From 11fd74e17f4ef619ca05fae23925bc90b7560d31 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 8 May 2024 11:24:23 -0700 Subject: [PATCH 001/631] Add FromJSON for Display objects --- unison-share-api/src/Unison/Server/Orphans.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/unison-share-api/src/Unison/Server/Orphans.hs b/unison-share-api/src/Unison/Server/Orphans.hs index 8aeadc269b..8775c376cd 100644 --- a/unison-share-api/src/Unison/Server/Orphans.hs +++ b/unison-share-api/src/Unison/Server/Orphans.hs @@ -155,6 +155,15 @@ instance (ToJSON b, ToJSON a) => ToJSON (DisplayObject b a) where MissingObject sh -> object ["tag" Aeson..= String "MissingObject", "contents" Aeson..= sh] UserObject a -> object ["tag" Aeson..= String "UserObject", "contents" Aeson..= a] +instance (FromJSON a, FromJSON b) => FromJSON (DisplayObject b a) where + parseJSON = withObject "DisplayObject" \o -> do + tag <- o .: "tag" + case tag of + "BuiltinObject" -> BuiltinObject <$> o .: "contents" + "MissingObject" -> MissingObject <$> o .: "contents" + "UserObject" -> UserObject <$> o .: "contents" + _ -> fail $ "Invalid tag: " <> Text.unpack tag + deriving instance (ToSchema b, ToSchema a) => ToSchema (DisplayObject b a) -- [21/10/07] Hello, this is Mitchell. Name refactor in progress. Changing internal representation from a flat text to a From a41e8d0bd7f5ea953eb83aa7339bd9ca038b3532 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 13 May 2024 14:41:13 -0600 Subject: [PATCH 002/631] Use `NumberedArgs` type consistently MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit As the type is changing to be more structured, we can’t use `[String]` in its place. --- unison-cli/src/Unison/CommandLine.hs | 5 +++-- unison-cli/src/Unison/CommandLine/Main.hs | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index f97a25e331..38d53a4a8b 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -46,6 +46,7 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Input (Event (..), Input (..)) +import Unison.Codebase.Editor.Output (NumberedArgs) import Unison.Codebase.Path qualified as Path import Unison.Codebase.Watch qualified as Watch import Unison.CommandLine.FZFResolvers qualified as FZFResolvers @@ -123,7 +124,7 @@ parseInput :: -- | Current path from root Path.Absolute -> -- | Numbered arguments - [String] -> + NumberedArgs -> -- | Input Pattern Map Map String InputPattern -> -- | command:arguments @@ -168,7 +169,7 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do ] -- Expand a numeric argument like `1` or a range like `3-9` -expandNumber :: [String] -> String -> [String] +expandNumber :: NumberedArgs -> String -> [String] expandNumber numberedArgs s = case expandedNumber of Nothing -> [s] Just nums -> diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index de0d7e12fb..0e948b5da0 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -33,7 +33,7 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.HandleInput qualified as HandleInput import Unison.Codebase.Editor.Input (Event, Input (..)) -import Unison.Codebase.Editor.Output (Output) +import Unison.Codebase.Editor.Output (NumberedArgs, Output) import Unison.Codebase.Editor.UCMVersion (UCMVersion) import Unison.Codebase.Path qualified as Path import Unison.Codebase.Runtime qualified as Runtime @@ -61,7 +61,7 @@ getUserInput :: Codebase IO Symbol Ann -> AuthenticatedHttpClient -> Path.Absolute -> - [String] -> + NumberedArgs -> IO Input getUserInput codebase authHTTPClient currentPath numberedArgs = Line.runInputT From 49ee64ef37fb3846d8aee8858435dc054d9992e3 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 20 May 2024 10:45:27 -0400 Subject: [PATCH 003/631] sketch out basic `upgrade.commit` command --- unison-cli/src/Unison/Cli/ProjectUtils.hs | 15 +++++ .../Codebase/Editor/HandleInput/Branch.hs | 3 +- .../Editor/HandleInput/CommitUpgrade.hs | 28 +++++++++ .../Editor/HandleInput/ProjectSwitch.hs | 62 +++++++++---------- unison-cli/unison-cli.cabal | 1 + 5 files changed, 75 insertions(+), 34 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index 9010be1c77..b74c5dbd82 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -39,6 +39,9 @@ module Unison.Cli.ProjectUtils -- * Other helpers findTemporaryBranchName, expectLatestReleaseBranchName, + + -- * Upgrade branch utils + getUpgradeBranchParent, ) where @@ -70,6 +73,7 @@ import Unison.Project.Util import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite import Witch (unsafeFrom) +import qualified Data.Text as Text branchRelativePathToAbsolute :: BranchRelativePath -> Cli Path.Absolute branchRelativePathToAbsolute brp = @@ -374,3 +378,14 @@ expectLatestReleaseBranchName remoteProject = case remoteProject.latestRelease of Nothing -> Cli.returnEarly (Output.ProjectHasNoReleases remoteProject.projectName) Just semver -> pure (UnsafeProjectBranchName ("releases/" <> into @Text semver)) + +-- | @getUpgradeBranchParent branch@ returns the parent branch of an "upgrade" branch. +-- +-- When an upgrade fails, we put you on a branch called `upgrade--to-`. That's an "upgrade" branch. It's not +-- currently distinguished in the database, so we first just switch on whether its name begins with "upgrade-". If it +-- does, then we get the branch's parent, which should exist, but perhaps wouldn't if the user had manually made a +-- parentless branch called "upgrade-whatever" for whatever reason. +getUpgradeBranchParent :: Sqlite.ProjectBranch -> Maybe ProjectBranchId +getUpgradeBranchParent branch = do + guard ("upgrade-" `Text.isPrefixOf` into @Text branch.name) + branch.parentBranchId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 4e740830cb..3ce5d167bd 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -120,11 +120,10 @@ doCreateBranch createFrom project newBranchName description = do Cli.getBranchAt (ProjectUtils.projectBranchPath (ProjectAndBranch sourceProjectId sourceBranchId)) CreateFrom'LooseCode sourcePath -> Cli.getBranchAt sourcePath CreateFrom'Nothingness -> pure Branch.empty - let projectId = project ^. #projectId let parentBranchId = case createFrom of CreateFrom'Branch (ProjectAndBranch _ sourceBranch) - | (sourceBranch ^. #projectId) == projectId -> Just (sourceBranch ^. #branchId) + | sourceBranch.projectId == project.projectId -> Just sourceBranch.branchId _ -> Nothing doCreateBranch' sourceNamespaceObject parentBranchId project (pure newBranchName) description diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs new file mode 100644 index 0000000000..f00526a963 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs @@ -0,0 +1,28 @@ +-- | @upgrade.commit@ handler. +module Unison.Codebase.Editor.HandleInput.CommitUpgrade + ( handleCommitUpgrade, + ) +where + +import U.Codebase.Sqlite.Project qualified +import Unison.Cli.Monad (Cli) +import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Codebase.Editor.HandleInput.ProjectSwitch qualified as ProjectSwitch +import Unison.NameSegment (NameSegment) +import Unison.Prelude +import Unison.Project (ProjectAndBranch (..)) + +handleCommitUpgrade :: Cli () +handleCommitUpgrade = do + (projectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch + + -- Assert that this is an "upgrade" branch and get its parent, which is the branch we were on when we ran `upgrade`. + parentBranchId <- + ProjectUtils.getUpgradeBranchParent projectAndBranch.branch + & onNothing wundefined + + -- Switch to the parent + ProjectSwitch.switchToProjectBranch projectAndBranch.project.projectId parentBranchId + + -- Merge in the upgrade branch + wundefined diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs index 87329e00d4..676a28244c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs @@ -1,11 +1,14 @@ -- | @switch@ input handler module Unison.Codebase.Editor.HandleInput.ProjectSwitch ( projectSwitch, + switchToProjectBranch, ) where -import Control.Lens ((^.)) import Data.These (These (..)) +import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) +import U.Codebase.Sqlite.Project qualified +import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -31,52 +34,47 @@ projectSwitch projectNames = do ProjectUtils.getCurrentProjectBranch >>= \case Nothing -> switchToProjectAndBranchByTheseNames (This projectName) Just (ProjectAndBranch currentProject _currentBranch, _restPath) -> do - let currentProjectName = currentProject ^. #name (projectExists, branchExists) <- Cli.runTransaction do (,) <$> Queries.projectExistsByName projectName - <*> Queries.projectBranchExistsByName (currentProject ^. #projectId) branchName + <*> Queries.projectBranchExistsByName currentProject.projectId branchName case (projectExists, branchExists) of (False, False) -> Cli.respond (Output.LocalProjectNorProjectBranchExist projectName branchName) - (False, True) -> switchToProjectAndBranchByTheseNames (These currentProjectName branchName) + (False, True) -> switchToProjectAndBranchByTheseNames (These currentProject.name branchName) (True, False) -> switchToProjectAndBranchByTheseNames (This projectName) (True, True) -> Cli.respondNumbered $ Output.AmbiguousSwitch projectName - (ProjectAndBranch currentProjectName branchName) + (ProjectAndBranch currentProject.name branchName) ProjectAndBranchNames'Unambiguous projectAndBranchNames0 -> switchToProjectAndBranchByTheseNames projectAndBranchNames0 switchToProjectAndBranchByTheseNames :: These ProjectName ProjectBranchName -> Cli () switchToProjectAndBranchByTheseNames projectAndBranchNames0 = do - branch <- case projectAndBranchNames0 of - This projectName -> - Cli.runTransactionWithRollback \rollback -> do - project <- - Queries.loadProjectByName projectName & onNothingM do - rollback (Output.LocalProjectDoesntExist projectName) - Queries.loadMostRecentBranch (project ^. #projectId) >>= \case - Nothing -> do - let branchName = unsafeFrom @Text "main" - branch <- - Queries.loadProjectBranchByName (project ^. #projectId) branchName & onNothingM do - rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName)) - setMostRecentBranch branch - Just branchId -> - Queries.loadProjectBranch (project ^. #projectId) branchId >>= \case - Nothing -> error "impossible" - Just branch -> pure branch - _ -> do - projectAndBranchNames@(ProjectAndBranch projectName branchName) <- ProjectUtils.hydrateNames projectAndBranchNames0 - Cli.runTransactionWithRollback \rollback -> do - branch <- + branch <- + case projectAndBranchNames0 of + This projectName -> + Cli.runTransactionWithRollback \rollback -> do + project <- + Queries.loadProjectByName projectName & onNothingM do + rollback (Output.LocalProjectDoesntExist projectName) + let branchName = unsafeFrom @Text "main" + Queries.loadProjectBranchByName project.projectId branchName & onNothingM do + rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName)) + _ -> do + projectAndBranchNames@(ProjectAndBranch projectName branchName) <- ProjectUtils.hydrateNames projectAndBranchNames0 + Cli.runTransactionWithRollback \rollback -> do Queries.loadProjectBranchByNames projectName branchName & onNothingM do rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) - setMostRecentBranch branch - Cli.cd (ProjectUtils.projectBranchPath (ProjectAndBranch (branch ^. #projectId) (branch ^. #branchId))) - where - setMostRecentBranch branch = do - Queries.setMostRecentBranch (branch ^. #projectId) (branch ^. #branchId) - pure branch + switchToProjectBranch branch.projectId branch.branchId + +-- | Switch to a branch: +-- +-- * Record it as the most-recent branch (so it's restored when ucm starts). +-- * Change the current path in the in-memory loop state. +switchToProjectBranch :: ProjectId -> ProjectBranchId -> Cli () +switchToProjectBranch projectId branchId = do + Cli.runTransaction (Queries.setMostRecentBranch projectId branchId) + Cli.cd (ProjectUtils.projectBranchPath (ProjectAndBranch projectId branchId)) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 6923ab417a..34b0da2803 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -54,6 +54,7 @@ library Unison.Codebase.Editor.HandleInput.Branch Unison.Codebase.Editor.HandleInput.Branches Unison.Codebase.Editor.HandleInput.BranchRename + Unison.Codebase.Editor.HandleInput.CommitUpgrade Unison.Codebase.Editor.HandleInput.DebugDefinition Unison.Codebase.Editor.HandleInput.DebugFoldRanges Unison.Codebase.Editor.HandleInput.DeleteBranch From 75795e61e4c0eeeba327e3ed33215ce34d252765 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 20 May 2024 12:09:00 -0400 Subject: [PATCH 004/631] implement `upgrade.commit` command --- unison-cli/src/Unison/Cli/ProjectUtils.hs | 30 +++++++++- .../src/Unison/Codebase/Editor/HandleInput.hs | 3 + .../Editor/HandleInput/CommitUpgrade.hs | 55 ++++++++++++++++--- .../Codebase/Editor/HandleInput/Merge2.hs | 54 +++++++++--------- .../Editor/HandleInput/ProjectSwitch.hs | 11 ++-- .../Codebase/Editor/HandleInput/Pull.hs | 13 ++--- .../src/Unison/Codebase/Editor/Input.hs | 1 + .../src/Unison/Codebase/Editor/Output.hs | 2 + .../src/Unison/CommandLine/InputPatterns.hs | 15 +++++ .../src/Unison/CommandLine/OutputMessages.hs | 2 + unison-src/transcripts/upgrade-happy-path.md | 1 + .../transcripts/upgrade-happy-path.output.md | 1 + unison-src/transcripts/upgrade-sad-path.md | 13 +++++ .../transcripts/upgrade-sad-path.output.md | 45 +++++++++++++++ 14 files changed, 195 insertions(+), 51 deletions(-) diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index b74c5dbd82..66eb87414c 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -25,6 +25,7 @@ module Unison.Cli.ProjectUtils getProjectAndBranchByTheseNames, expectProjectAndBranchByTheseNames, expectLooseCodeOrProjectBranch, + getProjectBranchCausalHash, -- * Loading remote project info expectRemoteProjectById, @@ -36,6 +37,11 @@ module Unison.Cli.ProjectUtils expectRemoteProjectBranchByNames, expectRemoteProjectBranchByTheseNames, + -- * Projecting out common things + justTheIds, + justTheIds', + justTheNames, + -- * Other helpers findTemporaryBranchName, expectLatestReleaseBranchName, @@ -49,7 +55,10 @@ import Control.Lens import Data.List qualified as List import Data.Maybe (fromJust) import Data.Set qualified as Set +import Data.Text qualified as Text import Data.These (These (..)) +import U.Codebase.Causal qualified +import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.DbId import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite @@ -59,6 +68,7 @@ import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.Share.Projects (IncludeSquashedHead) import Unison.Cli.Share.Projects qualified as Share +import Unison.Codebase qualified as Codebase import Unison.Codebase.Editor.Input (LooseCodeOrProject) import Unison.Codebase.Editor.Output (Output (LocalProjectBranchDoesntExist)) import Unison.Codebase.Editor.Output qualified as Output @@ -73,7 +83,6 @@ import Unison.Project.Util import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite import Witch (unsafeFrom) -import qualified Data.Text as Text branchRelativePathToAbsolute :: BranchRelativePath -> Cli Path.Absolute branchRelativePathToAbsolute brp = @@ -108,6 +117,18 @@ resolveBranchRelativePath = \case Left branchName -> That branchName Right (projectName, branchName) -> These projectName branchName +justTheIds :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> ProjectAndBranch ProjectId ProjectBranchId +justTheIds x = + ProjectAndBranch x.project.projectId x.branch.branchId + +justTheIds' :: Sqlite.ProjectBranch -> ProjectAndBranch ProjectId ProjectBranchId +justTheIds' x = + ProjectAndBranch x.projectId x.branchId + +justTheNames :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> ProjectAndBranch ProjectName ProjectBranchName +justTheNames x = + ProjectAndBranch x.project.name x.branch.name + -- @findTemporaryBranchName projectId preferred@ finds some unused branch name in @projectId@ with a name -- like @preferred@. findTemporaryBranchName :: ProjectId -> ProjectBranchName -> Transaction ProjectBranchName @@ -268,6 +289,13 @@ expectLooseCodeOrProjectBranch = That (ProjectAndBranch (Just project) branch) -> Right (These project branch) These path _ -> Left path -- (3) above +-- | Get the causal hash of a project branch. +getProjectBranchCausalHash :: ProjectAndBranch ProjectId ProjectBranchId -> Transaction CausalHash +getProjectBranchCausalHash branch = do + let path = projectBranchPath branch + causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute path) + pure causal.causalHash + ------------------------------------------------------------------------------------------------------------------------ -- Remote project utils diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index ece99ab85c..376f521a86 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -57,6 +57,7 @@ import Unison.Codebase.Editor.HandleInput.AuthLogin (authLogin) import Unison.Codebase.Editor.HandleInput.Branch (handleBranch) import Unison.Codebase.Editor.HandleInput.BranchRename (handleBranchRename) import Unison.Codebase.Editor.HandleInput.Branches (handleBranches) +import Unison.Codebase.Editor.HandleInput.CommitUpgrade (handleCommitUpgrade) import Unison.Codebase.Editor.HandleInput.DebugDefinition qualified as DebugDefinition import Unison.Codebase.Editor.HandleInput.DebugFoldRanges qualified as DebugFoldRanges import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch) @@ -1192,6 +1193,7 @@ loop e = do CloneI remoteNames localNames -> handleClone remoteNames localNames ReleaseDraftI semver -> handleReleaseDraft semver UpgradeI old new -> handleUpgrade old new + UpgradeCommitI -> handleCommitUpgrade LibInstallI libdep -> handleInstallLib libdep inputDescription :: Input -> Cli Text @@ -1407,6 +1409,7 @@ inputDescription input = UiI {} -> wat UpI {} -> wat UpgradeI {} -> wat + UpgradeCommitI {} -> wat VersionI -> wat where hp' :: Either SCH.ShortCausalHash Path' -> Cli Text diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs index f00526a963..a02acd5bc2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs @@ -4,25 +4,66 @@ module Unison.Codebase.Editor.HandleInput.CommitUpgrade ) where +import Data.Text qualified as Text +import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Project qualified +import U.Codebase.Sqlite.Queries qualified as Queries +import Unison.Cli.MergeTypes (MergeSource (..)) import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge import Unison.Codebase.Editor.HandleInput.ProjectSwitch qualified as ProjectSwitch -import Unison.NameSegment (NameSegment) +import Unison.Codebase.Editor.Output qualified as Output +import Unison.CommandLine.InputPattern qualified as InputPattern +import Unison.CommandLine.InputPatterns qualified as InputPatterns import Unison.Prelude import Unison.Project (ProjectAndBranch (..)) handleCommitUpgrade :: Cli () handleCommitUpgrade = do - (projectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch + (upgradeProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch -- Assert that this is an "upgrade" branch and get its parent, which is the branch we were on when we ran `upgrade`. + parentBranchId <- - ProjectUtils.getUpgradeBranchParent projectAndBranch.branch - & onNothing wundefined + ProjectUtils.getUpgradeBranchParent upgradeProjectAndBranch.branch + & onNothing (Cli.returnEarly Output.NoUpgradeInProgress) + parentBranch <- + Cli.runTransaction do + Queries.expectProjectBranch upgradeProjectAndBranch.project.projectId parentBranchId + + let parentProjectAndBranch = + ProjectAndBranch upgradeProjectAndBranch.project parentBranch -- Switch to the parent - ProjectSwitch.switchToProjectBranch projectAndBranch.project.projectId parentBranchId - -- Merge in the upgrade branch - wundefined + ProjectSwitch.switchToProjectBranch (ProjectUtils.justTheIds parentProjectAndBranch) + + -- Merge the upgrade branch into the parent + + (parentCausalHash, upgradeCausalHash, lcaCausalHash) <- + Cli.runTransaction do + parentCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds parentProjectAndBranch) + upgradeCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds upgradeProjectAndBranch) + lcaCausalHash <- Operations.lca parentCausalHash upgradeCausalHash + pure (parentCausalHash, upgradeCausalHash, lcaCausalHash) + + Merge.doMerge + Merge.MergeInfo + { alice = + Merge.AliceMergeInfo + { causalHash = parentCausalHash, + projectAndBranch = parentProjectAndBranch + }, + bob = + Merge.BobMergeInfo + { causalHash = upgradeCausalHash, + source = MergeSource'LocalProjectBranch (ProjectUtils.justTheNames upgradeProjectAndBranch) + }, + lca = + Merge.LcaMergeInfo + { causalHash = lcaCausalHash + }, + description = Text.pack (InputPattern.patternName InputPatterns.upgradeCommitInputPattern) + } diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index d6685f1059..4c566351b6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -43,11 +43,11 @@ import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Builtin.Decls qualified as Builtin.Decls -import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceOrTarget (..), MergeSourceAndTarget (..)) +import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceAndTarget (..), MergeSourceOrTarget (..)) 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 Cli +import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) @@ -140,24 +140,28 @@ import Prelude hiding (unzip, zip, zipWith) handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do -- Assert that Alice (us) is on a project branch, and grab the causal hash. - (ProjectAndBranch aliceProject aliceProjectBranch, _path) <- Cli.expectCurrentProjectBranch - aliceCausalHash <- Cli.runTransaction (projectBranchToCausalHash aliceProjectBranch) + (aliceProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch -- Resolve Bob's maybe-project-name + branch-name to the info the merge algorithm needs: the project name, branch -- name, and causal hash. bobProject <- case maybeBobProjectName of - Nothing -> pure aliceProject + Nothing -> pure aliceProjectAndBranch.project Just bobProjectName - | bobProjectName == aliceProject.name -> pure aliceProject + | bobProjectName == aliceProjectAndBranch.project.name -> pure aliceProjectAndBranch.project | otherwise -> do Cli.runTransaction (Queries.loadProjectByName bobProjectName) & onNothingM (Cli.returnEarly (Output.LocalProjectDoesntExist bobProjectName)) - bobProjectBranch <- Cli.expectProjectBranchByName bobProject bobBranchName - bobCausalHash <- Cli.runTransaction (projectBranchToCausalHash bobProjectBranch) + bobProjectBranch <- ProjectUtils.expectProjectBranchByName bobProject bobBranchName + let bobProjectAndBranch = ProjectAndBranch bobProject bobProjectBranch - -- Using Alice and Bob's causal hashes, find the LCA (if it exists) - lcaCausalHash <- Cli.runTransaction (Operations.lca aliceCausalHash bobCausalHash) + (aliceCausalHash, bobCausalHash, lcaCausalHash) <- + Cli.runTransaction do + aliceCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds aliceProjectAndBranch) + bobCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds bobProjectAndBranch) + -- Using Alice and Bob's causal hashes, find the LCA (if it exists) + lcaCausalHash <- Operations.lca aliceCausalHash bobCausalHash + pure (aliceCausalHash, bobCausalHash, lcaCausalHash) -- Do the merge! doMerge @@ -165,30 +169,23 @@ handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do { alice = AliceMergeInfo { causalHash = aliceCausalHash, - project = aliceProject, - projectBranch = aliceProjectBranch + projectAndBranch = aliceProjectAndBranch }, bob = BobMergeInfo { causalHash = bobCausalHash, - source = MergeSource'LocalProjectBranch (ProjectAndBranch bobProject.name bobBranchName) + source = MergeSource'LocalProjectBranch (ProjectUtils.justTheNames bobProjectAndBranch) }, lca = LcaMergeInfo { causalHash = lcaCausalHash }, - description = "merge " <> into @Text (ProjectAndBranch bobProject.name bobBranchName) + description = "merge " <> into @Text (ProjectUtils.justTheNames bobProjectAndBranch) } - where - projectBranchToCausalHash :: ProjectBranch -> Transaction CausalHash - projectBranchToCausalHash branch = do - let path = Cli.projectBranchPath (ProjectAndBranch branch.projectId branch.branchId) - causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute path) - pure causal.causalHash data MergeInfo = MergeInfo { alice :: !AliceMergeInfo, - bob :: BobMergeInfo, + bob :: !BobMergeInfo, lca :: !LcaMergeInfo, -- | How should we describe this merge in the reflog? description :: !Text @@ -196,8 +193,7 @@ data MergeInfo = MergeInfo data AliceMergeInfo = AliceMergeInfo { causalHash :: !CausalHash, - project :: !Project, - projectBranch :: !ProjectBranch + projectAndBranch :: !(ProjectAndBranch Project ProjectBranch) } data BobMergeInfo = BobMergeInfo @@ -216,11 +212,11 @@ doMerge info = do then realDebugFunctions else fakeDebugFunctions - let alicePath = Cli.projectBranchPath (ProjectAndBranch info.alice.project.projectId info.alice.projectBranch.branchId) - let aliceBranchNames = ProjectAndBranch info.alice.project.name info.alice.projectBranch.name + let alicePath = ProjectUtils.projectBranchPath (ProjectUtils.justTheIds info.alice.projectAndBranch) + let aliceBranchNames = ProjectUtils.justTheNames info.alice.projectAndBranch let mergeSource = MergeSourceOrTarget'Source info.bob.source let mergeTarget = MergeSourceOrTarget'Target aliceBranchNames - let mergeSourceAndTarget = MergeSourceAndTarget { alice = aliceBranchNames, bob = info.bob.source } + let mergeSourceAndTarget = MergeSourceAndTarget {alice = aliceBranchNames, bob = info.bob.source} Cli.Env {codebase} <- ask @@ -438,8 +434,8 @@ doMerge info = do HandleInput.Branch.doCreateBranch' (Branch.mergeNode stageOneBranch parents.alice parents.bob) Nothing - info.alice.project - (findTemporaryBranchName info.alice.project.projectId mergeSourceAndTarget) + info.alice.projectAndBranch.project + (findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget) info.description scratchFilePath <- Cli.getLatestFile <&> \case @@ -838,7 +834,7 @@ defnsToNames defns = findTemporaryBranchName :: ProjectId -> MergeSourceAndTarget -> Transaction ProjectBranchName findTemporaryBranchName projectId mergeSourceAndTarget = do - Cli.findTemporaryBranchName projectId preferred + ProjectUtils.findTemporaryBranchName projectId preferred where preferred :: ProjectBranchName preferred = diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs index 676a28244c..688ba58363 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs @@ -8,7 +8,6 @@ where import Data.These (These (..)) import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) import U.Codebase.Sqlite.Project qualified -import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -68,13 +67,13 @@ switchToProjectAndBranchByTheseNames projectAndBranchNames0 = do Cli.runTransactionWithRollback \rollback -> do Queries.loadProjectBranchByNames projectName branchName & onNothingM do rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) - switchToProjectBranch branch.projectId branch.branchId + switchToProjectBranch (ProjectUtils.justTheIds' branch) -- | Switch to a branch: -- -- * Record it as the most-recent branch (so it's restored when ucm starts). -- * Change the current path in the in-memory loop state. -switchToProjectBranch :: ProjectId -> ProjectBranchId -> Cli () -switchToProjectBranch projectId branchId = do - Cli.runTransaction (Queries.setMostRecentBranch projectId branchId) - Cli.cd (ProjectUtils.projectBranchPath (ProjectAndBranch projectId branchId)) +switchToProjectBranch :: ProjectAndBranch ProjectId ProjectBranchId -> Cli () +switchToProjectBranch x = do + Cli.runTransaction (Queries.setMostRecentBranch x.project x.branch) + Cli.cd (ProjectUtils.projectBranchPath x) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index 3bf286d998..1d2cff1483 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -125,8 +125,7 @@ handlePull unresolvedSourceAndTarget pullMode = do { alice = AliceMergeInfo { causalHash = aliceCausalHash, - project = target.project, - projectBranch = target.branch + projectAndBranch = target }, bob = BobMergeInfo @@ -221,9 +220,9 @@ resolveExplicitSource includeSquashed = \case (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName) pure (ReadShare'ProjectBranch remoteProjectBranch) ReadShare'ProjectBranch (That branchNameOrLatestRelease) -> do - (ProjectAndBranch localProject localBranch, _restPath) <- ProjectUtils.expectCurrentProjectBranch - let localProjectId = localProject.projectId - let localBranchId = localBranch.branchId + (localProjectAndBranch, _restPath) <- ProjectUtils.expectCurrentProjectBranch + let localProjectId = localProjectAndBranch.project.projectId + let localBranchId = localProjectAndBranch.branch.branchId Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case Just (remoteProjectId, _maybeProjectBranchId) -> do remoteProjectName <- Cli.runTransaction (Queries.expectRemoteProjectName remoteProjectId Share.hardCodedUri) @@ -240,9 +239,7 @@ resolveExplicitSource includeSquashed = \case pure (ReadShare'ProjectBranch remoteProjectBranch) Nothing -> do Cli.returnEarly $ - Output.NoAssociatedRemoteProject - Share.hardCodedUri - (ProjectAndBranch localProject.name localBranch.name) + Output.NoAssociatedRemoteProject Share.hardCodedUri (ProjectUtils.justTheNames localProjectAndBranch) ReadShare'ProjectBranch (These projectName branchNameOrLatestRelease) -> do remoteProject <- ProjectUtils.expectRemoteProjectByName projectName let remoteProjectId = remoteProject.projectId diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 47d1c75cdc..e1ee2c73ee 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -242,6 +242,7 @@ data Input | -- New merge algorithm: merge the given project branch into the current one. MergeI (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) | LibInstallI !(ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) + | UpgradeCommitI 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 95923f5cc0..d30c8ef94d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -411,6 +411,7 @@ data Output | MergeNestedDeclAlias !(Maybe MergeSourceOrTarget) !Name !Name | MergeStrayConstructor !(Maybe MergeSourceOrTarget) !Name | InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment + | NoUpgradeInProgress data UpdateOrUpgrade = UOUUpdate | UOUUpgrade @@ -654,6 +655,7 @@ isFailure o = case o of MergeNestedDeclAlias {} -> True MergeStrayConstructor {} -> True InstalledLibdep {} -> False + NoUpgradeInProgress {} -> True isNumberedFailure :: NumberedOutput -> Bool isNumberedFailure = \case diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index b5b69727c1..11e4c8b985 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -127,6 +127,7 @@ module Unison.CommandLine.InputPatterns updateOld, updateOldNoPatch, upgrade, + upgradeCommitInputPattern, view, viewGlobal, viewPatch, @@ -3142,6 +3143,19 @@ upgrade = segment NE.:| [] <- Just (Name.reverseSegments name) Just segment +upgradeCommitInputPattern :: InputPattern +upgradeCommitInputPattern = + InputPattern + { patternName = "upgrade.commit", + aliases = ["commit.upgrade"], + visibility = I.Visible, + args = [], + help = P.wrap $ makeExample' upgradeCommitInputPattern <> "commits the current upgrade.", + parse = \case + [] -> Right Input.UpgradeCommitI + _ -> Left (I.help upgradeCommitInputPattern) + } + validInputs :: [InputPattern] validInputs = sortOn @@ -3270,6 +3284,7 @@ validInputs = updateOld, updateOldNoPatch, upgrade, + upgradeCommitInputPattern, view, viewGlobal, viewPatch, diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index fc9b570235..18e6e8768f 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2311,6 +2311,8 @@ notifyUser dir = \case <> prettyProjectAndBranchName libdep <> "as" <> P.group (P.text (NameSegment.toEscapedText segment) <> ".") + NoUpgradeInProgress -> + pure . P.wrap $ "It doesn't look like there's an upgrade in progress." expectedEmptyPushDest :: WriteRemoteNamespace Void -> Pretty expectedEmptyPushDest namespace = diff --git a/unison-src/transcripts/upgrade-happy-path.md b/unison-src/transcripts/upgrade-happy-path.md index 3daf5f78e8..c234e9ac7d 100644 --- a/unison-src/transcripts/upgrade-happy-path.md +++ b/unison-src/transcripts/upgrade-happy-path.md @@ -15,6 +15,7 @@ proj/main> add ``` Test tab completion and fzf options of upgrade command. + ```ucm proj/main> debug.tab-complete upgrade ol proj/main> debug.fuzzy-options upgrade _ diff --git a/unison-src/transcripts/upgrade-happy-path.output.md b/unison-src/transcripts/upgrade-happy-path.output.md index 5e487a5723..b2d8bb80a6 100644 --- a/unison-src/transcripts/upgrade-happy-path.output.md +++ b/unison-src/transcripts/upgrade-happy-path.output.md @@ -30,6 +30,7 @@ proj/main> add ``` Test tab completion and fzf options of upgrade command. + ```ucm proj/main> debug.tab-complete upgrade ol diff --git a/unison-src/transcripts/upgrade-sad-path.md b/unison-src/transcripts/upgrade-sad-path.md index 4557c1cadf..1aed98723b 100644 --- a/unison-src/transcripts/upgrade-sad-path.md +++ b/unison-src/transcripts/upgrade-sad-path.md @@ -16,3 +16,16 @@ proj/main> add ```ucm:error proj/main> upgrade old new ``` + +Resolve the error and commit the upgrade. + +```unison +thingy = foo + +10 +``` + +```ucm +proj/upgrade-old-to-new> update +proj/upgrade-old-to-new> upgrade.commit +proj/main> view thingy +proj/main> ls lib +``` diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md index 37f96f94ed..7df2c61272 100644 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ b/unison-src/transcripts/upgrade-sad-path.output.md @@ -44,3 +44,48 @@ thingy = foo + 10 ``` +Resolve the error and commit the upgrade. + +```unison +thingy = foo + +10 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These names already exist. You can `update` them to your + new definition: + + thingy : Int + +``` +```ucm +proj/upgrade-old-to-new> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +proj/upgrade-old-to-new> upgrade.commit + + I fast-forward merged proj/upgrade-old-to-new into proj/main. + +proj/main> view thingy + + thingy : Int + thingy = + use Int + + foo + +10 + +proj/main> ls lib + + 1. builtin/ (469 terms, 74 types) + 2. new/ (1 term) + +``` From 4479966f8d04fb1510f51dcf2e5a287d23d2893b Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 20 May 2024 13:04:31 -0400 Subject: [PATCH 005/631] make `upgrade.commit` perform the initial `update` --- .../Editor/HandleInput/CommitUpgrade.hs | 44 +++++-------- .../Editor/HandleInput/DeleteBranch.hs | 64 +++++++++---------- .../Codebase/Editor/HandleInput/Merge2.hs | 61 ++++++++++-------- unison-src/transcripts/upgrade-sad-path.md | 1 - .../transcripts/upgrade-sad-path.output.md | 4 +- 5 files changed, 83 insertions(+), 91 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs index a02acd5bc2..901dada1e4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs @@ -4,19 +4,17 @@ module Unison.Codebase.Editor.HandleInput.CommitUpgrade ) where -import Data.Text qualified as Text -import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Project qualified import U.Codebase.Sqlite.Queries qualified as Queries -import Unison.Cli.MergeTypes (MergeSource (..)) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Codebase.Editor.HandleInput.DeleteBranch qualified as DeleteBranch import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge import Unison.Codebase.Editor.HandleInput.ProjectSwitch qualified as ProjectSwitch +import Unison.Codebase.Editor.HandleInput.Update2 qualified as Update import Unison.Codebase.Editor.Output qualified as Output -import Unison.CommandLine.InputPattern qualified as InputPattern -import Unison.CommandLine.InputPatterns qualified as InputPatterns +import Unison.Merge.TwoWay (TwoWay (..)) import Unison.Prelude import Unison.Project (ProjectAndBranch (..)) @@ -36,34 +34,22 @@ handleCommitUpgrade = do let parentProjectAndBranch = ProjectAndBranch upgradeProjectAndBranch.project parentBranch + -- Run `update` + + Update.handleUpdate2 + -- Switch to the parent ProjectSwitch.switchToProjectBranch (ProjectUtils.justTheIds parentProjectAndBranch) -- Merge the upgrade branch into the parent - (parentCausalHash, upgradeCausalHash, lcaCausalHash) <- - Cli.runTransaction do - parentCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds parentProjectAndBranch) - upgradeCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds upgradeProjectAndBranch) - lcaCausalHash <- Operations.lca parentCausalHash upgradeCausalHash - pure (parentCausalHash, upgradeCausalHash, lcaCausalHash) - - Merge.doMerge - Merge.MergeInfo - { alice = - Merge.AliceMergeInfo - { causalHash = parentCausalHash, - projectAndBranch = parentProjectAndBranch - }, - bob = - Merge.BobMergeInfo - { causalHash = upgradeCausalHash, - source = MergeSource'LocalProjectBranch (ProjectUtils.justTheNames upgradeProjectAndBranch) - }, - lca = - Merge.LcaMergeInfo - { causalHash = lcaCausalHash - }, - description = Text.pack (InputPattern.patternName InputPatterns.upgradeCommitInputPattern) + Merge.doMergeLocalBranch + TwoWay + { alice = parentProjectAndBranch, + bob = upgradeProjectAndBranch } + + -- Delete the upgrade branch + + DeleteBranch.doDeleteProjectBranch upgradeProjectAndBranch diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs index b6865748f1..0fa4291c61 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs @@ -1,19 +1,21 @@ -- | @delete.branch@ input handler module Unison.Codebase.Editor.HandleInput.DeleteBranch ( handleDeleteBranch, + doDeleteProjectBranch, ) where -import Control.Lens (over, (^.)) +import Control.Lens (over) import Data.Map.Strict qualified as Map import Data.These (These (..)) +import U.Codebase.Sqlite.Project qualified as Sqlite +import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Branch qualified as Branch -import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) @@ -25,47 +27,45 @@ import Witch (unsafeFrom) -- Its children branches, if any, are reparented to their grandparent, if any. You may delete the only branch in a -- project. handleDeleteBranch :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () -handleDeleteBranch projectAndBranchNames0 = do - projectAndBranchNames <- - ProjectUtils.hydrateNames - case projectAndBranchNames0 of +handleDeleteBranch projectAndBranchNamesToDelete = do + projectAndBranchToDelete <- + ProjectUtils.expectProjectAndBranchByTheseNames + case projectAndBranchNamesToDelete of ProjectAndBranch Nothing branch -> That branch ProjectAndBranch (Just project) branch -> These project branch maybeCurrentBranch <- ProjectUtils.getCurrentProjectBranch - deletedBranch <- - Cli.runTransactionWithRollback \rollback -> do - branch <- - Queries.loadProjectBranchByNames (projectAndBranchNames ^. #project) (projectAndBranchNames ^. #branch) - & onNothingM (rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames)) - Queries.deleteProjectBranch (branch ^. #projectId) (branch ^. #branchId) - pure branch - - let projectId = deletedBranch ^. #projectId - - Cli.stepAt - ("delete.branch " <> into @Text projectAndBranchNames) - ( Path.unabsolute (ProjectUtils.projectBranchesPath projectId), - \branchObject -> - branchObject - & over - Branch.children - (Map.delete (ProjectUtils.projectBranchSegment (deletedBranch ^. #branchId))) - ) + doDeleteProjectBranch projectAndBranchToDelete -- If the user is on the branch that they're deleting, we have to cd somewhere; try these in order: -- -- 1. cd to parent branch, if it exists -- 2. cd to "main", if it exists -- 3. cd to loose code path `.` - whenJust maybeCurrentBranch \(ProjectAndBranch _currentProject currentBranch, _restPath) -> - when (deletedBranch == currentBranch) do + whenJust maybeCurrentBranch \(currentProjectAndBranch, _restPath) -> + when (ProjectUtils.justTheIds currentProjectAndBranch == ProjectUtils.justTheIds projectAndBranchToDelete) do newPath <- - case deletedBranch ^. #parentBranchId of + case projectAndBranchToDelete.branch.parentBranchId of Nothing -> - Cli.runTransaction (Queries.loadProjectBranchByName projectId (unsafeFrom @Text "main")) <&> \case - Nothing -> Path.Absolute Path.empty - Just mainBranch -> ProjectUtils.projectBranchPath (ProjectAndBranch projectId (mainBranch ^. #branchId)) - Just parentBranchId -> pure (ProjectUtils.projectBranchPath (ProjectAndBranch projectId parentBranchId)) + let loadMain = + Queries.loadProjectBranchByName projectAndBranchToDelete.project.projectId (unsafeFrom @Text "main") + in Cli.runTransaction loadMain <&> \case + Nothing -> Path.Absolute Path.empty + Just mainBranch -> ProjectUtils.projectBranchPath (ProjectUtils.justTheIds' mainBranch) + Just parentBranchId -> + pure $ + ProjectUtils.projectBranchPath + (ProjectAndBranch projectAndBranchToDelete.project.projectId parentBranchId) Cli.cd newPath + +-- | Delete a project branch and record an entry in the reflog. +doDeleteProjectBranch :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> Cli () +doDeleteProjectBranch projectAndBranch = do + Cli.runTransaction do + Queries.deleteProjectBranch projectAndBranch.project.projectId projectAndBranch.branch.branchId + Cli.stepAt + ("delete.branch " <> into @Text (ProjectUtils.justTheNames projectAndBranch)) + ( Path.unabsolute (ProjectUtils.projectBranchesPath projectAndBranch.project.projectId), + over Branch.children (Map.delete (ProjectUtils.projectBranchSegment projectAndBranch.branch.branchId)) + ) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 4c566351b6..3e1907e1b1 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -7,6 +7,7 @@ module Unison.Codebase.Editor.HandleInput.Merge2 BobMergeInfo (..), LcaMergeInfo (..), doMerge, + doMergeLocalBranch, ) where @@ -155,32 +156,10 @@ handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do bobProjectBranch <- ProjectUtils.expectProjectBranchByName bobProject bobBranchName let bobProjectAndBranch = ProjectAndBranch bobProject bobProjectBranch - (aliceCausalHash, bobCausalHash, lcaCausalHash) <- - Cli.runTransaction do - aliceCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds aliceProjectAndBranch) - bobCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds bobProjectAndBranch) - -- Using Alice and Bob's causal hashes, find the LCA (if it exists) - lcaCausalHash <- Operations.lca aliceCausalHash bobCausalHash - pure (aliceCausalHash, bobCausalHash, lcaCausalHash) - - -- Do the merge! - doMerge - MergeInfo - { alice = - AliceMergeInfo - { causalHash = aliceCausalHash, - projectAndBranch = aliceProjectAndBranch - }, - bob = - BobMergeInfo - { causalHash = bobCausalHash, - source = MergeSource'LocalProjectBranch (ProjectUtils.justTheNames bobProjectAndBranch) - }, - lca = - LcaMergeInfo - { causalHash = lcaCausalHash - }, - description = "merge " <> into @Text (ProjectUtils.justTheNames bobProjectAndBranch) + doMergeLocalBranch + TwoWay + { alice = aliceProjectAndBranch, + bob = bobProjectAndBranch } data MergeInfo = MergeInfo @@ -453,6 +432,36 @@ doMerge info = do (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) Cli.respond (Output.MergeSuccess mergeSourceAndTarget) +doMergeLocalBranch :: TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () +doMergeLocalBranch branches = do + (aliceCausalHash, bobCausalHash, lcaCausalHash) <- + Cli.runTransaction do + aliceCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds branches.alice) + bobCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds branches.bob) + -- Using Alice and Bob's causal hashes, find the LCA (if it exists) + lcaCausalHash <- Operations.lca aliceCausalHash bobCausalHash + pure (aliceCausalHash, bobCausalHash, lcaCausalHash) + + -- Do the merge! + doMerge + MergeInfo + { alice = + AliceMergeInfo + { causalHash = aliceCausalHash, + projectAndBranch = branches.alice + }, + bob = + BobMergeInfo + { causalHash = bobCausalHash, + source = MergeSource'LocalProjectBranch (ProjectUtils.justTheNames branches.bob) + }, + lca = + LcaMergeInfo + { causalHash = lcaCausalHash + }, + description = "merge " <> into @Text (ProjectUtils.justTheNames branches.bob) + } + ------------------------------------------------------------------------------------------------------------------------ -- Loading basic info out of the database diff --git a/unison-src/transcripts/upgrade-sad-path.md b/unison-src/transcripts/upgrade-sad-path.md index 1aed98723b..a27b75f0c9 100644 --- a/unison-src/transcripts/upgrade-sad-path.md +++ b/unison-src/transcripts/upgrade-sad-path.md @@ -24,7 +24,6 @@ thingy = foo + +10 ``` ```ucm -proj/upgrade-old-to-new> update proj/upgrade-old-to-new> upgrade.commit proj/main> view thingy proj/main> ls lib diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md index 7df2c61272..718a4c5009 100644 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ b/unison-src/transcripts/upgrade-sad-path.output.md @@ -65,15 +65,13 @@ thingy = foo + +10 ``` ```ucm -proj/upgrade-old-to-new> update +proj/upgrade-old-to-new> upgrade.commit Okay, I'm searching the branch for code that needs to be updated... Done. -proj/upgrade-old-to-new> upgrade.commit - I fast-forward merged proj/upgrade-old-to-new into proj/main. proj/main> view thingy From 7273bd9a3af39dd9d3bd8b06479eb10bb16b22ac Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 20 May 2024 14:13:04 -0400 Subject: [PATCH 006/631] in `merge`, don't `returnEarly` on success --- .../Codebase/Editor/HandleInput/Merge2.hs | 465 +++++++++--------- unison-src/transcripts/upgrade-sad-path.md | 1 + .../transcripts/upgrade-sad-path.output.md | 5 + 3 files changed, 240 insertions(+), 231 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 3e1907e1b1..265cd9d06c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -199,238 +199,241 @@ doMerge info = do Cli.Env {codebase} <- ask - -- If alice == bob, or LCA == bob (so alice is ahead of bob), then we are done. - when (info.alice.causalHash == info.bob.causalHash || info.lca.causalHash == Just info.bob.causalHash) do - Cli.returnEarly (Output.MergeAlreadyUpToDate2 mergeSourceAndTarget) - - -- Otherwise, if LCA == alice (so alice is behind bob), then we could fast forward to bob, so we're done. - when (info.lca.causalHash == Just info.alice.causalHash) do - bobBranch <- liftIO (Codebase.expectBranchForHash codebase info.bob.causalHash) - _ <- Cli.updateAt info.description alicePath (\_aliceBranch -> bobBranch) - Cli.returnEarly (Output.MergeSuccessFastForward mergeSourceAndTarget) - - -- Create a bunch of cached database lookup functions - db <- makeMergeDatabase codebase - - -- Load Alice/Bob/LCA causals - causals <- Cli.runTransaction do - traverse - Operations.expectCausalBranchByCausalHash - TwoOrThreeWay - { alice = info.alice.causalHash, - bob = info.bob.causalHash, - lca = info.lca.causalHash - } - - liftIO (debugFunctions.debugCausals causals) - - -- Load Alice/Bob/LCA branches - branches <- - Cli.runTransaction do - alice <- causals.alice.value - bob <- causals.bob.value - lca <- for causals.lca \causal -> causal.value - pure TwoOrThreeWay {lca, alice, bob} - - -- Assert that neither Alice nor Bob have defns in lib - for_ [(mergeTarget, branches.alice), (mergeSource, branches.bob)] \(who, branch) -> do - libdeps <- - case Map.lookup NameSegment.libSegment branch.children of - Nothing -> pure V2.Branch.empty - Just libdeps -> Cli.runTransaction libdeps.value - when (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) do - Cli.returnEarly (Output.MergeDefnsInLib who) - - -- Load Alice/Bob/LCA definitions and decl name lookups - (defns3, declNameLookups3) <- do - let load = \case - Nothing -> - pure - ( Nametree {value = Defns Map.empty Map.empty, children = Map.empty}, - DeclNameLookup Map.empty Map.empty - ) - Just (who, branch) -> do - defns <- - Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) & onLeftM \conflictedName -> - Cli.returnEarly case conflictedName of - ConflictedName'Term name refs -> Output.MergeConflictedTermName name refs - ConflictedName'Type name refs -> Output.MergeConflictedTypeName name refs - declNameLookup <- - Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) & onLeftM \err -> - Cli.returnEarly case err of - IncoherentDeclReason'ConstructorAlias name1 name2 -> - Output.MergeConstructorAlias who name1 name2 - IncoherentDeclReason'MissingConstructorName name -> Output.MergeMissingConstructorName who name - IncoherentDeclReason'NestedDeclAlias shorterName longerName -> - Output.MergeNestedDeclAlias who shorterName longerName - IncoherentDeclReason'StrayConstructor name -> Output.MergeStrayConstructor who name - pure (defns, declNameLookup) - - (aliceDefns0, aliceDeclNameLookup) <- load (Just (Just mergeTarget, branches.alice)) - (bobDefns0, bobDeclNameLookup) <- load (Just (Just mergeSource, branches.bob)) - (lcaDefns0, lcaDeclNameLookup) <- load ((Nothing,) <$> branches.lca) - - let flatten defns = Defns (flattenNametree (view #terms) defns) (flattenNametree (view #types) defns) - let defns3 = flatten <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} - let declNameLookups3 = ThreeWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup, lca = lcaDeclNameLookup} - - pure (defns3, declNameLookups3) - - let defns = ThreeWay.forgetLca defns3 - let declNameLookups = ThreeWay.forgetLca declNameLookups3 - - liftIO (debugFunctions.debugDefns defns3 declNameLookups3) - - -- Diff LCA->Alice and LCA->Bob - diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups3 defns3) - - liftIO (debugFunctions.debugDiffs diffs) - - -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias - for_ ((,) <$> TwoWay mergeTarget mergeSource <*> diffs) \(who, diff) -> - whenJust (findConflictedAlias defns3.lca diff) \(name1, name2) -> - Cli.returnEarly (Output.MergeConflictedAliases who name1 name2) - - -- Combine the LCA->Alice and LCA->Bob diffs together - let diff = combineDiffs diffs - - liftIO (debugFunctions.debugCombinedDiff diff) - - -- Partition the combined diff into the conflicted things and the unconflicted things - (conflicts, unconflicts) <- - partitionCombinedDiffs defns declNameLookups diff & onLeft \name -> - Cli.returnEarly (Output.MergeConflictInvolvingBuiltin name) - - liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts) - - -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if there - -- aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) - dependents <- Cli.runTransaction (identifyDependents defns conflicts unconflicts) - - liftIO (debugFunctions.debugDependents dependents) - - let stageOne :: DefnsF (Map Name) Referent TypeReference - stageOne = - makeStageOne - declNameLookups - conflicts - unconflicts - dependents - (bimap BiMultimap.range BiMultimap.range defns3.lca) - - liftIO (debugFunctions.debugStageOne stageOne) - - -- Load and merge Alice's and Bob's libdeps - mergedLibdeps <- - Cli.runTransaction do - libdeps <- loadLibdeps branches - libdepsToBranch0 db (Merge.mergeLibdeps getTwoFreshNames libdeps) - - -- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names - let mkPpes :: TwoWay Names -> Names -> TwoWay PrettyPrintEnvDecl - mkPpes defnsNames libdepsNames = - defnsNames <&> \names -> PPED.makePPED (PPE.namer (names <> libdepsNames)) suffixifier - where - suffixifier = PPE.suffixifyByName (fold defnsNames <> libdepsNames) - let ppes = mkPpes (defnsToNames <$> defns) (Branch.toNames mergedLibdeps) + Cli.label \done -> do + -- If alice == bob, or LCA == bob (so alice is ahead of bob), then we are done. + when (info.alice.causalHash == info.bob.causalHash || info.lca.causalHash == Just info.bob.causalHash) do + Cli.respond (Output.MergeAlreadyUpToDate2 mergeSourceAndTarget) + done () + + -- Otherwise, if LCA == alice (so alice is behind bob), then we could fast forward to bob, so we're done. + when (info.lca.causalHash == Just info.alice.causalHash) do + bobBranch <- liftIO (Codebase.expectBranchForHash codebase info.bob.causalHash) + _ <- Cli.updateAt info.description alicePath (\_aliceBranch -> bobBranch) + Cli.respond (Output.MergeSuccessFastForward mergeSourceAndTarget) + done () + + -- Create a bunch of cached database lookup functions + db <- makeMergeDatabase codebase + + -- Load Alice/Bob/LCA causals + causals <- Cli.runTransaction do + traverse + Operations.expectCausalBranchByCausalHash + TwoOrThreeWay + { alice = info.alice.causalHash, + bob = info.bob.causalHash, + lca = info.lca.causalHash + } - hydratedThings <- do - Cli.runTransaction do - for ((,) <$> conflicts <*> dependents) \(conflicts1, dependents1) -> - let hydrate = hydrateDefns (Codebase.unsafeGetTermComponent codebase) Operations.expectDeclComponent - in (,) <$> hydrate conflicts1 <*> hydrate dependents1 - - let (renderedConflicts, renderedDependents) = - let honk declNameLookup ppe defns = - let (types, accessorNames) = - Writer.runWriter $ - defns.types & Map.traverseWithKey \name (ref, typ) -> - renderTypeBinding - -- Sort of a hack; since the decl printer looks in the PPE for names of constructors, - -- we just delete all term names out and add back the constructors... - -- probably no need to wipe out the suffixified side but we do it anyway - (setPpedToConstructorNames declNameLookup name ref ppe) - name - ref - typ - terms = - defns.terms & Map.mapMaybeWithKey \name (term, typ) -> - if Set.member name accessorNames - then Nothing - else Just (renderTermBinding ppe.suffixifiedPPE name term typ) - in Defns {terms, types} - in unzip $ - ( \declNameLookup (conflicts, dependents) ppe -> - let honk1 = honk declNameLookup ppe - in (honk1 conflicts, honk1 dependents) - ) - <$> declNameLookups - <*> hydratedThings - <*> ppes - - let prettyUnisonFile = - makePrettyUnisonFile - TwoWay - { alice = into @Text aliceBranchNames, - bob = - case info.bob.source of - MergeSource'LocalProjectBranch bobBranchNames -> into @Text bobBranchNames - MergeSource'RemoteProjectBranch bobBranchNames - | aliceBranchNames == bobBranchNames -> "remote " <> into @Text bobBranchNames - | otherwise -> into @Text bobBranchNames - MergeSource'RemoteLooseCode info -> - case Path.toName info.path of - Nothing -> "" - Just name -> Name.toText name - MergeSource'RemoteGitRepo info -> - case Path.toName info.path of - Nothing -> "" - Just name -> Name.toText name - } - renderedConflicts - renderedDependents - - let stageOneBranch = defnsAndLibdepsToBranch0 codebase stageOne mergedLibdeps - - maybeTypecheckedUnisonFile <- - let thisMergeHasConflicts = - -- Eh, they'd either both be null, or neither, but just check both maps anyway - not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob) - in if thisMergeHasConflicts - then pure Nothing - else do - currentPath <- Cli.getCurrentPath - parsingEnv <- makeParsingEnv currentPath (Branch.toNames stageOneBranch) - prettyParseTypecheck2 prettyUnisonFile parsingEnv <&> eitherToMaybe - - let parents = - (\causal -> (causal.causalHash, Codebase.expectBranchForHash codebase causal.causalHash)) <$> causals - - case maybeTypecheckedUnisonFile of - Nothing -> do - Cli.Env {writeSource} <- ask - _temporaryBranchId <- - HandleInput.Branch.doCreateBranch' - (Branch.mergeNode stageOneBranch parents.alice parents.bob) - Nothing - info.alice.projectAndBranch.project - (findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget) - info.description - scratchFilePath <- - Cli.getLatestFile <&> \case - Nothing -> "scratch.u" - Just (file, _) -> file - liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) - Cli.respond (Output.MergeFailure scratchFilePath mergeSourceAndTarget) - Just tuf -> do - Cli.runTransaction (Codebase.addDefsToCodebase codebase tuf) - let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch - _ <- - Cli.updateAt - info.description - alicePath - (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) - Cli.respond (Output.MergeSuccess mergeSourceAndTarget) + liftIO (debugFunctions.debugCausals causals) + + -- Load Alice/Bob/LCA branches + branches <- + Cli.runTransaction do + alice <- causals.alice.value + bob <- causals.bob.value + lca <- for causals.lca \causal -> causal.value + pure TwoOrThreeWay {lca, alice, bob} + + -- Assert that neither Alice nor Bob have defns in lib + for_ [(mergeTarget, branches.alice), (mergeSource, branches.bob)] \(who, branch) -> do + libdeps <- + case Map.lookup NameSegment.libSegment branch.children of + Nothing -> pure V2.Branch.empty + Just libdeps -> Cli.runTransaction libdeps.value + when (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) do + Cli.returnEarly (Output.MergeDefnsInLib who) + + -- Load Alice/Bob/LCA definitions and decl name lookups + (defns3, declNameLookups3) <- do + let load = \case + Nothing -> + pure + ( Nametree {value = Defns Map.empty Map.empty, children = Map.empty}, + DeclNameLookup Map.empty Map.empty + ) + Just (who, branch) -> do + defns <- + Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) & onLeftM \conflictedName -> + Cli.returnEarly case conflictedName of + ConflictedName'Term name refs -> Output.MergeConflictedTermName name refs + ConflictedName'Type name refs -> Output.MergeConflictedTypeName name refs + declNameLookup <- + Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) & onLeftM \err -> + Cli.returnEarly case err of + IncoherentDeclReason'ConstructorAlias name1 name2 -> + Output.MergeConstructorAlias who name1 name2 + IncoherentDeclReason'MissingConstructorName name -> Output.MergeMissingConstructorName who name + IncoherentDeclReason'NestedDeclAlias shorterName longerName -> + Output.MergeNestedDeclAlias who shorterName longerName + IncoherentDeclReason'StrayConstructor name -> Output.MergeStrayConstructor who name + pure (defns, declNameLookup) + + (aliceDefns0, aliceDeclNameLookup) <- load (Just (Just mergeTarget, branches.alice)) + (bobDefns0, bobDeclNameLookup) <- load (Just (Just mergeSource, branches.bob)) + (lcaDefns0, lcaDeclNameLookup) <- load ((Nothing,) <$> branches.lca) + + let flatten defns = Defns (flattenNametree (view #terms) defns) (flattenNametree (view #types) defns) + let defns3 = flatten <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} + let declNameLookups3 = ThreeWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup, lca = lcaDeclNameLookup} + + pure (defns3, declNameLookups3) + + let defns = ThreeWay.forgetLca defns3 + let declNameLookups = ThreeWay.forgetLca declNameLookups3 + + liftIO (debugFunctions.debugDefns defns3 declNameLookups3) + + -- Diff LCA->Alice and LCA->Bob + diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups3 defns3) + + liftIO (debugFunctions.debugDiffs diffs) + + -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias + for_ ((,) <$> TwoWay mergeTarget mergeSource <*> diffs) \(who, diff) -> + whenJust (findConflictedAlias defns3.lca diff) \(name1, name2) -> + Cli.returnEarly (Output.MergeConflictedAliases who name1 name2) + + -- Combine the LCA->Alice and LCA->Bob diffs together + let diff = combineDiffs diffs + + liftIO (debugFunctions.debugCombinedDiff diff) + + -- Partition the combined diff into the conflicted things and the unconflicted things + (conflicts, unconflicts) <- + partitionCombinedDiffs defns declNameLookups diff & onLeft \name -> + Cli.returnEarly (Output.MergeConflictInvolvingBuiltin name) + + liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts) + + -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if there + -- aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) + dependents <- Cli.runTransaction (identifyDependents defns conflicts unconflicts) + + liftIO (debugFunctions.debugDependents dependents) + + let stageOne :: DefnsF (Map Name) Referent TypeReference + stageOne = + makeStageOne + declNameLookups + conflicts + unconflicts + dependents + (bimap BiMultimap.range BiMultimap.range defns3.lca) + + liftIO (debugFunctions.debugStageOne stageOne) + + -- Load and merge Alice's and Bob's libdeps + mergedLibdeps <- + Cli.runTransaction do + libdeps <- loadLibdeps branches + libdepsToBranch0 db (Merge.mergeLibdeps getTwoFreshNames libdeps) + + -- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names + let mkPpes :: TwoWay Names -> Names -> TwoWay PrettyPrintEnvDecl + mkPpes defnsNames libdepsNames = + defnsNames <&> \names -> PPED.makePPED (PPE.namer (names <> libdepsNames)) suffixifier + where + suffixifier = PPE.suffixifyByName (fold defnsNames <> libdepsNames) + let ppes = mkPpes (defnsToNames <$> defns) (Branch.toNames mergedLibdeps) + + hydratedThings <- do + Cli.runTransaction do + for ((,) <$> conflicts <*> dependents) \(conflicts1, dependents1) -> + let hydrate = hydrateDefns (Codebase.unsafeGetTermComponent codebase) Operations.expectDeclComponent + in (,) <$> hydrate conflicts1 <*> hydrate dependents1 + + let (renderedConflicts, renderedDependents) = + let honk declNameLookup ppe defns = + let (types, accessorNames) = + Writer.runWriter $ + defns.types & Map.traverseWithKey \name (ref, typ) -> + renderTypeBinding + -- Sort of a hack; since the decl printer looks in the PPE for names of constructors, + -- we just delete all term names out and add back the constructors... + -- probably no need to wipe out the suffixified side but we do it anyway + (setPpedToConstructorNames declNameLookup name ref ppe) + name + ref + typ + terms = + defns.terms & Map.mapMaybeWithKey \name (term, typ) -> + if Set.member name accessorNames + then Nothing + else Just (renderTermBinding ppe.suffixifiedPPE name term typ) + in Defns {terms, types} + in unzip $ + ( \declNameLookup (conflicts, dependents) ppe -> + let honk1 = honk declNameLookup ppe + in (honk1 conflicts, honk1 dependents) + ) + <$> declNameLookups + <*> hydratedThings + <*> ppes + + let prettyUnisonFile = + makePrettyUnisonFile + TwoWay + { alice = into @Text aliceBranchNames, + bob = + case info.bob.source of + MergeSource'LocalProjectBranch bobBranchNames -> into @Text bobBranchNames + MergeSource'RemoteProjectBranch bobBranchNames + | aliceBranchNames == bobBranchNames -> "remote " <> into @Text bobBranchNames + | otherwise -> into @Text bobBranchNames + MergeSource'RemoteLooseCode info -> + case Path.toName info.path of + Nothing -> "" + Just name -> Name.toText name + MergeSource'RemoteGitRepo info -> + case Path.toName info.path of + Nothing -> "" + Just name -> Name.toText name + } + renderedConflicts + renderedDependents + + let stageOneBranch = defnsAndLibdepsToBranch0 codebase stageOne mergedLibdeps + + maybeTypecheckedUnisonFile <- + let thisMergeHasConflicts = + -- Eh, they'd either both be null, or neither, but just check both maps anyway + not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob) + in if thisMergeHasConflicts + then pure Nothing + else do + currentPath <- Cli.getCurrentPath + parsingEnv <- makeParsingEnv currentPath (Branch.toNames stageOneBranch) + prettyParseTypecheck2 prettyUnisonFile parsingEnv <&> eitherToMaybe + + let parents = + (\causal -> (causal.causalHash, Codebase.expectBranchForHash codebase causal.causalHash)) <$> causals + + case maybeTypecheckedUnisonFile of + Nothing -> do + Cli.Env {writeSource} <- ask + _temporaryBranchId <- + HandleInput.Branch.doCreateBranch' + (Branch.mergeNode stageOneBranch parents.alice parents.bob) + Nothing + info.alice.projectAndBranch.project + (findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget) + info.description + scratchFilePath <- + Cli.getLatestFile <&> \case + Nothing -> "scratch.u" + Just (file, _) -> file + liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) + Cli.respond (Output.MergeFailure scratchFilePath mergeSourceAndTarget) + Just tuf -> do + Cli.runTransaction (Codebase.addDefsToCodebase codebase tuf) + let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch + _ <- + Cli.updateAt + info.description + alicePath + (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) + Cli.respond (Output.MergeSuccess mergeSourceAndTarget) doMergeLocalBranch :: TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () doMergeLocalBranch branches = do diff --git a/unison-src/transcripts/upgrade-sad-path.md b/unison-src/transcripts/upgrade-sad-path.md index a27b75f0c9..e0e87f2187 100644 --- a/unison-src/transcripts/upgrade-sad-path.md +++ b/unison-src/transcripts/upgrade-sad-path.md @@ -27,4 +27,5 @@ thingy = foo + +10 proj/upgrade-old-to-new> upgrade.commit proj/main> view thingy proj/main> ls lib +proj/main> branches ``` diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md index 718a4c5009..627a245966 100644 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ b/unison-src/transcripts/upgrade-sad-path.output.md @@ -86,4 +86,9 @@ proj/main> ls lib 1. builtin/ (469 terms, 74 types) 2. new/ (1 term) +proj/main> branches + + Branch Remote branch + 1. main + ``` From ce9110be46b7a92a46c78bf68f8536536bdaa16a Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 20 May 2024 14:21:06 -0400 Subject: [PATCH 007/631] Add `merge.commit` command --- unison-cli/src/Unison/Cli/ProjectUtils.hs | 14 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 3 + .../Editor/HandleInput/CommitMerge.hs | 57 +++ .../Editor/HandleInput/CommitUpgrade.hs | 2 + .../Codebase/Editor/HandleInput/Merge2.hs | 471 +++++++++--------- .../src/Unison/Codebase/Editor/Input.hs | 1 + .../src/Unison/Codebase/Editor/Output.hs | 2 + .../src/Unison/CommandLine/InputPatterns.hs | 14 + .../src/Unison/CommandLine/OutputMessages.hs | 2 + unison-cli/unison-cli.cabal | 1 + unison-src/transcripts/merge.md | 66 +++ unison-src/transcripts/merge.output.md | 90 ++++ 12 files changed, 487 insertions(+), 236 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index 66eb87414c..8ffbf752de 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -46,7 +46,8 @@ module Unison.Cli.ProjectUtils findTemporaryBranchName, expectLatestReleaseBranchName, - -- * Upgrade branch utils + -- * Merge/upgrade branch utils + getMergeBranchParent, getUpgradeBranchParent, ) where @@ -407,6 +408,17 @@ expectLatestReleaseBranchName remoteProject = Nothing -> Cli.returnEarly (Output.ProjectHasNoReleases remoteProject.projectName) Just semver -> pure (UnsafeProjectBranchName ("releases/" <> into @Text semver)) +-- | @getMergeBranchParent branch@ returns the parent branch of a "merge" branch. +-- +-- When a merge fails, we put you on a branch called `merge--into-`. That's a "merge" branch. It's not +-- currently distinguished in the database, so we first just switch on whether its name begins with "merge-". If it +-- does, then we get the branch's parent, which should exist, but perhaps wouldn't if the user had manually made a +-- parentless branch called "merge-whatever" for whatever reason. +getMergeBranchParent :: Sqlite.ProjectBranch -> Maybe ProjectBranchId +getMergeBranchParent branch = do + guard ("merge-" `Text.isPrefixOf` into @Text branch.name) + branch.parentBranchId + -- | @getUpgradeBranchParent branch@ returns the parent branch of an "upgrade" branch. -- -- When an upgrade fails, we put you on a branch called `upgrade--to-`. That's an "upgrade" branch. It's not diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 376f521a86..64598461a9 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -57,6 +57,7 @@ import Unison.Codebase.Editor.HandleInput.AuthLogin (authLogin) import Unison.Codebase.Editor.HandleInput.Branch (handleBranch) import Unison.Codebase.Editor.HandleInput.BranchRename (handleBranchRename) import Unison.Codebase.Editor.HandleInput.Branches (handleBranches) +import Unison.Codebase.Editor.HandleInput.CommitMerge (handleCommitMerge) import Unison.Codebase.Editor.HandleInput.CommitUpgrade (handleCommitUpgrade) import Unison.Codebase.Editor.HandleInput.DebugDefinition qualified as DebugDefinition import Unison.Codebase.Editor.HandleInput.DebugFoldRanges qualified as DebugFoldRanges @@ -428,6 +429,7 @@ loop e = do then Success else BranchEmpty branchEmpty MergeI branch -> handleMerge branch + MergeCommitI -> handleCommitMerge MergeLocalBranchI src0 dest0 mergeMode -> do description <- inputDescription input src0 <- ProjectUtils.expectLooseCodeOrProjectBranch src0 @@ -1385,6 +1387,7 @@ inputDescription input = ListEditsI {} -> wat LoadI {} -> wat MergeI {} -> wat + MergeCommitI {} -> wat NamesI {} -> wat NamespaceDependenciesI {} -> wat PopBranchI {} -> wat diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs new file mode 100644 index 0000000000..4f8abd347f --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs @@ -0,0 +1,57 @@ +-- | @merge.commit@ handler. +module Unison.Codebase.Editor.HandleInput.CommitMerge + ( handleCommitMerge, + ) +where + +import U.Codebase.Sqlite.Project qualified +import U.Codebase.Sqlite.Queries qualified as Queries +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Codebase.Editor.HandleInput.DeleteBranch qualified as DeleteBranch +import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge +import Unison.Codebase.Editor.HandleInput.ProjectSwitch qualified as ProjectSwitch +import Unison.Codebase.Editor.HandleInput.Update2 qualified as Update +import Unison.Codebase.Editor.Output qualified as Output +import Unison.Merge.TwoWay (TwoWay (..)) +import Unison.Prelude +import Unison.Project (ProjectAndBranch (..)) + +-- Note: this implementation is similar to `upgrade.commit`. + +handleCommitMerge :: Cli () +handleCommitMerge = do + (mergeProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch + + -- Assert that this is a "merge" branch and get its parent, which is the branch we were on when we ran `merge`. + + parentBranchId <- + ProjectUtils.getMergeBranchParent mergeProjectAndBranch.branch + & onNothing (Cli.returnEarly Output.NoMergeInProgress) + parentBranch <- + Cli.runTransaction do + Queries.expectProjectBranch mergeProjectAndBranch.project.projectId parentBranchId + + let parentProjectAndBranch = + ProjectAndBranch mergeProjectAndBranch.project parentBranch + + -- Run `update` + + Update.handleUpdate2 + + -- Switch to the parent + + ProjectSwitch.switchToProjectBranch (ProjectUtils.justTheIds parentProjectAndBranch) + + -- Merge the merge branch into the parent + + Merge.doMergeLocalBranch + TwoWay + { alice = parentProjectAndBranch, + bob = mergeProjectAndBranch + } + + -- Delete the merge branch + + DeleteBranch.doDeleteProjectBranch mergeProjectAndBranch diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs index 901dada1e4..6717bcbbc2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs @@ -18,6 +18,8 @@ import Unison.Merge.TwoWay (TwoWay (..)) import Unison.Prelude import Unison.Project (ProjectAndBranch (..)) +-- Note: this implementation is similar to `merge.commit`. + handleCommitUpgrade :: Cli () handleCommitUpgrade = do (upgradeProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 265cd9d06c..fa3ed37fea 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -199,241 +199,242 @@ doMerge info = do Cli.Env {codebase} <- ask - Cli.label \done -> do - -- If alice == bob, or LCA == bob (so alice is ahead of bob), then we are done. - when (info.alice.causalHash == info.bob.causalHash || info.lca.causalHash == Just info.bob.causalHash) do - Cli.respond (Output.MergeAlreadyUpToDate2 mergeSourceAndTarget) - done () - - -- Otherwise, if LCA == alice (so alice is behind bob), then we could fast forward to bob, so we're done. - when (info.lca.causalHash == Just info.alice.causalHash) do - bobBranch <- liftIO (Codebase.expectBranchForHash codebase info.bob.causalHash) - _ <- Cli.updateAt info.description alicePath (\_aliceBranch -> bobBranch) - Cli.respond (Output.MergeSuccessFastForward mergeSourceAndTarget) - done () - - -- Create a bunch of cached database lookup functions - db <- makeMergeDatabase codebase - - -- Load Alice/Bob/LCA causals - causals <- Cli.runTransaction do - traverse - Operations.expectCausalBranchByCausalHash - TwoOrThreeWay - { alice = info.alice.causalHash, - bob = info.bob.causalHash, - lca = info.lca.causalHash - } - - liftIO (debugFunctions.debugCausals causals) - - -- Load Alice/Bob/LCA branches - branches <- - Cli.runTransaction do - alice <- causals.alice.value - bob <- causals.bob.value - lca <- for causals.lca \causal -> causal.value - pure TwoOrThreeWay {lca, alice, bob} - - -- Assert that neither Alice nor Bob have defns in lib - for_ [(mergeTarget, branches.alice), (mergeSource, branches.bob)] \(who, branch) -> do - libdeps <- - case Map.lookup NameSegment.libSegment branch.children of - Nothing -> pure V2.Branch.empty - Just libdeps -> Cli.runTransaction libdeps.value - when (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) do - Cli.returnEarly (Output.MergeDefnsInLib who) - - -- Load Alice/Bob/LCA definitions and decl name lookups - (defns3, declNameLookups3) <- do - let load = \case - Nothing -> - pure - ( Nametree {value = Defns Map.empty Map.empty, children = Map.empty}, - DeclNameLookup Map.empty Map.empty - ) - Just (who, branch) -> do - defns <- - Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) & onLeftM \conflictedName -> - Cli.returnEarly case conflictedName of - ConflictedName'Term name refs -> Output.MergeConflictedTermName name refs - ConflictedName'Type name refs -> Output.MergeConflictedTypeName name refs - declNameLookup <- - Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) & onLeftM \err -> - Cli.returnEarly case err of - IncoherentDeclReason'ConstructorAlias name1 name2 -> - Output.MergeConstructorAlias who name1 name2 - IncoherentDeclReason'MissingConstructorName name -> Output.MergeMissingConstructorName who name - IncoherentDeclReason'NestedDeclAlias shorterName longerName -> - Output.MergeNestedDeclAlias who shorterName longerName - IncoherentDeclReason'StrayConstructor name -> Output.MergeStrayConstructor who name - pure (defns, declNameLookup) - - (aliceDefns0, aliceDeclNameLookup) <- load (Just (Just mergeTarget, branches.alice)) - (bobDefns0, bobDeclNameLookup) <- load (Just (Just mergeSource, branches.bob)) - (lcaDefns0, lcaDeclNameLookup) <- load ((Nothing,) <$> branches.lca) - - let flatten defns = Defns (flattenNametree (view #terms) defns) (flattenNametree (view #types) defns) - let defns3 = flatten <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} - let declNameLookups3 = ThreeWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup, lca = lcaDeclNameLookup} - - pure (defns3, declNameLookups3) - - let defns = ThreeWay.forgetLca defns3 - let declNameLookups = ThreeWay.forgetLca declNameLookups3 - - liftIO (debugFunctions.debugDefns defns3 declNameLookups3) - - -- Diff LCA->Alice and LCA->Bob - diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups3 defns3) - - liftIO (debugFunctions.debugDiffs diffs) - - -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias - for_ ((,) <$> TwoWay mergeTarget mergeSource <*> diffs) \(who, diff) -> - whenJust (findConflictedAlias defns3.lca diff) \(name1, name2) -> - Cli.returnEarly (Output.MergeConflictedAliases who name1 name2) - - -- Combine the LCA->Alice and LCA->Bob diffs together - let diff = combineDiffs diffs - - liftIO (debugFunctions.debugCombinedDiff diff) - - -- Partition the combined diff into the conflicted things and the unconflicted things - (conflicts, unconflicts) <- - partitionCombinedDiffs defns declNameLookups diff & onLeft \name -> - Cli.returnEarly (Output.MergeConflictInvolvingBuiltin name) - - liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts) - - -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if there - -- aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) - dependents <- Cli.runTransaction (identifyDependents defns conflicts unconflicts) - - liftIO (debugFunctions.debugDependents dependents) - - let stageOne :: DefnsF (Map Name) Referent TypeReference - stageOne = - makeStageOne - declNameLookups - conflicts - unconflicts - dependents - (bimap BiMultimap.range BiMultimap.range defns3.lca) - - liftIO (debugFunctions.debugStageOne stageOne) - - -- Load and merge Alice's and Bob's libdeps - mergedLibdeps <- - Cli.runTransaction do - libdeps <- loadLibdeps branches - libdepsToBranch0 db (Merge.mergeLibdeps getTwoFreshNames libdeps) - - -- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names - let mkPpes :: TwoWay Names -> Names -> TwoWay PrettyPrintEnvDecl - mkPpes defnsNames libdepsNames = - defnsNames <&> \names -> PPED.makePPED (PPE.namer (names <> libdepsNames)) suffixifier - where - suffixifier = PPE.suffixifyByName (fold defnsNames <> libdepsNames) - let ppes = mkPpes (defnsToNames <$> defns) (Branch.toNames mergedLibdeps) - - hydratedThings <- do - Cli.runTransaction do - for ((,) <$> conflicts <*> dependents) \(conflicts1, dependents1) -> - let hydrate = hydrateDefns (Codebase.unsafeGetTermComponent codebase) Operations.expectDeclComponent - in (,) <$> hydrate conflicts1 <*> hydrate dependents1 - - let (renderedConflicts, renderedDependents) = - let honk declNameLookup ppe defns = - let (types, accessorNames) = - Writer.runWriter $ - defns.types & Map.traverseWithKey \name (ref, typ) -> - renderTypeBinding - -- Sort of a hack; since the decl printer looks in the PPE for names of constructors, - -- we just delete all term names out and add back the constructors... - -- probably no need to wipe out the suffixified side but we do it anyway - (setPpedToConstructorNames declNameLookup name ref ppe) - name - ref - typ - terms = - defns.terms & Map.mapMaybeWithKey \name (term, typ) -> - if Set.member name accessorNames - then Nothing - else Just (renderTermBinding ppe.suffixifiedPPE name term typ) - in Defns {terms, types} - in unzip $ - ( \declNameLookup (conflicts, dependents) ppe -> - let honk1 = honk declNameLookup ppe - in (honk1 conflicts, honk1 dependents) - ) - <$> declNameLookups - <*> hydratedThings - <*> ppes - - let prettyUnisonFile = - makePrettyUnisonFile - TwoWay - { alice = into @Text aliceBranchNames, - bob = - case info.bob.source of - MergeSource'LocalProjectBranch bobBranchNames -> into @Text bobBranchNames - MergeSource'RemoteProjectBranch bobBranchNames - | aliceBranchNames == bobBranchNames -> "remote " <> into @Text bobBranchNames - | otherwise -> into @Text bobBranchNames - MergeSource'RemoteLooseCode info -> - case Path.toName info.path of - Nothing -> "" - Just name -> Name.toText name - MergeSource'RemoteGitRepo info -> - case Path.toName info.path of - Nothing -> "" - Just name -> Name.toText name - } - renderedConflicts - renderedDependents - - let stageOneBranch = defnsAndLibdepsToBranch0 codebase stageOne mergedLibdeps - - maybeTypecheckedUnisonFile <- - let thisMergeHasConflicts = - -- Eh, they'd either both be null, or neither, but just check both maps anyway - not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob) - in if thisMergeHasConflicts - then pure Nothing - else do - currentPath <- Cli.getCurrentPath - parsingEnv <- makeParsingEnv currentPath (Branch.toNames stageOneBranch) - prettyParseTypecheck2 prettyUnisonFile parsingEnv <&> eitherToMaybe - - let parents = - (\causal -> (causal.causalHash, Codebase.expectBranchForHash codebase causal.causalHash)) <$> causals - - case maybeTypecheckedUnisonFile of - Nothing -> do - Cli.Env {writeSource} <- ask - _temporaryBranchId <- - HandleInput.Branch.doCreateBranch' - (Branch.mergeNode stageOneBranch parents.alice parents.bob) - Nothing - info.alice.projectAndBranch.project - (findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget) - info.description - scratchFilePath <- - Cli.getLatestFile <&> \case - Nothing -> "scratch.u" - Just (file, _) -> file - liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) - Cli.respond (Output.MergeFailure scratchFilePath mergeSourceAndTarget) - Just tuf -> do - Cli.runTransaction (Codebase.addDefsToCodebase codebase tuf) - let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch - _ <- - Cli.updateAt - info.description - alicePath - (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) - Cli.respond (Output.MergeSuccess mergeSourceAndTarget) + finalOutput <- + Cli.label \done -> do + -- If alice == bob, or LCA == bob (so alice is ahead of bob), then we are done. + when (info.alice.causalHash == info.bob.causalHash || info.lca.causalHash == Just info.bob.causalHash) do + done (Output.MergeAlreadyUpToDate2 mergeSourceAndTarget) + + -- Otherwise, if LCA == alice (so alice is behind bob), then we could fast forward to bob, so we're done. + when (info.lca.causalHash == Just info.alice.causalHash) do + bobBranch <- liftIO (Codebase.expectBranchForHash codebase info.bob.causalHash) + _ <- Cli.updateAt info.description alicePath (\_aliceBranch -> bobBranch) + done (Output.MergeSuccessFastForward mergeSourceAndTarget) + + -- Create a bunch of cached database lookup functions + db <- makeMergeDatabase codebase + + -- Load Alice/Bob/LCA causals + causals <- Cli.runTransaction do + traverse + Operations.expectCausalBranchByCausalHash + TwoOrThreeWay + { alice = info.alice.causalHash, + bob = info.bob.causalHash, + lca = info.lca.causalHash + } + + liftIO (debugFunctions.debugCausals causals) + + -- Load Alice/Bob/LCA branches + branches <- + Cli.runTransaction do + alice <- causals.alice.value + bob <- causals.bob.value + lca <- for causals.lca \causal -> causal.value + pure TwoOrThreeWay {lca, alice, bob} + + -- Assert that neither Alice nor Bob have defns in lib + for_ [(mergeTarget, branches.alice), (mergeSource, branches.bob)] \(who, branch) -> do + libdeps <- + case Map.lookup NameSegment.libSegment branch.children of + Nothing -> pure V2.Branch.empty + Just libdeps -> Cli.runTransaction libdeps.value + when (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) do + done (Output.MergeDefnsInLib who) + + -- Load Alice/Bob/LCA definitions and decl name lookups + (defns3, declNameLookups3) <- do + let load = \case + Nothing -> + pure + ( Nametree {value = Defns Map.empty Map.empty, children = Map.empty}, + DeclNameLookup Map.empty Map.empty + ) + Just (who, branch) -> do + defns <- + Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) & onLeftM \conflictedName -> + done case conflictedName of + ConflictedName'Term name refs -> Output.MergeConflictedTermName name refs + ConflictedName'Type name refs -> Output.MergeConflictedTypeName name refs + declNameLookup <- + Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) & onLeftM \err -> + done case err of + IncoherentDeclReason'ConstructorAlias name1 name2 -> + Output.MergeConstructorAlias who name1 name2 + IncoherentDeclReason'MissingConstructorName name -> Output.MergeMissingConstructorName who name + IncoherentDeclReason'NestedDeclAlias shorterName longerName -> + Output.MergeNestedDeclAlias who shorterName longerName + IncoherentDeclReason'StrayConstructor name -> Output.MergeStrayConstructor who name + pure (defns, declNameLookup) + + (aliceDefns0, aliceDeclNameLookup) <- load (Just (Just mergeTarget, branches.alice)) + (bobDefns0, bobDeclNameLookup) <- load (Just (Just mergeSource, branches.bob)) + (lcaDefns0, lcaDeclNameLookup) <- load ((Nothing,) <$> branches.lca) + + let flatten defns = Defns (flattenNametree (view #terms) defns) (flattenNametree (view #types) defns) + let defns3 = flatten <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} + let declNameLookups3 = ThreeWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup, lca = lcaDeclNameLookup} + + pure (defns3, declNameLookups3) + + let defns = ThreeWay.forgetLca defns3 + let declNameLookups = ThreeWay.forgetLca declNameLookups3 + + liftIO (debugFunctions.debugDefns defns3 declNameLookups3) + + -- Diff LCA->Alice and LCA->Bob + diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups3 defns3) + + liftIO (debugFunctions.debugDiffs diffs) + + -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias + for_ ((,) <$> TwoWay mergeTarget mergeSource <*> diffs) \(who, diff) -> + whenJust (findConflictedAlias defns3.lca diff) \(name1, name2) -> + done (Output.MergeConflictedAliases who name1 name2) + + -- Combine the LCA->Alice and LCA->Bob diffs together + let diff = combineDiffs diffs + + liftIO (debugFunctions.debugCombinedDiff diff) + + -- Partition the combined diff into the conflicted things and the unconflicted things + (conflicts, unconflicts) <- + partitionCombinedDiffs defns declNameLookups diff & onLeft \name -> + done (Output.MergeConflictInvolvingBuiltin name) + + liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts) + + -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if there + -- aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) + dependents <- Cli.runTransaction (identifyDependents defns conflicts unconflicts) + + liftIO (debugFunctions.debugDependents dependents) + + let stageOne :: DefnsF (Map Name) Referent TypeReference + stageOne = + makeStageOne + declNameLookups + conflicts + unconflicts + dependents + (bimap BiMultimap.range BiMultimap.range defns3.lca) + + liftIO (debugFunctions.debugStageOne stageOne) + + -- Load and merge Alice's and Bob's libdeps + mergedLibdeps <- + Cli.runTransaction do + libdeps <- loadLibdeps branches + libdepsToBranch0 db (Merge.mergeLibdeps getTwoFreshNames libdeps) + + -- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names + let mkPpes :: TwoWay Names -> Names -> TwoWay PrettyPrintEnvDecl + mkPpes defnsNames libdepsNames = + defnsNames <&> \names -> PPED.makePPED (PPE.namer (names <> libdepsNames)) suffixifier + where + suffixifier = PPE.suffixifyByName (fold defnsNames <> libdepsNames) + let ppes = mkPpes (defnsToNames <$> defns) (Branch.toNames mergedLibdeps) + + hydratedThings <- do + Cli.runTransaction do + for ((,) <$> conflicts <*> dependents) \(conflicts1, dependents1) -> + let hydrate = hydrateDefns (Codebase.unsafeGetTermComponent codebase) Operations.expectDeclComponent + in (,) <$> hydrate conflicts1 <*> hydrate dependents1 + + let (renderedConflicts, renderedDependents) = + let honk declNameLookup ppe defns = + let (types, accessorNames) = + Writer.runWriter $ + defns.types & Map.traverseWithKey \name (ref, typ) -> + renderTypeBinding + -- Sort of a hack; since the decl printer looks in the PPE for names of constructors, + -- we just delete all term names out and add back the constructors... + -- probably no need to wipe out the suffixified side but we do it anyway + (setPpedToConstructorNames declNameLookup name ref ppe) + name + ref + typ + terms = + defns.terms & Map.mapMaybeWithKey \name (term, typ) -> + if Set.member name accessorNames + then Nothing + else Just (renderTermBinding ppe.suffixifiedPPE name term typ) + in Defns {terms, types} + in unzip $ + ( \declNameLookup (conflicts, dependents) ppe -> + let honk1 = honk declNameLookup ppe + in (honk1 conflicts, honk1 dependents) + ) + <$> declNameLookups + <*> hydratedThings + <*> ppes + + let prettyUnisonFile = + makePrettyUnisonFile + TwoWay + { alice = into @Text aliceBranchNames, + bob = + case info.bob.source of + MergeSource'LocalProjectBranch bobBranchNames -> into @Text bobBranchNames + MergeSource'RemoteProjectBranch bobBranchNames + | aliceBranchNames == bobBranchNames -> "remote " <> into @Text bobBranchNames + | otherwise -> into @Text bobBranchNames + MergeSource'RemoteLooseCode info -> + case Path.toName info.path of + Nothing -> "" + Just name -> Name.toText name + MergeSource'RemoteGitRepo info -> + case Path.toName info.path of + Nothing -> "" + Just name -> Name.toText name + } + renderedConflicts + renderedDependents + + let stageOneBranch = defnsAndLibdepsToBranch0 codebase stageOne mergedLibdeps + + maybeTypecheckedUnisonFile <- + let thisMergeHasConflicts = + -- Eh, they'd either both be null, or neither, but just check both maps anyway + not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob) + in if thisMergeHasConflicts + then pure Nothing + else do + currentPath <- Cli.getCurrentPath + parsingEnv <- makeParsingEnv currentPath (Branch.toNames stageOneBranch) + prettyParseTypecheck2 prettyUnisonFile parsingEnv <&> eitherToMaybe + + let parents = + (\causal -> (causal.causalHash, Codebase.expectBranchForHash codebase causal.causalHash)) <$> causals + + case maybeTypecheckedUnisonFile of + Nothing -> do + Cli.Env {writeSource} <- ask + _temporaryBranchId <- + HandleInput.Branch.doCreateBranch' + (Branch.mergeNode stageOneBranch parents.alice parents.bob) + (Just info.alice.projectAndBranch.branch.branchId) + info.alice.projectAndBranch.project + (findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget) + info.description + scratchFilePath <- + Cli.getLatestFile <&> \case + Nothing -> "scratch.u" + Just (file, _) -> file + liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) + pure (Output.MergeFailure scratchFilePath mergeSourceAndTarget) + Just tuf -> do + Cli.runTransaction (Codebase.addDefsToCodebase codebase tuf) + let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch + _ <- + Cli.updateAt + info.description + alicePath + (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) + pure (Output.MergeSuccess mergeSourceAndTarget) + + Cli.respond finalOutput doMergeLocalBranch :: TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () doMergeLocalBranch branches = do diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index e1ee2c73ee..7bd0b82f17 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -243,6 +243,7 @@ data Input MergeI (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) | LibInstallI !(ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) | UpgradeCommitI + | MergeCommitI 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 d30c8ef94d..cc1afca815 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -412,6 +412,7 @@ data Output | MergeStrayConstructor !(Maybe MergeSourceOrTarget) !Name | InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment | NoUpgradeInProgress + | NoMergeInProgress data UpdateOrUpgrade = UOUUpdate | UOUUpgrade @@ -656,6 +657,7 @@ isFailure o = case o of MergeStrayConstructor {} -> True InstalledLibdep {} -> False NoUpgradeInProgress {} -> True + NoMergeInProgress {} -> True isNumberedFailure :: NumberedOutput -> Bool isNumberedFailure = \case diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index a281f02ebe..bb978987cd 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1934,6 +1934,19 @@ mergeInputPattern = pure (Input.MergeI branch) } +mergeCommitInputPattern :: InputPattern +mergeCommitInputPattern = + InputPattern + { patternName = "merge.commit", + aliases = ["commit.merge"], + visibility = I.Visible, + args = [], + help = P.wrap $ makeExample' mergeCommitInputPattern <> "commits the current merge.", + parse = \case + [] -> Right Input.MergeCommitI + _ -> Left (I.help mergeCommitInputPattern) + } + parseLooseCodeOrProject :: String -> Maybe Input.LooseCodeOrProject parseLooseCodeOrProject inputString = case (asLooseCode, asBranch) of @@ -3256,6 +3269,7 @@ validInputs = mergeOldPreviewInputPattern, mergeOldSquashInputPattern, mergeInputPattern, + mergeCommitInputPattern, names False, -- names names True, -- names.global namespaceDependencies, diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 18e6e8768f..b5ead1f2d1 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2313,6 +2313,8 @@ notifyUser dir = \case <> P.group (P.text (NameSegment.toEscapedText segment) <> ".") NoUpgradeInProgress -> pure . P.wrap $ "It doesn't look like there's an upgrade in progress." + NoMergeInProgress -> + pure . P.wrap $ "It doesn't look like there's a merge in progress." expectedEmptyPushDest :: WriteRemoteNamespace Void -> Pretty expectedEmptyPushDest namespace = diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 42f38a34eb..6fabb878d8 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -55,6 +55,7 @@ library Unison.Codebase.Editor.HandleInput.Branch Unison.Codebase.Editor.HandleInput.Branches Unison.Codebase.Editor.HandleInput.BranchRename + Unison.Codebase.Editor.HandleInput.CommitMerge Unison.Codebase.Editor.HandleInput.CommitUpgrade Unison.Codebase.Editor.HandleInput.DebugDefinition Unison.Codebase.Editor.HandleInput.DebugFoldRanges diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index d74605f1cb..de95842c59 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -969,6 +969,72 @@ project/alice> merge bob .> project.delete project ``` +## `merge.commit` example + +After merge conflicts are resolved, you can use `merge.commit` rather than `update` + `switch` + `merge` + +`branch.delete` to "commit" your changes. + +```ucm:hide +.> project.create-empty project +project/main> builtins.mergeio +``` + +Original branch: +```unison:hide +foo : Text +foo = "old foo" +``` + +```ucm:hide +project/main> add +project/main> branch alice +``` + +Alice's changes: +```unison:hide +foo : Text +foo = "alices foo" +``` + +```ucm:hide +project/alice> update +project/main> branch bob +``` + +Bob's changes: + +```unison:hide +foo : Text +foo = "bobs foo" +``` + +Attempt to merge: + +```ucm:hide +project/bob> update +``` +```ucm:error +project/alice> merge /bob +``` + +Resolve conflicts and commit: + +```unison +foo : Text +foo = "alice and bobs foo" +``` + +```ucm +project/merge-bob-into-alice> merge.commit +project/alice> view foo +project/alice> branches +``` + +```ucm:hide +.> project.delete project +``` + + ## Precondition violations There are a number of conditions under which we can't perform a merge, and the user will have to fix up the namespace(s) manually before attempting to merge again. diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 6b50339eec..4e575fcde0 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -929,6 +929,96 @@ bob _ = 19 ``` +## `merge.commit` example + +After merge conflicts are resolved, you can use `merge.commit` rather than `update` + `switch` + `merge` + +`branch.delete` to "commit" your changes. + +Original branch: +```unison +foo : Text +foo = "old foo" +``` + +Alice's changes: +```unison +foo : Text +foo = "alices foo" +``` + +Bob's changes: + +```unison +foo : Text +foo = "bobs foo" +``` + +Attempt to merge: + +```ucm +project/alice> merge /bob + + I couldn't automatically merge project/bob into project/alice. + However, I've added the definitions that need attention to the + top of scratch.u. + +``` +```unison:added-by-ucm scratch.u +-- project/alice +foo : Text +foo = "alices foo" + +-- project/bob +foo : Text +foo = "bobs foo" + + +``` + +Resolve conflicts and commit: + +```unison +foo : Text +foo = "alice and bobs foo" +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + foo : Text + +``` +```ucm +project/merge-bob-into-alice> merge.commit + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + + I fast-forward merged project/merge-bob-into-alice into + project/alice. + +project/alice> view foo + + foo : Text + foo = "alice and bobs foo" + +project/alice> branches + + Branch Remote branch + 1. alice + 2. bob + 3. main + +``` ## Precondition violations There are a number of conditions under which we can't perform a merge, and the user will have to fix up the namespace(s) manually before attempting to merge again. From 73145db0d23a5e35ecf98235a76996a29d7631f7 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 20 May 2024 16:08:35 -0700 Subject: [PATCH 008/631] Add Location pt 2 --- .../src/Unison/Codebase/Path.hs | 25 +++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/parser-typechecker/src/Unison/Codebase/Path.hs b/parser-typechecker/src/Unison/Codebase/Path.hs index b911e276f3..839e50a8c7 100644 --- a/parser-typechecker/src/Unison/Codebase/Path.hs +++ b/parser-typechecker/src/Unison/Codebase/Path.hs @@ -5,7 +5,12 @@ module Unison.Codebase.Path Path' (..), Absolute (..), pattern AbsolutePath', + absPath_, + Location (..), + locAbsPath_, + locPath_, Relative (..), + relPath_, pattern RelativePath', Resolve (..), pattern Empty, @@ -89,14 +94,28 @@ import Data.Sequence (Seq ((:<|), (:|>))) import Data.Sequence qualified as Seq import Data.Text qualified as Text import GHC.Exts qualified as GHC +import Unison.Core.Project (ProjectBranchName) import Unison.HashQualified' qualified as HQ' import Unison.Name (Convert (..), Name, Parse) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.Prelude hiding (empty, toList) +import Unison.Project (ProjectName) import Unison.Syntax.Name qualified as Name (toText, unsafeParseText) import Unison.Util.List qualified as List +data Location + = Location ProjectName ProjectBranchName Absolute + +locAbsPath_ :: Lens' Location Absolute +locAbsPath_ = lens go set + where + go (Location _ _ p) = p + set (Location n b _) p = Location n b p + +locPath_ :: Lens' Location Path +locPath_ = locAbsPath_ . absPath_ + -- `Foo.Bar.baz` becomes ["Foo", "Bar", "baz"] newtype Path = Path {toSeq :: Seq NameSegment} deriving stock (Eq, Ord) @@ -111,8 +130,14 @@ instance GHC.IsList Path where newtype Absolute = Absolute {unabsolute :: Path} deriving (Eq, Ord) +absPath_ :: Lens' Absolute Path +absPath_ = lens unabsolute (\_ new -> Absolute new) + newtype Relative = Relative {unrelative :: Path} deriving (Eq, Ord) +relPath_ :: Lens' Relative Path +relPath_ = lens unrelative (\_ new -> Relative new) + newtype Path' = Path' {unPath' :: Either Absolute Relative} deriving (Eq, Ord) From fe751e168557e7843fc8c14aaea3f95df31c09fb Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 20 May 2024 16:12:06 -0700 Subject: [PATCH 009/631] Remove direct access to root branch --- unison-cli/src/Unison/Cli/Monad.hs | 59 ++++++++++--------------- unison-cli/src/Unison/Cli/MonadUtils.hs | 6 +-- 2 files changed, 26 insertions(+), 39 deletions(-) diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index 0ef993cc27..6ccbff582e 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -14,6 +14,7 @@ module Unison.Cli.Monad -- * Immutable state LoopState (..), loopState0, + getCurrentLocation, -- * Lifting IO actions ioE, @@ -52,22 +53,20 @@ module Unison.Cli.Monad where import Control.Exception (throwIO) -import Control.Lens (lens, (.=)) +import Control.Lens import Control.Monad.Reader (MonadReader (..)) import Control.Monad.State.Strict (MonadState) import Control.Monad.State.Strict qualified as State import Data.Configurator.Types qualified as Configurator import Data.List.NonEmpty qualified as List (NonEmpty) import Data.List.NonEmpty qualified as List.NonEmpty +import Data.List.NonEmpty qualified as NonEmpty import Data.Time.Clock (DiffTime, diffTimeToPicoseconds) import Data.Time.Clock.System (getSystemTime, systemToTAITime) import Data.Time.Clock.TAI (diffAbsoluteTime) import Data.Unique (Unique, newUnique) -import GHC.OverloadedLabels (IsLabel (..)) import System.CPUTime (getCPUTime) import Text.Printf (printf) -import U.Codebase.HashTags (CausalHash) -import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Auth.CredentialManager (CredentialManager) import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Codebase (Codebase) @@ -76,10 +75,10 @@ import Unison.Codebase.Branch (Branch) import Unison.Codebase.Editor.Input (Input) import Unison.Codebase.Editor.Output (NumberedArgs, NumberedOutput, Output) import Unison.Codebase.Editor.UCMVersion (UCMVersion) +import Unison.Codebase.Path (locAbsPath_) import Unison.Codebase.Path qualified as Path import Unison.Codebase.Runtime (Runtime) import Unison.Debug qualified as Debug -import Unison.NameSegment qualified as NameSegment import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Server.CodebaseServer qualified as Server @@ -179,10 +178,9 @@ data Env = Env -- -- There's an additional pseudo @"currentPath"@ field lens, for convenience. data LoopState = LoopState - { root :: TMVar (Branch IO), - lastSavedRootHash :: CausalHash, - -- the current position in the namespace - currentPathStack :: List.NonEmpty Path.Absolute, + { currentBranch :: TMVar (Branch IO), + -- the current position in the codebase, with the head being the most recent lcoation. + locationStack :: List.NonEmpty Path.Location, -- TBD -- , _activeEdits :: Set Branch.EditGuid @@ -207,26 +205,12 @@ data LoopState = LoopState } deriving stock (Generic) -instance - {-# OVERLAPS #-} - (Functor f) => - IsLabel "currentPath" ((Path.Absolute -> f Path.Absolute) -> (LoopState -> f LoopState)) - where - fromLabel :: (Path.Absolute -> f Path.Absolute) -> (LoopState -> f LoopState) - fromLabel = - lens - (\LoopState {currentPathStack} -> List.NonEmpty.head currentPathStack) - ( \loopState@LoopState {currentPathStack = _ List.NonEmpty.:| paths} path -> - loopState {currentPathStack = path List.NonEmpty.:| paths} - ) - -- | Create an initial loop state given a root branch and the current path. -loopState0 :: CausalHash -> TMVar (Branch IO) -> Path.Absolute -> LoopState -loopState0 lastSavedRootHash b p = do +loopState0 :: TMVar (Branch IO) -> Path.Location -> LoopState +loopState0 b p = do LoopState - { root = b, - lastSavedRootHash = lastSavedRootHash, - currentPathStack = pure p, + { currentBranch = b, + locationStack = pure p, latestFile = Nothing, latestTypecheckedFile = Nothing, lastInput = Nothing, @@ -388,11 +372,13 @@ time label action = ms = ns / 1_000_000 s = ns / 1_000_000_000 +getCurrentLocation :: Cli Path.Location +getCurrentLocation = NonEmpty.head <$> use #locationStack + cd :: Path.Absolute -> Cli () cd path = do - setMostRecentNamespace path - State.modify' \state -> - state {currentPathStack = List.NonEmpty.cons path (currentPathStack state)} + loc <- getCurrentLocation + #locationStack %= NonEmpty.cons (loc & locAbsPath_ .~ path) -- | Pop the latest path off the stack, if it's not the only path in the stack. -- @@ -400,16 +386,17 @@ cd path = do popd :: Cli Bool popd = do state <- State.get - case List.NonEmpty.uncons (currentPathStack state) of + case List.NonEmpty.uncons (locationStack state) of (_, Nothing) -> pure False (_, Just paths) -> do - setMostRecentNamespace (List.NonEmpty.head paths) - State.put state {currentPathStack = paths} + setMostRecentLocation (List.NonEmpty.head paths) + State.put state {locationStack = paths} pure True -setMostRecentNamespace :: Path.Absolute -> Cli () -setMostRecentNamespace = - runTransaction . Queries.setMostRecentNamespace . map NameSegment.toUnescapedText . Path.toList . Path.unabsolute +setMostRecentLocation :: Path.Location -> Cli () +setMostRecentLocation _loc = + -- runTransaction . Queries.setMostRecentLocation . map NameSegment.toUnescapedText . Path.toList . Path.unabsolute + error "Implement setMostRecentLocation" respond :: Output -> Cli () respond output = do diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index ddccf48a2d..f1ef8675b6 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -143,7 +143,7 @@ getConfig key = do -- | Get the current path. getCurrentPath :: Cli Path.Absolute getCurrentPath = do - use #currentPath + view Path.locAbsPath_ <$> Cli.getCurrentLocation -- | Resolve a @Path@ (interpreted as relative) to a @Path.Absolute@, per the current path. resolvePath :: Path -> Cli Path.Absolute @@ -225,8 +225,8 @@ resolveShortCausalHashToCausalHash rollback shortHash = do -- Getting/Setting branches -- | Get the root branch. -getRootBranch :: Cli (Branch IO) -getRootBranch = do +getProjectRootBranch :: Cli (Branch IO) +getProjectRootBranch = do use #root >>= atomically . readTMVar -- | Get the root branch0. From 12b3107cdbb5f9eb5400652eb511fda284bcd8b3 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 20 May 2024 16:12:06 -0700 Subject: [PATCH 010/631] Add migration to move project branches to sqlite --- .../U/Codebase/Sqlite/ProjectBranch.hs | 5 +++-- .../codebase-sqlite/U/Codebase/Sqlite/Queries.hs | 9 +++++---- .../Unison/Codebase/SqliteCodebase/Migrations.hs | 4 +++- .../Migrations/MigrateSchema16To17.hs | 14 ++++++++++++++ parser-typechecker/unison-parser-typechecker.cabal | 3 ++- 5 files changed, 27 insertions(+), 8 deletions(-) create mode 100644 parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectBranch.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectBranch.hs index 05b63e7e23..a7059acb32 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectBranch.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectBranch.hs @@ -3,7 +3,7 @@ module U.Codebase.Sqlite.ProjectBranch ) where -import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) +import U.Codebase.Sqlite.DbId (CausalHashId, ProjectBranchId, ProjectId) import Unison.Core.Orphans.Sqlite () import Unison.Core.Project (ProjectBranchName) import Unison.Prelude @@ -14,7 +14,8 @@ data ProjectBranch = ProjectBranch { projectId :: !ProjectId, branchId :: !ProjectBranchId, name :: !ProjectBranchName, - parentBranchId :: !(Maybe ProjectBranchId) + parentBranchId :: !(Maybe ProjectBranchId), + rootCausalHash :: !CausalHashId } deriving stock (Eq, Generic, Show) deriving anyclass (ToRow, FromRow) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index ab263ef9d5..dc05c3f185 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3525,7 +3525,8 @@ loadProjectBranchSql projectId branchId = project_branch.project_id, project_branch.branch_id, project_branch.name, - project_branch_parent.parent_branch_id + project_branch_parent.parent_branch_id, + project_branch.causal_hash_id FROM project_branch LEFT JOIN project_branch_parent ON project_branch.project_id = project_branch_parent.project_id @@ -3680,11 +3681,11 @@ loadProjectAndBranchNames projectId branchId = -- | Insert a project branch. insertProjectBranch :: ProjectBranch -> Transaction () -insertProjectBranch (ProjectBranch projectId branchId branchName maybeParentBranchId) = do +insertProjectBranch (ProjectBranch projectId branchId branchName maybeParentBranchId causalHashId) = do execute [sql| - INSERT INTO project_branch (project_id, branch_id, name) - VALUES (:projectId, :branchId, :branchName) + INSERT INTO project_branch (project_id, branch_id, name, causal_hash_id) + VALUES (:projectId, :branchId, :branchName, :causalHashId) |] whenJust maybeParentBranchId \parentBranchId -> execute diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 68dc7c0a9f..eec913cb61 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -21,6 +21,7 @@ import Unison.Codebase.Init.OpenCodebaseError qualified as Codebase import Unison.Codebase.IntegrityCheck (IntegrityResult (..), integrityCheckAllBranches, integrityCheckAllCausals, prettyPrintIntegrityErrors) import Unison.Codebase.SqliteCodebase.Migrations.Helpers (abortMigration) import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema11To12 (migrateSchema11To12) +import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 (migrateSchema16To17) import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2 (migrateSchema1To2) import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema3To4 (migrateSchema3To4) import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema5To6 (migrateSchema5To6) @@ -81,7 +82,8 @@ migrations getDeclType termBuffer declBuffer rootCodebasePath = sqlMigration 13 Q.addMostRecentNamespaceTable, sqlMigration 14 Q.addSquashResultTable, sqlMigration 15 Q.addSquashResultTableIfNotExists, - sqlMigration 16 Q.cdToProjectRoot + sqlMigration 16 Q.cdToProjectRoot, + sqlMigration 17 migrateSchema16To17 ] where sqlMigration :: SchemaVersion -> Sqlite.Transaction () -> (SchemaVersion, Sqlite.Transaction ()) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs new file mode 100644 index 0000000000..45c41036a2 --- /dev/null +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 (migrateSchema16To17) where + +import U.Codebase.Sqlite.Queries qualified as Queries +import Unison.Sqlite qualified as Sqlite + +-- | This migration adds the causal_object_id column to the project_branches table. +migrateSchema16To17 :: Sqlite.Transaction () +migrateSchema16To17 = do + Queries.expectSchemaVersion 16 + error "Impelement MigrateSchema16To17.migrateSchema16To17" + Queries.setSchemaVersion 17 diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 512a0093a0..43fd0af0e8 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack @@ -75,6 +75,7 @@ library Unison.Codebase.SqliteCodebase.Migrations Unison.Codebase.SqliteCodebase.Migrations.Helpers Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema11To12 + Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2 Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2.DbHelpers Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema3To4 From 39f065e65683c60b638dfd3837455dfe8fd6480b Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 20 May 2024 16:38:05 -0700 Subject: [PATCH 011/631] Propagate root branch accessors --- .../U/Codebase/Sqlite/Operations.hs | 12 ++ .../U/Codebase/Sqlite/ProjectBranch.hs | 2 +- parser-typechecker/src/Unison/Codebase.hs | 28 ++++- .../src/Unison/Codebase/Path.hs | 34 ++--- .../src/Unison/Codebase/ProjectPath.hs | 90 +++++++++++++ parser-typechecker/src/Unison/Project/Util.hs | 18 --- .../unison-parser-typechecker.cabal | 1 + unison-cli/src/Unison/Cli/Monad.hs | 33 ++--- unison-cli/src/Unison/Cli/MonadUtils.hs | 119 ++++++++++-------- .../src/Unison/Codebase/Editor/HandleInput.hs | 73 +++++------ .../Codebase/Editor/HandleInput/Branch.hs | 3 +- .../HandleInput/NamespaceDependencies.hs | 6 +- .../Editor/HandleInput/ProjectClone.hs | 3 +- .../Editor/HandleInput/ProjectCreate.hs | 3 +- .../src/Unison/Codebase/Editor/Input.hs | 2 +- .../src/Unison/Codebase/Editor/Propagate.hs | 2 +- unison-cli/src/Unison/CommandLine.hs | 25 ++-- .../src/Unison/CommandLine/Completion.hs | 23 ++-- .../src/Unison/CommandLine/FZFResolvers.hs | 13 +- .../src/Unison/CommandLine/InputPattern.hs | 3 +- .../src/Unison/CommandLine/InputPatterns.hs | 71 ++++------- unison-cli/src/Unison/CommandLine/Main.hs | 51 ++++---- 22 files changed, 345 insertions(+), 270 deletions(-) create mode 100644 parser-typechecker/src/Unison/Codebase/ProjectPath.hs diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index 556bb5327f..45b0950619 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -98,6 +98,9 @@ module U.Codebase.Sqlite.Operations fuzzySearchDefinitions, namesPerspectiveForRootAndPath, + -- * Projects + expectProjectAndBranchNames, + -- * reflog getReflog, appendReflog, @@ -181,6 +184,8 @@ import U.Codebase.Sqlite.Patch.TermEdit qualified as S import U.Codebase.Sqlite.Patch.TermEdit qualified as S.TermEdit import U.Codebase.Sqlite.Patch.TypeEdit qualified as S import U.Codebase.Sqlite.Patch.TypeEdit qualified as S.TypeEdit +import U.Codebase.Sqlite.Project (Project (..)) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Reference qualified as S import U.Codebase.Sqlite.Reference qualified as S.Reference @@ -198,6 +203,7 @@ import U.Codebase.TypeEdit qualified as C.TypeEdit import U.Codebase.WatchKind (WatchKind) import U.Util.Base32Hex qualified as Base32Hex import U.Util.Serialization qualified as S +import Unison.Core.Project (ProjectBranchName, ProjectName) import Unison.Hash qualified as H import Unison.Hash32 qualified as Hash32 import Unison.NameSegment (NameSegment) @@ -1541,3 +1547,9 @@ stripPrefixFromNamedRef (PathSegments prefix) namedRef = Nothing -> reversedName Just strippedReversedPath -> S.ReversedName (name NonEmpty.:| strippedReversedPath) in namedRef {S.reversedSegments = newReversedName} + +expectProjectAndBranchNames :: Db.ProjectId -> Db.ProjectBranchId -> Transaction (ProjectName, ProjectBranchName) +expectProjectAndBranchNames projectId projectBranchId = do + Project {name = pName} <- Q.expectProject projectId + ProjectBranch {name = bName} <- Q.expectProjectBranch projectId projectBranchId + pure (pName, bName) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectBranch.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectBranch.hs index a7059acb32..986de3fbb6 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectBranch.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectBranch.hs @@ -15,7 +15,7 @@ data ProjectBranch = ProjectBranch branchId :: !ProjectBranchId, name :: !ProjectBranchName, parentBranchId :: !(Maybe ProjectBranchId), - rootCausalHash :: !CausalHashId + causalHashId :: !CausalHashId } deriving stock (Eq, Generic, Show) deriving anyclass (ToRow, FromRow) diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 9817a18b45..65608c0c96 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -49,6 +49,8 @@ module Unison.Codebase getShallowCausalFromRoot, getShallowRootBranch, getShallowRootCausal, + getShallowProjectRootBranch, + getShallowBranchAtProjectPath, -- * Root branch getRootBranch, @@ -116,7 +118,10 @@ import U.Codebase.Branch qualified as V2 import U.Codebase.Branch qualified as V2Branch import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash) +import U.Codebase.Sqlite.DbId qualified as Db import U.Codebase.Sqlite.Operations qualified as Operations +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Builtin qualified as Builtin import Unison.Builtin.Terms qualified as Builtin @@ -128,6 +133,7 @@ import Unison.Codebase.Editor.Git qualified as Git import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace) import Unison.Codebase.Path import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.Codebase.SqliteCodebase.Operations qualified as SqliteCodebase.Operations import Unison.Codebase.Type (Codebase (..), GitError) @@ -214,10 +220,9 @@ getShallowCausalAtPath path mayCausal = do -- Use the root causal if none is provided. getShallowBranchAtPath :: Path -> - Maybe (V2Branch.Branch Sqlite.Transaction) -> + V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) -getShallowBranchAtPath path mayBranch = do - branch <- whenNothing mayBranch (getShallowRootCausal >>= V2Causal.value) +getShallowBranchAtPath path branch = do case path of Path.Empty -> pure branch ns Path.:< p -> do @@ -225,7 +230,22 @@ getShallowBranchAtPath path mayBranch = do Nothing -> pure V2Branch.empty Just childCausal -> do childBranch <- V2Causal.value childCausal - getShallowBranchAtPath p (Just childBranch) + getShallowBranchAtPath p childBranch + +getShallowProjectRootBranch :: Db.ProjectId -> Db.ProjectBranchId -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) +getShallowProjectRootBranch projectId projectBranchId = do + ProjectBranch {causalHashId} <- Q.expectProjectBranch projectId projectBranchId + causalHash <- Q.expectCausalHash causalHashId + Operations.expectCausalBranchByCausalHash causalHash >>= V2Causal.value + +-- | Recursively descend into causals following the given path, +-- Use the root causal if none is provided. +getShallowBranchAtProjectPath :: + PP.ProjectPathIds -> + Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) +getShallowBranchAtProjectPath (PP.ProjectPath projectId projectBranchId path) = do + projectRootBranch <- getShallowProjectRootBranch projectId projectBranchId + getShallowBranchAtPath (Path.unabsolute path) projectRootBranch -- | Get a v1 branch from the root following the given path. getBranchAtPath :: diff --git a/parser-typechecker/src/Unison/Codebase/Path.hs b/parser-typechecker/src/Unison/Codebase/Path.hs index 839e50a8c7..3b7a7b483d 100644 --- a/parser-typechecker/src/Unison/Codebase/Path.hs +++ b/parser-typechecker/src/Unison/Codebase/Path.hs @@ -6,9 +6,6 @@ module Unison.Codebase.Path Absolute (..), pattern AbsolutePath', absPath_, - Location (..), - locAbsPath_, - locPath_, Relative (..), relPath_, pattern RelativePath', @@ -62,6 +59,8 @@ module Unison.Codebase.Path unsafeToName', toText, toText', + absToText, + relToText, unsplit, unsplit', unsplitAbsolute, @@ -94,28 +93,14 @@ import Data.Sequence (Seq ((:<|), (:|>))) import Data.Sequence qualified as Seq import Data.Text qualified as Text import GHC.Exts qualified as GHC -import Unison.Core.Project (ProjectBranchName) import Unison.HashQualified' qualified as HQ' import Unison.Name (Convert (..), Name, Parse) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.Prelude hiding (empty, toList) -import Unison.Project (ProjectName) import Unison.Syntax.Name qualified as Name (toText, unsafeParseText) import Unison.Util.List qualified as List -data Location - = Location ProjectName ProjectBranchName Absolute - -locAbsPath_ :: Lens' Location Absolute -locAbsPath_ = lens go set - where - go (Location _ _ p) = p - set (Location n b _) p = Location n b p - -locPath_ :: Lens' Location Path -locPath_ = locAbsPath_ . absPath_ - -- `Foo.Bar.baz` becomes ["Foo", "Bar", "baz"] newtype Path = Path {toSeq :: Seq NameSegment} deriving stock (Eq, Ord) @@ -128,6 +113,7 @@ instance GHC.IsList Path where toList (Path segs) = Foldable.toList segs fromList = Path . Seq.fromList +-- | A path absolute to the current project root newtype Absolute = Absolute {unabsolute :: Path} deriving (Eq, Ord) absPath_ :: Lens' Absolute Path @@ -166,14 +152,14 @@ absoluteToPath' = AbsolutePath' instance Show Path' where show = \case - AbsolutePath' abs -> show abs - RelativePath' rel -> show rel + AbsolutePath' abs -> Text.unpack $ absToText abs + RelativePath' rel -> Text.unpack $ relToText rel instance Show Absolute where - show s = "." ++ show (unabsolute s) + show s = Text.unpack $ absToText s instance Show Relative where - show = show . unrelative + show = Text.unpack . relToText unsplit' :: Split' -> Path' unsplit' = \case @@ -387,6 +373,12 @@ toText :: Path -> Text toText = maybe Text.empty Name.toText . toName +absToText :: Absolute -> Text +absToText abs = "." <> toText (unabsolute abs) + +relToText :: Relative -> Text +relToText rel = toText (unrelative rel) + unsafeParseText :: Text -> Path unsafeParseText = \case "" -> empty diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs new file mode 100644 index 0000000000..7fd5cfd669 --- /dev/null +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -0,0 +1,90 @@ +module Unison.Codebase.ProjectPath + ( ProjectPath (..), + ProjectPathIds, + ProjectPathNames, + ProjectPathCtx, + absPath_, + path_, + projectAndBranch_, + toText, + ctxAsIds_, + ctxAsNames_, + project_, + branch_, + ) +where + +import Control.Lens +import Data.Bifoldable (Bifoldable (..)) +import Data.Bitraversable (Bitraversable (..)) +import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) +import Unison.Codebase.Path qualified as Path +import Unison.Prelude +import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) + +data ProjectPath proj branch = ProjectPath + { projPathProject :: proj, + projPathBranch :: branch, + projPathPath :: Path.Absolute + } + deriving stock (Eq, Ord, Show) + +type ProjectPathIds = ProjectPath ProjectId ProjectBranchId + +type ProjectPathNames = ProjectPath ProjectName ProjectBranchName + +type ProjectPathCtx = ProjectPath (ProjectId, ProjectName) (ProjectBranchId, ProjectBranchName) + +project_ :: Lens' (ProjectPath p b) p +project_ = lens go set + where + go (ProjectPath p _ _) = p + set (ProjectPath _ b path) p = ProjectPath p b path + +branch_ :: Lens' (ProjectPath p b) b +branch_ = lens go set + where + go (ProjectPath _ b _) = b + set (ProjectPath p _ path) b = ProjectPath p b path + +-- | Project a project context into a project path of just IDs +ctxAsIds_ :: Lens' ProjectPathCtx ProjectPathIds +ctxAsIds_ = lens go set + where + go (ProjectPath (pid, _) (bid, _) p) = ProjectPath pid bid p + set (ProjectPath (_, pName) (_, bName) _) (ProjectPath pid bid p) = ProjectPath (pid, pName) (bid, bName) p + +-- | Project a project context into a project path of just names +ctxAsNames_ :: Lens' ProjectPathCtx ProjectPathNames +ctxAsNames_ = lens go set + where + go (ProjectPath (_, pName) (_, bName) path) = ProjectPath pName bName path + set (ProjectPath (pId, _) (bId, _) _) (ProjectPath pName bName path) = ProjectPath (pId, pName) (bId, bName) path + +instance Bifunctor ProjectPath where + bimap f g (ProjectPath p b path) = ProjectPath (f p) (g b) path + +instance Bifoldable ProjectPath where + bifoldMap f g (ProjectPath p b _) = f p <> g b + +instance Bitraversable ProjectPath where + bitraverse f g (ProjectPath p b path) = ProjectPath <$> f p <*> g b <*> pure path + +toText :: ProjectPath ProjectName ProjectBranchName -> Text +toText (ProjectPath projName branchName path) = + into @Text projName <> "/" <> into @Text branchName <> ":" <> Path.absToText path + +absPath_ :: Lens' (ProjectPath p b) Path.Absolute +absPath_ = lens go set + where + go (ProjectPath _ _ p) = p + set (ProjectPath n b _) p = ProjectPath n b p + +path_ :: Lens' (ProjectPath p b) Path.Path +path_ = absPath_ . Path.absPath_ + +projectAndBranch_ :: Lens' (ProjectPath p b) (ProjectAndBranch p b) +projectAndBranch_ = lens go set + where + go (ProjectPath proj branch _) = ProjectAndBranch proj branch + set (ProjectPath _ _ p) (ProjectAndBranch proj branch) = ProjectPath proj branch p diff --git a/parser-typechecker/src/Unison/Project/Util.hs b/parser-typechecker/src/Unison/Project/Util.hs index d75f2250a0..edc670c063 100644 --- a/parser-typechecker/src/Unison/Project/Util.hs +++ b/parser-typechecker/src/Unison/Project/Util.hs @@ -5,9 +5,7 @@ module Unison.Project.Util projectBranchSegment, projectPathPrism, projectBranchPathPrism, - projectContextFromPath, pattern UUIDNameSegment, - ProjectContext (..), pattern ProjectsNameSegment, pattern BranchesNameSegment, ) @@ -123,22 +121,6 @@ projectBranchPathPrism = Just (ProjectAndBranch {project = ProjectId projectId, branch = ProjectBranchId branchId}, Path.fromList restPath) _ -> Nothing --- | The project information about the current path. --- NOTE: if the user has cd'd into the project storage area but NOT into a branch, (where they shouldn't ever --- be), this will result in a LooseCodePath. -data ProjectContext - = LooseCodePath Path.Absolute - | ProjectBranchPath ProjectId ProjectBranchId Path.Path {- path from branch root -} - deriving stock (Eq, Show) - -projectContextFromPath :: Path.Absolute -> ProjectContext -projectContextFromPath path = - case path ^? projectBranchPathPrism of - Just (ProjectAndBranch {project = projectId, branch = branchId}, restPath) -> - ProjectBranchPath projectId branchId restPath - Nothing -> - LooseCodePath path - pattern ProjectsNameSegment :: NameSegment pattern ProjectsNameSegment <- ((== projectsNameSegment) -> True) diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 43fd0af0e8..f57ba4ad5e 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -62,6 +62,7 @@ library Unison.Codebase.Patch Unison.Codebase.Path Unison.Codebase.Path.Parse + Unison.Codebase.ProjectPath Unison.Codebase.PushBehavior Unison.Codebase.RootBranchCache Unison.Codebase.Runtime diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index 6ccbff582e..1db18cf12d 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -14,7 +14,7 @@ module Unison.Cli.Monad -- * Immutable state LoopState (..), loopState0, - getCurrentLocation, + getProjectPathIds, -- * Lifting IO actions ioE, @@ -75,8 +75,8 @@ import Unison.Codebase.Branch (Branch) import Unison.Codebase.Editor.Input (Input) import Unison.Codebase.Editor.Output (NumberedArgs, NumberedOutput, Output) import Unison.Codebase.Editor.UCMVersion (UCMVersion) -import Unison.Codebase.Path (locAbsPath_) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) import Unison.Debug qualified as Debug import Unison.Parser.Ann (Ann) @@ -178,9 +178,9 @@ data Env = Env -- -- There's an additional pseudo @"currentPath"@ field lens, for convenience. data LoopState = LoopState - { currentBranch :: TMVar (Branch IO), + { currentProjectRoot :: TMVar (Branch IO), -- the current position in the codebase, with the head being the most recent lcoation. - locationStack :: List.NonEmpty Path.Location, + projectPathStack :: List.NonEmpty PP.ProjectPathIds, -- TBD -- , _activeEdits :: Set Branch.EditGuid @@ -206,11 +206,11 @@ data LoopState = LoopState deriving stock (Generic) -- | Create an initial loop state given a root branch and the current path. -loopState0 :: TMVar (Branch IO) -> Path.Location -> LoopState +loopState0 :: TMVar (Branch IO) -> PP.ProjectPathIds -> LoopState loopState0 b p = do LoopState - { currentBranch = b, - locationStack = pure p, + { currentProjectRoot = b, + projectPathStack = pure p, latestFile = Nothing, latestTypecheckedFile = Nothing, lastInput = Nothing, @@ -372,13 +372,14 @@ time label action = ms = ns / 1_000_000 s = ns / 1_000_000_000 -getCurrentLocation :: Cli Path.Location -getCurrentLocation = NonEmpty.head <$> use #locationStack +getProjectPathIds :: Cli PP.ProjectPathIds +getProjectPathIds = do + NonEmpty.head <$> use #projectPathStack cd :: Path.Absolute -> Cli () cd path = do - loc <- getCurrentLocation - #locationStack %= NonEmpty.cons (loc & locAbsPath_ .~ path) + pp <- getProjectPathIds + #projectPathStack %= NonEmpty.cons (pp & PP.absPath_ .~ path) -- | Pop the latest path off the stack, if it's not the only path in the stack. -- @@ -386,15 +387,15 @@ cd path = do popd :: Cli Bool popd = do state <- State.get - case List.NonEmpty.uncons (locationStack state) of + case List.NonEmpty.uncons (projectPathStack state) of (_, Nothing) -> pure False (_, Just paths) -> do - setMostRecentLocation (List.NonEmpty.head paths) - State.put state {locationStack = paths} + setMostRecentProjectPath (List.NonEmpty.head paths) + State.put state {projectPathStack = paths} pure True -setMostRecentLocation :: Path.Location -> Cli () -setMostRecentLocation _loc = +setMostRecentProjectPath :: PP.ProjectPathIds -> Cli () +setMostRecentProjectPath _loc = -- runTransaction . Queries.setMostRecentLocation . map NameSegment.toUnescapedText . Path.toList . Path.unabsolute error "Implement setMostRecentLocation" diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index f1ef8675b6..beaf3bff77 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -6,6 +6,9 @@ module Unison.Cli.MonadUtils -- * Paths getCurrentPath, + getCurrentProjectName, + getCurrentProjectBranchName, + getProjectPathCtx, resolvePath, resolvePath', resolveSplit', @@ -20,16 +23,14 @@ module Unison.Cli.MonadUtils resolveShortCausalHash, -- ** Getting/setting branches - getRootBranch, - setRootBranch, - modifyRootBranch, - getRootBranch0, + setCurrentProjectRoot, + modifyProjectRoot, + getProjectRoot, + getProjectRoot0, getCurrentBranch, getCurrentBranch0, getBranchAt, getBranch0At, - getLastSavedRootHash, - setLastSavedRootHash, getMaybeBranchAt, getMaybeBranch0At, expectBranchAtPath, @@ -49,7 +50,7 @@ module Unison.Cli.MonadUtils stepManyAtMNoSync, stepManyAtNoSync, syncRoot, - updateRoot, + updateCurrentProjectRoot, updateAtM, updateAt, updateAndStepAt, @@ -94,6 +95,9 @@ import U.Codebase.Branch qualified as V2 (Branch) import U.Codebase.Branch qualified as V2Branch import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash (..)) +import U.Codebase.Sqlite.Project (Project (..)) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.Queries qualified as Q import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Codebase qualified as Codebase @@ -106,6 +110,7 @@ import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path (Path, Path' (..)) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.HashQualified qualified as HQ @@ -115,6 +120,7 @@ import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Parser.Ann (Ann (..)) import Unison.Prelude +import Unison.Project (ProjectBranchName, ProjectName) import Unison.Reference (TypeReference) import Unison.Referent (Referent) import Unison.Sqlite qualified as Sqlite @@ -140,10 +146,28 @@ getConfig key = do ------------------------------------------------------------------------------------------------------------------------ -- Getting paths, path resolution, etc. --- | Get the current path. +getProjectPathCtx :: Cli PP.ProjectPathCtx +getProjectPathCtx = do + (PP.ProjectPath projId branchId path) <- Cli.getProjectPathIds + -- TODO: Reset to a valid project on error. + (Project {name = projName}, ProjectBranch {name = branchName}) <- fmap (fromMaybe (error $ reportBug "E794202" ("Project branch not found in database for ids: " <> show (projId, branchId)))) . Cli.runTransaction . runMaybeT $ do + project <- MaybeT $ Q.loadProject projId + branch <- MaybeT $ Q.loadProjectBranch projId branchId + pure (project, branch) + pure (PP.ProjectPath (projId, projName) (branchId, branchName) path) + +-- | Get the current path relative to the current project. getCurrentPath :: Cli Path.Absolute getCurrentPath = do - view Path.locAbsPath_ <$> Cli.getCurrentLocation + view PP.absPath_ <$> getProjectPathCtx + +getCurrentProjectName :: Cli ProjectName +getCurrentProjectName = do + view (PP.ctxAsNames_ . PP.project_) <$> getProjectPathCtx + +getCurrentProjectBranchName :: Cli ProjectBranchName +getCurrentProjectBranchName = do + view (PP.ctxAsNames_ . PP.branch_) <$> getProjectPathCtx -- | Resolve a @Path@ (interpreted as relative) to a @Path.Absolute@, per the current path. resolvePath :: Path -> Cli Path.Absolute @@ -225,28 +249,28 @@ resolveShortCausalHashToCausalHash rollback shortHash = do -- Getting/Setting branches -- | Get the root branch. -getProjectRootBranch :: Cli (Branch IO) -getProjectRootBranch = do - use #root >>= atomically . readTMVar +getProjectRoot :: Cli (Branch IO) +getProjectRoot = do + use #currentProjectRoot >>= atomically . readTMVar -- | Get the root branch0. -getRootBranch0 :: Cli (Branch0 IO) -getRootBranch0 = - Branch.head <$> getRootBranch +getProjectRoot0 :: Cli (Branch0 IO) +getProjectRoot0 = + Branch.head <$> getProjectRoot -- | Set a new root branch. -- -- Note: This does _not_ update the codebase, the caller is responsible for that. -setRootBranch :: Branch IO -> Cli () -setRootBranch b = do - void $ modifyRootBranch (const b) +setCurrentProjectRoot :: Branch IO -> Cli () +setCurrentProjectRoot b = do + void $ modifyProjectRoot (const b) -- | Modify the root branch. -- -- Note: This does _not_ update the codebase, the caller is responsible for that. -modifyRootBranch :: (Branch IO -> Branch IO) -> Cli (Branch IO) -modifyRootBranch f = do - rootVar <- use #root +modifyProjectRoot :: (Branch IO -> Branch IO) -> Cli (Branch IO) +modifyProjectRoot f = do + rootVar <- use #currentProjectRoot atomically do root <- takeTMVar rootVar let !newRoot = f root @@ -265,17 +289,6 @@ getCurrentBranch0 :: Cli (Branch0 IO) getCurrentBranch0 = do Branch.head <$> getCurrentBranch --- | Get the last saved root hash. -getLastSavedRootHash :: Cli CausalHash -getLastSavedRootHash = do - use #lastSavedRootHash - --- | Set a new root branch. --- Note: This does _not_ update the codebase, the caller is responsible for that. -setLastSavedRootHash :: CausalHash -> Cli () -setLastSavedRootHash ch = do - #lastSavedRootHash .= ch - -- | Get the branch at an absolute path. getBranchAt :: Path.Absolute -> Cli (Branch IO) getBranchAt path = @@ -289,7 +302,7 @@ getBranch0At path = -- | Get the maybe-branch at an absolute path. getMaybeBranchAt :: Path.Absolute -> Cli (Maybe (Branch IO)) getMaybeBranchAt path = do - rootBranch <- getRootBranch + rootBranch <- getProjectRoot pure (Branch.getAt (Path.unabsolute path) rootBranch) -- | Get the maybe-branch0 at an absolute path. @@ -394,9 +407,9 @@ stepManyAtNoSync' :: f (Path, Branch0 IO -> Cli (Branch0 IO)) -> Cli Bool stepManyAtNoSync' actions = do - origRoot <- getRootBranch + origRoot <- getProjectRoot newRoot <- Branch.stepManyAtM actions origRoot - setRootBranch newRoot + setCurrentProjectRoot newRoot pure (origRoot /= newRoot) -- Like stepManyAt, but doesn't update the last saved root @@ -405,7 +418,7 @@ stepManyAtNoSync :: f (Path, Branch0 IO -> Branch0 IO) -> Cli () stepManyAtNoSync actions = - void . modifyRootBranch $ Branch.stepManyAt actions + void . modifyProjectRoot $ Branch.stepManyAt actions stepManyAtM :: (Foldable f) => @@ -421,15 +434,15 @@ stepManyAtMNoSync :: f (Path, Branch0 IO -> IO (Branch0 IO)) -> Cli () stepManyAtMNoSync actions = do - oldRoot <- getRootBranch + oldRoot <- getProjectRoot newRoot <- liftIO (Branch.stepManyAtM actions oldRoot) - setRootBranch newRoot + setCurrentProjectRoot newRoot -- | Sync the in-memory root branch. syncRoot :: Text -> Cli () syncRoot description = do - rootBranch <- getRootBranch - updateRoot rootBranch description + rootBranch <- getProjectRoot + updateCurrentProjectRoot rootBranch description -- | Update a branch at the given path, returning `True` if -- an update occurred and false otherwise @@ -439,9 +452,9 @@ updateAtM :: (Branch IO -> Cli (Branch IO)) -> Cli Bool updateAtM reason (Path.Absolute p) f = do - b <- getRootBranch + b <- getProjectRoot b' <- Branch.modifyAtM p f b - updateRoot b' reason + updateCurrentProjectRoot b' reason pure $ b /= b' -- | Update a branch at the given path, returning `True` if @@ -464,26 +477,22 @@ updateAndStepAt reason updates steps = do root <- (Branch.stepManyAt steps) . (\root -> foldl' (\b (Path.Absolute p, f) -> Branch.modifyAt p f b) root updates) - <$> getRootBranch - updateRoot root reason + <$> getProjectRoot + updateCurrentProjectRoot root reason -updateRoot :: Branch IO -> Text -> Cli () -updateRoot new reason = - Cli.time "updateRoot" do +updateCurrentProjectRoot :: Branch IO -> Text -> Cli () +updateCurrentProjectRoot new reason = + Cli.time "updateCurrentProjectRoot" do Cli.Env {codebase} <- ask - let newHash = Branch.headHash new - oldHash <- getLastSavedRootHash - when (oldHash /= newHash) do - liftIO (Codebase.putRootBranch codebase reason new) - setRootBranch new - setLastSavedRootHash newHash + liftIO (Codebase.putRootBranch codebase reason new) + setCurrentProjectRoot new ------------------------------------------------------------------------------------------------------------------------ -- Getting terms getTermsAt :: (Path.Absolute, HQ'.HQSegment) -> Cli (Set Referent) getTermsAt path = do - rootBranch0 <- getRootBranch0 + rootBranch0 <- getProjectRoot0 pure (BranchUtil.getTerm (Path.convert path) rootBranch0) ------------------------------------------------------------------------------------------------------------------------ @@ -491,7 +500,7 @@ getTermsAt path = do getTypesAt :: (Path.Absolute, HQ'.HQSegment) -> Cli (Set TypeReference) getTypesAt path = do - rootBranch0 <- getRootBranch0 + rootBranch0 <- getProjectRoot0 pure (BranchUtil.getType (Path.convert path) rootBranch0) ------------------------------------------------------------------------------------------------------------------------ diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 7e5352675c..b9fdbe0201 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -147,7 +147,6 @@ import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo, empty) import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Project (ProjectAndBranch (..)) -import Unison.Project.Util (projectContextFromPath) import Unison.Reference (Reference, TermReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) @@ -401,7 +400,7 @@ loop e = do Left hash -> Cli.resolveShortCausalHash hash Right path' -> Cli.expectBranchAtPath' path' description <- inputDescription input - Cli.updateRoot newRoot description + Cli.updateCurrentProjectRoot newRoot description Cli.respond Success ForkLocalBranchI src0 dest0 -> do (srcb, branchEmpty) <- @@ -520,7 +519,7 @@ loop e = do let elem = (Branch.headHash b, Branch.namesDiff b' b) doHistory schLength (n + 1) b' (elem : acc) UndoI -> do - rootBranch <- Cli.getRootBranch + rootBranch <- Cli.getProjectRoot (_, prev) <- liftIO (Branch.uncons rootBranch) & onNothingM do Cli.returnEarly . CantUndo $ @@ -528,7 +527,7 @@ loop e = do then CantUndoPastStart else CantUndoPastMerge description <- inputDescription input - Cli.updateRoot prev description + Cli.updateCurrentProjectRoot prev description (ppe, diff) <- diffHelper (Branch.head prev) (Branch.head rootBranch) Cli.respondNumbered (Output.ShowDiffAfterUndo ppe diff) UiI path' -> openUI path' @@ -602,7 +601,7 @@ loop e = do -- this implementation will happily produce name conflicts, -- but will surface them in a normal diff at the end of the operation. AliasManyI srcs dest' -> do - root0 <- Cli.getRootBranch0 + root0 <- Cli.getProjectRoot0 currentBranch0 <- Cli.getCurrentBranch0 destAbs <- Cli.resolvePath' dest' old <- Cli.getBranch0At destAbs @@ -658,11 +657,11 @@ loop e = do fixupOutput = fmap Path.unsafeToName . HQ'.toHQ . Path.unsplitHQ NamesI global query -> do hqLength <- Cli.runTransaction Codebase.hashLength - root <- Cli.getRootBranch (names, pped) <- if global || any Name.isAbsolute query then do - let root0 = Branch.head root + -- TODO: Use some global names index here + root0 <- Cli.getProjectRoot0 -- Use an absolutely qualified ppe for view.global let names = Names.makeAbsolute $ Branch.toNames root0 let pped = PPED.makePPED (PPE.hqNamer hqLength names) (PPE.suffixifyByHash names) @@ -735,15 +734,7 @@ loop e = do description (BranchUtil.makeDeletePatch (Path.convert src)) Cli.respond Success - DeleteTarget'Namespace insistence Nothing -> do - hasConfirmed <- confirmedCommand input - if hasConfirmed || insistence == Force - then do - description <- inputDescription input - Cli.updateRoot Branch.empty description - Cli.respond DeletedEverything - else Cli.respond DeleteEverythingConfirmation - DeleteTarget'Namespace insistence (Just p@(parentPath, childName)) -> do + DeleteTarget'Namespace insistence p@(parentPath, childName) -> do branch <- Cli.expectBranchAtPath' (Path.unsplit' p) description <- inputDescription input absPath <- Cli.resolveSplit' p @@ -752,7 +743,7 @@ loop e = do (Path.unsafeToName (Path.unsplit (Path.convert absPath))) (Branch.toNames (Branch.head branch)) afterDelete <- do - rootNames <- Branch.toNames <$> Cli.getRootBranch0 + rootNames <- Branch.toNames <$> Cli.getProjectRoot0 endangerments <- Cli.runTransaction (getEndangeredDependents toDelete Set.empty rootNames) case (null endangerments, insistence) of (True, _) -> pure (Cli.respond Success) @@ -1039,20 +1030,19 @@ loop e = do Cli.respond $ DumpUnisonFileHashes hqLength datas effects terms DebugTabCompletionI inputs -> do Cli.Env {authHTTPClient, codebase} <- ask - currentPath <- Cli.getCurrentPath - let completionFunc = Completion.haskelineTabComplete IP.patternMap codebase authHTTPClient currentPath + ppCtx <- Cli.getProjectPathCtx + let completionFunc = Completion.haskelineTabComplete IP.patternMap codebase authHTTPClient ppCtx (_, completions) <- liftIO $ completionFunc (reverse (unwords inputs), "") Cli.respond (DisplayDebugCompletions completions) DebugFuzzyOptionsI command args -> do Cli.Env {codebase} <- ask - currentPath <- Cli.getCurrentPath currentBranch <- Branch.withoutTransitiveLibs <$> Cli.getCurrentBranch0 - let projCtx = projectContextFromPath currentPath case Map.lookup command InputPatterns.patternMap of Just (IP.InputPattern {args = argTypes}) -> do zip argTypes args & Monoid.foldMapM \case ((argName, _, IP.ArgumentType {fzfResolver = Just IP.FZFResolver {getOptions}}), "_") -> do - results <- liftIO $ getOptions codebase projCtx currentBranch + ppCtx <- Cli.getProjectPathCtx + results <- liftIO $ getOptions codebase ppCtx currentBranch Cli.respond (DebugDisplayFuzzyOptions argName (Text.unpack <$> results)) ((_, _, IP.ArgumentType {fzfResolver = Nothing}), "_") -> do Cli.respond DebugFuzzyOptionsNoResolver @@ -1123,13 +1113,13 @@ loop e = do prettyRef renderR r = P.indentN 2 $ P.text (renderR r) prettyDefn renderR (r, Foldable.toList -> names) = P.lines (P.text <$> if null names then [""] else NameSegment.toEscapedText <$> names) <> P.newline <> prettyRef renderR r - rootBranch <- Cli.getRootBranch - void . liftIO . flip State.execStateT mempty $ goCausal [getCausal rootBranch] + projectRoot <- Cli.getProjectRoot + void . liftIO . flip State.execStateT mempty $ goCausal [getCausal projectRoot] DebugDumpNamespaceSimpleI -> do - rootBranch0 <- Cli.getRootBranch0 - for_ (Relation.toList . Branch.deepTypes $ rootBranch0) \(r, name) -> + projectRootBranch0 <- Cli.getProjectRoot0 + for_ (Relation.toList . Branch.deepTypes $ projectRootBranch0) \(r, name) -> traceM $ show name ++ ",Type," ++ Text.unpack (Reference.toText r) - for_ (Relation.toList . Branch.deepTerms $ rootBranch0) \(r, name) -> + for_ (Relation.toList . Branch.deepTerms $ projectRootBranch0) \(r, name) -> traceM $ show name ++ ",Term," ++ Text.unpack (Referent.toText r) DebugTermI isVerbose hqName -> DebugDefinition.debugTerm isVerbose hqName DebugLSPFoldRangesI -> do @@ -1274,10 +1264,10 @@ inputDescription input = thing <- traverse hqs' thing0 pure ("delete.type.verbose " <> Text.intercalate " " thing) DeleteTarget'Namespace Try opath0 -> do - opath <- ops' opath0 + opath <- ps' opath0 pure ("delete.namespace " <> opath) DeleteTarget'Namespace Force opath0 -> do - opath <- ops' opath0 + opath <- ps' opath0 pure ("delete.namespace.force " <> opath) DeleteTarget'Patch path0 -> do path <- ps' path0 @@ -1410,8 +1400,6 @@ inputDescription input = p' = fmap tShow . Cli.resolvePath' brp :: BranchRelativePath -> Cli Text brp = fmap from . ProjectUtils.resolveBranchRelativePath - ops' :: Maybe Path.Split' -> Cli Text - ops' = maybe (pure ".") ps' opatch :: Maybe Path.Split' -> Cli Text opatch = ps' . fromMaybe Cli.defaultPatchPath wat = error $ show input ++ " is not expected to alter the branch" @@ -1458,10 +1446,11 @@ handleFindI isVerbose fscope ws input = do pped <- Cli.currentPrettyPrintEnvDecl pure (pped, names, Just p, branch0) FindGlobal -> do - globalNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getRootBranch0 - pped <- Cli.prettyPrintEnvDeclFromNames globalNames + -- TODO: Rewrite to be properly global again + projectRootNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getProjectRoot0 + pped <- Cli.prettyPrintEnvDeclFromNames projectRootNames currentBranch0 <- Cli.getCurrentBranch0 - pure (pped, globalNames, Nothing, currentBranch0) + pure (pped, projectRootNames, Nothing, currentBranch0) let suffixifiedPPE = PPED.suffixifiedPPE pped let getResults :: Names -> Cli [SearchResult] getResults names = @@ -1666,16 +1655,16 @@ handleShowDefinition outputLoc showDefinitionScope query = do hqLength <- Cli.runTransaction Codebase.hashLength let hasAbsoluteQuery = any (any Name.isAbsolute) query (names, unbiasedPPED) <- case (hasAbsoluteQuery, showDefinitionScope) of - -- If any of the queries are absolute, use global names. -- TODO: We should instead print each definition using the names from its project-branch root. (True, _) -> do - root <- Cli.getRootBranch + root <- Cli.getProjectRoot let root0 = Branch.head root let names = Names.makeAbsolute $ Branch.toNames root0 pped <- Cli.prettyPrintEnvDeclFromNames names pure (names, pped) (_, ShowDefinitionGlobal) -> do - root <- Cli.getRootBranch + -- TODO: Maybe rewrite to be properly global + root <- Cli.getProjectRoot let root0 = Branch.head root let names = Names.makeAbsolute $ Branch.toNames root0 pped <- Cli.prettyPrintEnvDeclFromNames names @@ -1970,9 +1959,7 @@ checkDeletes typesTermsTuples doutput inputs = do toRel setRef name = R.fromList (fmap (name,) (toList setRef)) let toDelete = fmap (\(_, names, types, terms) -> Names (toRel terms names) (toRel types names)) splitsNames -- make sure endangered is compeletely contained in paths - -- TODO: We should just check for endangerments from the project root, not the - -- global root! - rootNames <- Branch.toNames <$> Cli.getRootBranch0 + projectNames <- Branch.toNames <$> Cli.getProjectRoot0 -- get only once for the entire deletion set let allTermsToDelete :: Set LabeledDependency allTermsToDelete = Set.unions (fmap Names.labeledReferences toDelete) @@ -1981,7 +1968,7 @@ checkDeletes typesTermsTuples doutput inputs = do Cli.runTransaction $ traverse ( \targetToDelete -> - getEndangeredDependents targetToDelete (allTermsToDelete) rootNames + getEndangeredDependents targetToDelete (allTermsToDelete) projectNames ) toDelete -- If the overall dependency map is not completely empty, abort deletion @@ -2005,7 +1992,7 @@ checkDeletes typesTermsTuples doutput inputs = do DeleteOutput'NoDiff -> do Cli.respond Success else do - ppeDecl <- Cli.prettyPrintEnvDeclFromNames rootNames + ppeDecl <- Cli.prettyPrintEnvDeclFromNames projectNames let combineRefs = List.foldl (Map.unionWith NESet.union) Map.empty endangeredDeletions Cli.respondNumbered (CantDeleteDefinitions ppeDecl combineRefs) @@ -2066,7 +2053,7 @@ displayI outputLoc hq = do (names, pped) <- if useRoot then do - root <- Cli.getRootBranch + root <- Cli.getProjectRoot let root0 = Branch.head root let names = Names.makeAbsolute $ Branch.toNames root0 pped <- Cli.prettyPrintEnvDeclFromNames names diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 4e740830cb..9ca57e574e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -151,7 +151,8 @@ doCreateBranch' sourceNamespaceObject parentBranchId project getNewBranchName de { projectId, branchId = newBranchId, name = newBranchName, - parentBranchId = parentBranchId + parentBranchId = parentBranchId, + rootCausalHash = error "TODO: implement doCreateBranch" } Queries.setMostRecentBranch projectId newBranchId pure newBranchId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs index f812df39ba..88b75a289b 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs @@ -43,11 +43,11 @@ handleNamespaceDependencies namespacePath' = do externalDependencies <- Cli.runTransaction (namespaceDependencies codebase branch) currentPPED <- Cli.currentPrettyPrintEnvDecl - globalNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getRootBranch0 - globalPPED <- Cli.prettyPrintEnvDeclFromNames globalNames + rootNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getProjectRoot0 + rootPPED <- Cli.prettyPrintEnvDeclFromNames rootNames -- We explicitly include a global unsuffixified fallback on namespace dependencies since -- the things we want names for are obviously outside of our scope. - let ppeWithFallback = PPED.unsuffixifiedPPE $ PPED.addFallback globalPPED currentPPED + let ppeWithFallback = PPED.unsuffixifiedPPE $ PPED.addFallback rootPPED currentPPED Cli.respondNumbered $ Output.ListNamespaceDependencies ppeWithFallback path externalDependencies -- | Check the dependencies of all types and terms in the current namespace, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs index a459b343bf..a0cc253bde 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs @@ -259,7 +259,8 @@ cloneInto localProjectBranch remoteProjectBranch = do { projectId = localProjectId, branchId = localBranchId, name = localProjectBranch.branch, - parentBranchId = Nothing + parentBranchId = Nothing, + rootCausalHash = error "Add causal hash id in cloneInto" } Queries.insertBranchRemoteMapping localProjectId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs index 99a90be6f8..90dead6159 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs @@ -161,7 +161,8 @@ insertProjectAndBranch projectId projectName branchId branchName = do { projectId, branchId, name = branchName, - parentBranchId = Nothing + parentBranchId = Nothing, + rootCausalHash = error "Add causal hash id in insertProjectAndBranch" } Queries.setMostRecentBranch projectId branchId diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 2cdfb96c13..8c18fd047b 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -331,7 +331,7 @@ data DeleteTarget = DeleteTarget'TermOrType DeleteOutput [Path.HQSplit'] | DeleteTarget'Term DeleteOutput [Path.HQSplit'] | DeleteTarget'Type DeleteOutput [Path.HQSplit'] - | DeleteTarget'Namespace Insistence (Maybe Path.Split') + | DeleteTarget'Namespace Insistence Path.Split' | DeleteTarget'Patch Path.Split' | DeleteTarget'ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) | DeleteTarget'Project ProjectName diff --git a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs index addb8d5de9..c06cd1f71a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs @@ -241,7 +241,7 @@ propagate patch b = case validatePatch patch of pure noEdits Just (initialTermEdits, initialTypeEdits) -> do -- TODO: this can be removed once patches have term replacement of type `Referent -> Referent` - rootNames <- Branch.toNames <$> Cli.getRootBranch0 + rootNames <- Branch.toNames <$> Cli.getProjectRoot0 let -- TODO: these are just used for tracing, could be deleted if we don't care -- about printing meaningful names for definitions during propagation, or if diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index f97a25e331..8291b7e9fb 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -26,6 +26,7 @@ module Unison.CommandLine where import Control.Concurrent (forkIO, killThread) +import Control.Lens hiding (aside) import Control.Monad.Except import Control.Monad.Trans.Except import Data.Configurator (autoConfig, autoReload) @@ -42,11 +43,10 @@ import Data.Vector qualified as Vector import System.FilePath (takeFileName) import Text.Regex.TDFA ((=~)) import Unison.Codebase (Codebase) -import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Input (Event (..), Input (..)) -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Watch qualified as Watch import Unison.CommandLine.FZFResolvers qualified as FZFResolvers import Unison.CommandLine.FuzzySelect qualified as Fuzzy @@ -54,7 +54,6 @@ import Unison.CommandLine.InputPattern (InputPattern (..)) import Unison.CommandLine.InputPattern qualified as InputPattern import Unison.Parser.Ann (Ann) import Unison.Prelude -import Unison.Project.Util (ProjectContext, projectContextFromPath) import Unison.Symbol (Symbol) import Unison.Util.ColorText qualified as CT import Unison.Util.Monoid (foldMapM) @@ -120,8 +119,9 @@ nothingTodo = emojiNote "😶" parseInput :: Codebase IO Symbol Ann -> - -- | Current path from root - Path.Absolute -> + -- | Current location + PP.ProjectPathCtx -> + IO (Branch.Branch IO) -> -- | Numbered arguments [String] -> -- | Input Pattern Map @@ -131,10 +131,11 @@ parseInput :: -- Returns either an error message or the fully expanded arguments list and parsed input. -- If the output is `Nothing`, the user cancelled the input (e.g. ctrl-c) IO (Either (P.Pretty CT.ColorText) (Maybe ([String], Input))) -parseInput codebase currentPath numberedArgs patterns segments = runExceptT do +parseInput codebase projPath currentProjectRoot numberedArgs patterns segments = runExceptT do let getCurrentBranch0 :: IO (Branch0 IO) - getCurrentBranch0 = Branch.head <$> Codebase.getBranchAtPath codebase currentPath - let projCtx = projectContextFromPath currentPath + getCurrentBranch0 = do + projRoot <- currentProjectRoot + pure . Branch.head $ Branch.getAt' (projPath ^. PP.path_) projRoot case segments of [] -> throwE "" @@ -143,7 +144,7 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do let expandedNumbers :: [String] expandedNumbers = foldMap (expandNumber numberedArgs) args - lift (fzfResolve codebase projCtx getCurrentBranch0 pat expandedNumbers) >>= \case + lift (fzfResolve codebase projPath getCurrentBranch0 pat expandedNumbers) >>= \case Left (NoFZFResolverForArgumentType _argDesc) -> throwError help Left (NoFZFOptions argDesc) -> throwError (noCompletionsMessage argDesc) Left FZFCancelled -> pure Nothing @@ -193,8 +194,8 @@ data FZFResolveFailure | NoFZFOptions Text {- argument description -} | FZFCancelled -fzfResolve :: Codebase IO Symbol Ann -> ProjectContext -> (IO (Branch0 IO)) -> InputPattern -> [String] -> IO (Either FZFResolveFailure [String]) -fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do +fzfResolve :: Codebase IO Symbol Ann -> PP.ProjectPathCtx -> (IO (Branch0 IO)) -> InputPattern -> [String] -> IO (Either FZFResolveFailure [String]) +fzfResolve codebase ppCtx getCurrentBranch pat args = runExceptT do -- We resolve args in two steps, first we check that all arguments that will require a fzf -- resolver have one, and only if so do we prompt the user to actually do a fuzzy search. -- Otherwise, we might ask the user to perform a search only to realize we don't have a resolver @@ -215,7 +216,7 @@ fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do fuzzyFillArg :: InputPattern.IsOptional -> Text -> InputPattern.FZFResolver -> ExceptT FZFResolveFailure IO [String] fuzzyFillArg opt argDesc InputPattern.FZFResolver {getOptions} = do currentBranch <- Branch.withoutTransitiveLibs <$> liftIO getCurrentBranch - options <- liftIO $ getOptions codebase projCtx currentBranch + options <- liftIO $ getOptions codebase ppCtx currentBranch when (null options) $ throwError $ NoFZFOptions argDesc liftIO $ Text.putStrLn (FZFResolvers.fuzzySelectHeader argDesc) results <- diff --git a/unison-cli/src/Unison/CommandLine/Completion.hs b/unison-cli/src/Unison/CommandLine/Completion.hs index a72ac3c923..5241e00979 100644 --- a/unison-cli/src/Unison/CommandLine/Completion.hs +++ b/unison-cli/src/Unison/CommandLine/Completion.hs @@ -48,6 +48,7 @@ import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.CommandLine.InputPattern qualified as IP import Unison.HashQualified' qualified as HQ' @@ -73,9 +74,9 @@ haskelineTabComplete :: Map String IP.InputPattern -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPathCtx -> Line.CompletionFunc m -haskelineTabComplete patterns codebase authedHTTPClient currentPath = Line.completeWordWithPrev Nothing " " $ \prev word -> +haskelineTabComplete patterns codebase authedHTTPClient ppCtx = Line.completeWordWithPrev Nothing " " $ \prev word -> -- User hasn't finished a command name, complete from command names if null prev then pure . exactComplete word $ Map.keys patterns @@ -84,7 +85,7 @@ haskelineTabComplete patterns codebase authedHTTPClient currentPath = Line.compl h : t -> fromMaybe (pure []) $ do p <- Map.lookup h patterns argType <- IP.argType p (length t) - pure $ IP.suggestions argType word codebase authedHTTPClient currentPath + pure $ IP.suggestions argType word codebase authedHTTPClient ppCtx _ -> pure [] -- | Things which we may want to complete for. @@ -141,9 +142,9 @@ completeWithinNamespace :: NESet CompletionType -> -- | The portion of this are that the user has already typed. String -> - Path.Absolute -> + PP.ProjectPathCtx -> Sqlite.Transaction [System.Console.Haskeline.Completion.Completion] -completeWithinNamespace compTypes query currentPath = do +completeWithinNamespace compTypes query ppCtx = do shortHashLen <- Codebase.hashLength b <- Codebase.getShallowBranchAtPath (Path.unabsolute absQueryPath) Nothing currentBranchSuggestions <- do @@ -169,7 +170,7 @@ completeWithinNamespace compTypes query currentPath = do querySuffix :: Text (queryPathPrefix, querySuffix) = parseLaxPath'Query (Text.pack query) absQueryPath :: Path.Absolute - absQueryPath = Path.resolve currentPath queryPathPrefix + absQueryPath = Path.resolve ppCtx queryPathPrefix getChildSuggestions :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [Completion] getChildSuggestions shortHashLen b | Text.null querySuffix = pure [] @@ -274,35 +275,35 @@ parseLaxPath'Query txt = -- | Completes a namespace argument by prefix-matching against the query. prefixCompleteNamespace :: String -> - Path.Absolute -> -- Current path + PP.ProjectPathCtx -> Sqlite.Transaction [Line.Completion] prefixCompleteNamespace = completeWithinNamespace (NESet.singleton NamespaceCompletion) -- | Completes a term or type argument by prefix-matching against the query. prefixCompleteTermOrType :: String -> - Path.Absolute -> -- Current path + PP.ProjectPathCtx -> Sqlite.Transaction [Line.Completion] prefixCompleteTermOrType = completeWithinNamespace (NESet.fromList (TermCompletion NE.:| [TypeCompletion])) -- | Completes a term argument by prefix-matching against the query. prefixCompleteTerm :: String -> - Path.Absolute -> -- Current path + PP.ProjectPathCtx -> Sqlite.Transaction [Line.Completion] prefixCompleteTerm = completeWithinNamespace (NESet.singleton TermCompletion) -- | Completes a term or type argument by prefix-matching against the query. prefixCompleteType :: String -> - Path.Absolute -> -- Current path + PP.ProjectPathCtx -> Sqlite.Transaction [Line.Completion] prefixCompleteType = completeWithinNamespace (NESet.singleton TypeCompletion) -- | Completes a patch argument by prefix-matching against the query. prefixCompletePatch :: String -> - Path.Absolute -> -- Current path + PP.ProjectPathCtx -> Sqlite.Transaction [Line.Completion] prefixCompletePatch = completeWithinNamespace (NESet.singleton PatchCompletion) diff --git a/unison-cli/src/Unison/CommandLine/FZFResolvers.hs b/unison-cli/src/Unison/CommandLine/FZFResolvers.hs index a6f23f2dbf..79a3f9fcfc 100644 --- a/unison-cli/src/Unison/CommandLine/FZFResolvers.hs +++ b/unison-cli/src/Unison/CommandLine/FZFResolvers.hs @@ -37,13 +37,13 @@ import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Path (Path, Path' (..)) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Position qualified as Position import Unison.Prelude -import Unison.Project.Util (ProjectContext (..)) import Unison.Symbol (Symbol) import Unison.Syntax.HashQualified qualified as HQ (toText) import Unison.Syntax.NameSegment qualified as NameSegment @@ -51,7 +51,7 @@ import Unison.Util.Monoid (foldMapM) import Unison.Util.Monoid qualified as Monoid import Unison.Util.Relation qualified as Relation -type OptionFetcher = Codebase IO Symbol Ann -> ProjectContext -> Branch0 IO -> IO [Text] +type OptionFetcher = Codebase IO Symbol Ann -> PP.ProjectPathCtx -> Branch0 IO -> IO [Text] data FZFResolver = FZFResolver { getOptions :: OptionFetcher @@ -121,7 +121,7 @@ fuzzySelectFromList options = -- | Combine multiple option fetchers into one resolver. multiResolver :: [OptionFetcher] -> FZFResolver multiResolver resolvers = - let getOptions :: Codebase IO Symbol Ann -> ProjectContext -> Branch0 IO -> IO [Text] + let getOptions :: Codebase IO Symbol Ann -> PP.ProjectPathCtx -> Branch0 IO -> IO [Text] getOptions codebase projCtx searchBranch0 = do List.nubOrd <$> foldMapM (\f -> f codebase projCtx searchBranch0) resolvers in (FZFResolver {getOptions}) @@ -177,11 +177,8 @@ projectBranchOptions codebase _projCtx _searchBranch0 = do -- E.g. '@unison/base/main' projectBranchOptionsWithinCurrentProject :: OptionFetcher projectBranchOptionsWithinCurrentProject codebase projCtx _searchBranch0 = do - case projCtx of - LooseCodePath _ -> pure [] - ProjectBranchPath currentProjectId _projectBranchId _path -> do - Codebase.runTransaction codebase (Q.loadAllProjectBranchesBeginningWith currentProjectId Nothing) - <&> fmap (into @Text . snd) + Codebase.runTransaction codebase (Q.loadAllProjectBranchesBeginningWith (projCtx ^. PP.ctxAsIds_ . PP.project_) Nothing) + <&> fmap (into @Text . snd) -- | Exported from here just so the debug command and actual implementation can use the same -- messaging. diff --git a/unison-cli/src/Unison/CommandLine/InputPattern.hs b/unison-cli/src/Unison/CommandLine/InputPattern.hs index f72506bab5..e5fa556859 100644 --- a/unison-cli/src/Unison/CommandLine/InputPattern.hs +++ b/unison-cli/src/Unison/CommandLine/InputPattern.hs @@ -26,6 +26,7 @@ import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Codebase (Codebase) import Unison.Codebase.Editor.Input (Input (..)) import Unison.Codebase.Path as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.FZFResolvers (FZFResolver (..)) import Unison.Prelude import Unison.Util.ColorText qualified as CT @@ -67,7 +68,7 @@ data ArgumentType = ArgumentType String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> -- Current path + PP.ProjectPathCtx -> m [Line.Completion], -- | If an argument is marked as required, but not provided, the fuzzy finder will be triggered if -- available. diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 490d29b6cd..19cc1c4ce6 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -182,6 +182,8 @@ import Unison.Codebase.Editor.UriParser (readRemoteNamespaceParser) import Unison.Codebase.Editor.UriParser qualified as UriParser import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path +import Unison.Codebase.ProjectPath (ProjectPathCtx) +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.PushBehavior qualified as PushBehavior import Unison.CommandLine import Unison.CommandLine.BranchRelativePath (parseBranchRelativePath, parseIncrementalBranchRelativePath) @@ -206,7 +208,6 @@ import Unison.Project Semver, branchWithOptionalProjectParser, ) -import Unison.Project.Util (ProjectContext (..), projectContextFromPath) import Unison.Syntax.HashQualified qualified as HQ (parseText) import Unison.Syntax.Name qualified as Name (parseText, unsafeParseText) import Unison.Syntax.NameSegment qualified as NameSegment (renderParseErr, segmentP) @@ -1234,13 +1235,9 @@ deleteNamespaceForce = deleteNamespaceParser :: P.Pretty CT.ColorText -> Input.Insistence -> [String] -> Either (P.Pretty CT.ColorText) Input deleteNamespaceParser helpText insistence = \case - ["."] -> - first fromString - . pure - $ Input.DeleteI (DeleteTarget'Namespace insistence Nothing) [p] -> first P.text do p <- Path.parseSplit' p - pure $ Input.DeleteI (DeleteTarget'Namespace insistence (Just p)) + pure $ Input.DeleteI (DeleteTarget'Namespace insistence p) _ -> Left helpText deletePatch :: InputPattern @@ -3481,9 +3478,9 @@ projectAndOrBranchSuggestions :: String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> -- Current path + ProjectPathCtx -> m [Line.Completion] -projectAndOrBranchSuggestions config inputStr codebase _httpClient path = do +projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do case Text.uncons input of -- Things like "/foo" would be parsed as unambiguous branches in the logic below, except we also want to -- handle "/" and "/@" inputs, which aren't valid branch names, but are valid branch prefixes. So, @@ -3527,10 +3524,7 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient path = do pure (map (projectBranchToCompletion projectName) branches) where input = Text.strip . Text.pack $ inputStr - - (mayCurrentProjectId, _mayCurrentBranchId) = case projectContextFromPath path of - LooseCodePath {} -> (Nothing, Nothing) - ProjectBranchPath projectId branchId _ -> (Just projectId, Just branchId) + currentProjectId = ppCtx ^. (PP.ctxAsIds_ . PP.project_) handleAmbiguousComplete :: MonadIO m => @@ -3667,28 +3661,22 @@ handleBranchesComplete :: ProjectBranchSuggestionsConfig -> Text -> Codebase m v a -> - Path.Absolute -> + PP.ProjectPathCtx -> m [Completion] -handleBranchesComplete config branchName codebase path = do +handleBranchesComplete config branchName codebase ppCtx = do branches <- - case preview ProjectUtils.projectBranchPathPrism path of - Nothing -> pure [] - Just (ProjectAndBranch currentProjectId _, _) -> - Codebase.runTransaction codebase do - fmap (filterBranches config path) do - Queries.loadAllProjectBranchesBeginningWith currentProjectId (Just branchName) + Codebase.runTransaction codebase do + fmap (filterBranches config ppCtx) do + Queries.loadAllProjectBranchesBeginningWith (ppCtx ^. PP.ctxAsIds_ . PP.project_) (Just branchName) pure (map currentProjectBranchToCompletion branches) -filterBranches :: ProjectBranchSuggestionsConfig -> Path.Absolute -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)] -filterBranches config path branches = - case (mayCurrentBranchId, branchInclusion config) of - (_, AllBranches) -> branches - (Nothing, _) -> branches - (Just currentBranchId, ExcludeCurrentBranch) -> branches & filter (\(branchId, _) -> branchId /= currentBranchId) +filterBranches :: ProjectBranchSuggestionsConfig -> PP.ProjectPathCtx -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)] +filterBranches config ppCtx branches = + case (branchInclusion config) of + AllBranches -> branches + ExcludeCurrentBranch -> branches & filter (\(branchId, _) -> branchId /= currentBranchId) where - (_mayCurrentProjectId, mayCurrentBranchId) = case projectContextFromPath path of - LooseCodePath {} -> (Nothing, Nothing) - ProjectBranchPath projectId branchId _ -> (Just projectId, Just branchId) + currentBranchId = ppCtx ^. PP.ctxAsIds_ . PP.branch_ currentProjectBranchToCompletion :: (ProjectBranchId, ProjectBranchName) -> Completion currentProjectBranchToCompletion (_, branchName) = @@ -3704,9 +3692,9 @@ branchRelativePathSuggestions :: String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> -- Current path + PP.ProjectPathCtx -> m [Line.Completion] -branchRelativePathSuggestions config inputStr codebase _httpClient currentPath = do +branchRelativePathSuggestions config inputStr codebase _httpClient ppCtx = do case parseIncrementalBranchRelativePath inputStr of Left _ -> pure [] Right ibrp -> case ibrp of @@ -3719,7 +3707,7 @@ branchRelativePathSuggestions config inputStr codebase _httpClient currentPath = BranchRelativePath.IncompleteProject _proj -> projectNameSuggestions WithSlash inputStr codebase BranchRelativePath.IncompleteBranch mproj mbranch -> case mproj of - Nothing -> map suffixPathSep <$> handleBranchesComplete config (maybe "" into mbranch) codebase currentPath + Nothing -> map suffixPathSep <$> handleBranchesComplete config (maybe "" into mbranch) codebase ppCtx Just projectName -> do branches <- Codebase.runTransaction codebase do @@ -3727,19 +3715,12 @@ branchRelativePathSuggestions config inputStr codebase _httpClient currentPath = Nothing -> pure [] Just project -> do let projectId = project ^. #projectId - fmap (filterBranches config currentPath) do + fmap (filterBranches config ppCtx) do Queries.loadAllProjectBranchesBeginningWith projectId (into @Text <$> mbranch) pure (map (projectBranchToCompletionWithSep projectName) branches) BranchRelativePath.PathRelativeToCurrentBranch relPath -> Codebase.runTransaction codebase do - mprojectBranch <- runMaybeT do - (projectId, branchId) <- MaybeT (pure $ (,) <$> mayCurrentProjectId <*> mayCurrentBranchId) - MaybeT (Queries.loadProjectBranch projectId branchId) - case mprojectBranch of - Nothing -> pure [] - Just projectBranch -> do - let branchPath = review ProjectUtils.projectBranchPathPrism (projectAndBranch, mempty) - projectAndBranch = ProjectAndBranch (projectBranch ^. #projectId) (projectBranch ^. #branchId) - map prefixPathSep <$> prefixCompleteNamespace (Path.convert relPath) branchPath + -- TODO: Verify this works as intendid + map prefixPathSep <$> prefixCompleteNamespace (Path.convert relPath) mempty BranchRelativePath.IncompletePath projStuff mpath -> do Codebase.runTransaction codebase do mprojectBranch <- runMaybeT do @@ -3747,7 +3728,6 @@ branchRelativePathSuggestions config inputStr codebase _httpClient currentPath = Left names@(ProjectAndBranch projectName branchName) -> do (,Left names) <$> MaybeT (Queries.loadProjectBranchByNames projectName branchName) Right branchName -> do - currentProjectId <- MaybeT (pure mayCurrentProjectId) projectBranch <- MaybeT (Queries.loadProjectBranchByName currentProjectId branchName) pure (projectBranch, Right (projectBranch ^. #name)) case mprojectBranch of @@ -3757,9 +3737,8 @@ branchRelativePathSuggestions config inputStr codebase _httpClient currentPath = projectAndBranch = ProjectAndBranch (projectBranch ^. #projectId) (projectBranch ^. #branchId) map (addBranchPrefix prefix) <$> prefixCompleteNamespace (maybe "" Path.convert mpath) branchPath where - (mayCurrentProjectId, mayCurrentBranchId) = case projectContextFromPath currentPath of - LooseCodePath {} -> (Nothing, Nothing) - ProjectBranchPath projectId branchId _ -> (Just projectId, Just branchId) + currentPath = ppCtx ^. PP.absPath_ + currentProjectId = ppCtx ^. PP.ctxAsIds_ . PP.project_ projectBranchToCompletionWithSep :: ProjectName -> (ProjectBranchId, ProjectBranchName) -> Completion projectBranchToCompletionWithSep projectName (_, branchName) = diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index de0d7e12fb..26ca644d01 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -10,6 +10,7 @@ import Control.Lens (preview, (?~), (^.)) import Crypto.Random qualified as Random import Data.Configurator.Types (Config) import Data.IORef +import Data.List.NonEmpty qualified as NEL import Data.Text qualified as Text import Data.Text.IO qualified as Text import Ki qualified @@ -20,6 +21,7 @@ import System.IO (hGetEcho, hPutStrLn, hSetEcho, stderr, stdin) import System.IO.Error (isDoesNotExistError) import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.Operations qualified as Operations +import U.Codebase.Sqlite.Operations qualified as Ops import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Auth.CredentialManager (newCredentialManager) import Unison.Auth.HTTPClient (AuthenticatedHttpClient) @@ -30,12 +32,14 @@ import Unison.Cli.Pretty (prettyProjectAndBranchName) import Unison.Cli.ProjectUtils (projectBranchPathPrism) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch (Branch) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.HandleInput qualified as HandleInput import Unison.Codebase.Editor.Input (Event, Input (..)) import Unison.Codebase.Editor.Output (Output) import Unison.Codebase.Editor.UCMVersion (UCMVersion) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Runtime import Unison.CommandLine import Unison.CommandLine.Completion (haskelineTabComplete) @@ -60,10 +64,11 @@ import UnliftIO.STM getUserInput :: Codebase IO Symbol Ann -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPathCtx -> + IO (Branch IO) -> [String] -> IO Input -getUserInput codebase authHTTPClient currentPath numberedArgs = +getUserInput codebase authHTTPClient ppCtx currentProjectRoot numberedArgs = Line.runInputT settings (haskelineCtrlCHandling go) @@ -78,23 +83,15 @@ getUserInput codebase authHTTPClient currentPath numberedArgs = Just a -> pure a go :: Line.InputT IO Input go = do - promptString <- - case preview projectBranchPathPrism currentPath of - Nothing -> pure ((P.green . P.shown) currentPath) - Just (ProjectAndBranch projectId branchId, restPath) -> do - lift (Codebase.runTransaction codebase (Queries.loadProjectAndBranchNames projectId branchId)) <&> \case - -- If the project branch has been deleted from sqlite, just show a borked prompt - Nothing -> P.red "???" - Just (projectName, branchName) -> - P.sep - " " - ( catMaybes - [ Just (prettyProjectAndBranchName (ProjectAndBranch projectName branchName)), - case restPath of - Path.Empty -> Nothing - _ -> (Just . P.green . P.shown) restPath - ] - ) + let (PP.ProjectPath projectName projectBranchName path) = ppCtx ^. PP.ctxAsNames_ + let promptString = + P.sep + ":" + ( catMaybes + [ Just (prettyProjectAndBranchName (ProjectAndBranch projectName projectBranchName)), + (Just . P.green . P.shown) path + ] + ) let fullPrompt = P.toANSI 80 (promptString <> fromString prompt) line <- Line.getInputLine fullPrompt case line of @@ -102,7 +99,7 @@ getUserInput codebase authHTTPClient currentPath numberedArgs = Just l -> case words l of [] -> go ws -> do - liftIO (parseInput codebase currentPath numberedArgs IP.patternMap ws) >>= \case + liftIO (parseInput codebase ppCtx currentProjectRoot numberedArgs IP.patternMap ws) >>= \case Left msg -> do -- We still add history that failed to parse so the user can easily reload -- the input and fix it. @@ -125,12 +122,12 @@ getUserInput codebase authHTTPClient currentPath numberedArgs = historyFile = Just ".unisonHistory", autoAddHistory = False } - tabComplete = haskelineTabComplete IP.patternMap codebase authHTTPClient currentPath + tabComplete = haskelineTabComplete IP.patternMap codebase authHTTPClient ppCtx main :: FilePath -> Welcome.Welcome -> - Path.Absolute -> + PP.ProjectPathIds -> Config -> [Either Event Input] -> Runtime.Runtime Symbol -> @@ -143,9 +140,8 @@ main :: (Path.Absolute -> STM ()) -> ShouldWatchFiles -> IO () -main dir welcome initialPath config initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion notifyBranchChange notifyPathChange shouldWatchFiles = Ki.scoped \scope -> do +main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion notifyBranchChange notifyPathChange shouldWatchFiles = Ki.scoped \scope -> do rootVar <- newEmptyTMVarIO - initialRootCausalHash <- Codebase.runTransaction codebase Operations.expectRootCausalHash _ <- Ki.fork scope do root <- Codebase.getRootBranch codebase atomically do @@ -158,7 +154,7 @@ main dir welcome initialPath config initialInputs runtime sbRuntime nRuntime cod UnliftIO.concurrently_ (UnliftIO.evaluate root) (UnliftIO.evaluate IOSource.typecheckedFile) -- IOSource takes a while to compile, we should start compiling it on startup - let initialState = Cli.loopState0 initialRootCausalHash rootVar initialPath + let initialState = Cli.loopState0 rootVar ppIds Ki.fork_ scope do let loop lastRoot = do -- This doesn't necessarily notify on _every_ update, but the LSP only needs the @@ -186,10 +182,13 @@ main dir welcome initialPath config initialInputs runtime sbRuntime nRuntime cod getInput loopState = do currentEcho <- hGetEcho stdin liftIO $ restoreEcho currentEcho + let getProjectRoot = atomically $ readTMVar rootVar + Codebase.runTransaction codebase Ops.expectProjectAndBranchNames getUserInput codebase authHTTPClient - (loopState ^. #currentPath) + (NEL.head $ Cli.projectPathStack loopState) + getProjectRoot (loopState ^. #numberedArgs) let loadSourceFile :: Text -> IO Cli.LoadSourceResult loadSourceFile fname = From 2c64c6a4086031ebb53afdf0e0a1071651f456d7 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 21 May 2024 15:48:42 -0700 Subject: [PATCH 012/631] Checkpoint --- .../unison-parser-typechecker.cabal | 1 - unison-cli/src/Unison/Cli/MonadUtils.hs | 38 ++++++++--------- .../Codebase/Editor/HandleInput/Branch.hs | 4 +- unison-share-api/src/Unison/Server/Backend.hs | 25 ++--------- .../Unison/Server/Local/Endpoints/Current.hs | 41 +++++-------------- 5 files changed, 36 insertions(+), 73 deletions(-) diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index f57ba4ad5e..df1b0ec4b3 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -136,7 +136,6 @@ library Unison.PrettyPrintEnvDecl.Names Unison.PrettyPrintEnvDecl.Sqlite Unison.PrintError - Unison.Project.Util Unison.Result Unison.Runtime.ANF Unison.Runtime.ANF.Rehash diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index beaf3bff77..78308eae67 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -29,10 +29,10 @@ module Unison.Cli.MonadUtils getProjectRoot0, getCurrentBranch, getCurrentBranch0, - getBranchAt, - getBranch0At, - getMaybeBranchAt, - getMaybeBranch0At, + getBranchFromProjectRootPath, + getBranch0FromProjectRootPath, + getMaybeBranchFromProjectRootPath, + getMaybeBranch0FromProjectRootPath, expectBranchAtPath, expectBranchAtPath', expectBranch0AtPath, @@ -194,7 +194,7 @@ resolveSplit' = resolveAbsBranchId :: Input.AbsBranchId -> Cli (Branch IO) resolveAbsBranchId = \case Left hash -> resolveShortCausalHash hash - Right path -> getBranchAt path + Right path -> getBranchFromProjectRootPath path -- | V2 version of 'resolveAbsBranchId2'. resolveAbsBranchIdV2 :: @@ -289,26 +289,26 @@ getCurrentBranch0 :: Cli (Branch0 IO) getCurrentBranch0 = do Branch.head <$> getCurrentBranch --- | Get the branch at an absolute path. -getBranchAt :: Path.Absolute -> Cli (Branch IO) -getBranchAt path = - getMaybeBranchAt path <&> fromMaybe Branch.empty +-- | Get the branch at an absolute path from the project root. +getBranchFromProjectRootPath :: Path.Absolute -> Cli (Branch IO) +getBranchFromProjectRootPath path = + getMaybeBranchFromProjectRootPath path <&> fromMaybe Branch.empty -- | Get the branch0 at an absolute path. -getBranch0At :: Path.Absolute -> Cli (Branch0 IO) -getBranch0At path = - Branch.head <$> getBranchAt path +getBranch0FromProjectRootPath :: Path.Absolute -> Cli (Branch0 IO) +getBranch0FromProjectRootPath path = + Branch.head <$> getBranchFromProjectRootPath path -- | Get the maybe-branch at an absolute path. -getMaybeBranchAt :: Path.Absolute -> Cli (Maybe (Branch IO)) -getMaybeBranchAt path = do +getMaybeBranchFromProjectRootPath :: Path.Absolute -> Cli (Maybe (Branch IO)) +getMaybeBranchFromProjectRootPath path = do rootBranch <- getProjectRoot pure (Branch.getAt (Path.unabsolute path) rootBranch) -- | Get the maybe-branch0 at an absolute path. -getMaybeBranch0At :: Path.Absolute -> Cli (Maybe (Branch0 IO)) -getMaybeBranch0At path = - fmap Branch.head <$> getMaybeBranchAt path +getMaybeBranch0FromProjectRootPath :: Path.Absolute -> Cli (Maybe (Branch0 IO)) +getMaybeBranch0FromProjectRootPath path = + fmap Branch.head <$> getMaybeBranchFromProjectRootPath path -- | Get the branch at a relative path, or return early if there's no such branch. expectBranchAtPath :: Path -> Cli (Branch IO) @@ -319,7 +319,7 @@ expectBranchAtPath = expectBranchAtPath' :: Path' -> Cli (Branch IO) expectBranchAtPath' path0 = do path <- resolvePath' path0 - getMaybeBranchAt path & onNothingM (Cli.returnEarly (Output.BranchNotFound path0)) + getMaybeBranchFromProjectRootPath path & onNothingM (Cli.returnEarly (Output.BranchNotFound path0)) -- | Get the branch0 at an absolute or relative path, or return early if there's no such branch. expectBranch0AtPath' :: Path' -> Cli (Branch0 IO) @@ -520,7 +520,7 @@ getPatchAt path = getMaybePatchAt :: Path.Split' -> Cli (Maybe Patch) getMaybePatchAt path0 = do (path, name) <- resolveSplit' path0 - branch <- getBranch0At path + branch <- getBranch0FromProjectRootPath path liftIO (Branch.getMaybePatch name branch) -- | Get the patch at a path, or return early if there's no such patch. diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 9ca57e574e..0137f0e3f4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -16,7 +16,7 @@ import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.MonadUtils qualified as Cli (getBranchAt, getCurrentPath, updateAt) +import Unison.Cli.MonadUtils qualified as Cli (getBranchFromProjectRootPath, getCurrentPath, updateAt) import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Branch (Branch) import Unison.Codebase.Branch qualified as Branch (empty) @@ -117,7 +117,7 @@ doCreateBranch createFrom project newBranchName description = do CreateFrom'Branch (ProjectAndBranch _ sourceBranch) -> do let sourceProjectId = sourceBranch ^. #projectId let sourceBranchId = sourceBranch ^. #branchId - Cli.getBranchAt (ProjectUtils.projectBranchPath (ProjectAndBranch sourceProjectId sourceBranchId)) + Cli.getBranchFromProjectRootPath (ProjectUtils.projectBranchPath (ProjectAndBranch sourceProjectId sourceBranchId)) CreateFrom'LooseCode sourcePath -> Cli.getBranchAt sourcePath CreateFrom'Nothingness -> pure Branch.empty let projectId = project ^. #projectId diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs index 10cd18867b..7ee0554a30 100644 --- a/unison-share-api/src/Unison/Server/Backend.hs +++ b/unison-share-api/src/Unison/Server/Backend.hs @@ -58,7 +58,6 @@ module Unison.Server.Backend renderDocRefs, docsForDefinitionName, normaliseRootCausalHash, - causalHashForProjectBranchName, -- * Unused, could remove? resolveRootBranchHash, @@ -103,14 +102,11 @@ import U.Codebase.HashTags (BranchHash, CausalHash (..)) import U.Codebase.Referent qualified as V2Referent import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Operations qualified as Ops -import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) -import U.Codebase.Sqlite.Queries qualified as Q import Unison.ABT qualified as ABT import Unison.Builtin qualified as B import Unison.Builtin.Decls qualified as Decls import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase -import Unison.Codebase qualified as UCodebase import Unison.Codebase.Branch (Branch) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch @@ -147,8 +143,7 @@ import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnv.Util qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.PrettyPrintEnvDecl.Names qualified as PPED -import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) -import Unison.Project.Util qualified as ProjectUtils +import Unison.Project (ProjectBranchName, ProjectName) import Unison.Reference (Reference, TermReference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) @@ -365,12 +360,12 @@ lsAtPath :: (MonadIO m) => Codebase m Symbol Ann -> -- The root to follow the path from. - Maybe (V2Branch.Branch Sqlite.Transaction) -> + V2Branch.Branch Sqlite.Transaction -> -- Path from the root to the branch to 'ls' Path.Absolute -> m [ShallowListEntry Symbol Ann] -lsAtPath codebase mayRootBranch absPath = do - b <- Codebase.runTransaction codebase (Codebase.getShallowBranchAtPath (Path.unabsolute absPath) mayRootBranch) +lsAtPath codebase rootBranch absPath = do + b <- Codebase.runTransaction codebase (Codebase.getShallowBranchAtPath (Path.unabsolute absPath) rootBranch) lsBranch codebase b findDocInBranch :: @@ -1270,15 +1265,3 @@ loadTypeDisplayObject c = \case Reference.DerivedId id -> maybe (MissingObject $ Reference.idToShortHash id) UserObject <$> Codebase.getTypeDeclaration c id - --- | Get the causal hash a given project branch points to -causalHashForProjectBranchName :: MonadIO m => ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe CausalHash) -causalHashForProjectBranchName (ProjectAndBranch projectName branchName) = do - Q.loadProjectBranchByNames projectName branchName >>= \case - Nothing -> pure Nothing - Just ProjectBranch {projectId, branchId} -> do - let path = ProjectUtils.projectBranchPath (ProjectAndBranch projectId branchId) - -- Use the default codebase root - let codebaseRoot = Nothing - mayCausal <- UCodebase.getShallowCausalFromRoot codebaseRoot (Path.unabsolute path) - pure . Just $ V2Causal.causalHash mayCausal diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs index 5cc218b7eb..caf71afbe2 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs @@ -3,22 +3,18 @@ module Unison.Server.Local.Endpoints.Current where +import Control.Lens hiding ((.=)) import Control.Monad.Except import Data.Aeson import Data.OpenApi (ToSchema (..)) import Servant ((:>)) import Servant.Docs (ToSample (..)) -import U.Codebase.Sqlite.DbId -import U.Codebase.Sqlite.Project qualified as Project -import U.Codebase.Sqlite.ProjectBranch qualified as ProjectBranch -import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path -import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName (..), ProjectName (..)) -import Unison.NameSegment (NameSegment) +import Unison.Codebase.ProjectPath qualified as PP +import Unison.Core.Project (ProjectBranchName (..), ProjectName (..)) import Unison.Prelude -import Unison.Project.Util (pattern BranchesNameSegment, pattern ProjectsNameSegment, pattern UUIDNameSegment) import Unison.Server.Backend import Unison.Server.Types (APIGet) @@ -57,26 +53,11 @@ serveCurrent = lift . getCurrentProjectBranch getCurrentProjectBranch :: MonadIO m => Codebase m v a -> m Current getCurrentProjectBranch codebase = do - segments <- Codebase.runTransaction codebase Queries.expectMostRecentNamespace - let absolutePath = toPath segments - case toIds segments of - ProjectAndBranch (Just projectId) branchId -> - Codebase.runTransaction codebase do - project <- Queries.expectProject projectId - branch <- traverse (Queries.expectProjectBranch projectId) branchId - pure $ Current (Just $ Project.name project) (ProjectBranch.name <$> branch) absolutePath - ProjectAndBranch _ _ -> - pure $ Current Nothing Nothing absolutePath - where - toIds :: [NameSegment] -> ProjectAndBranch (Maybe ProjectId) (Maybe ProjectBranchId) - toIds segments = - case segments of - ProjectsNameSegment : UUIDNameSegment projectId : BranchesNameSegment : UUIDNameSegment branchId : _ -> - ProjectAndBranch {project = Just $ ProjectId projectId, branch = Just $ ProjectBranchId branchId} - ProjectsNameSegment : UUIDNameSegment projectId : _ -> - ProjectAndBranch {project = Just $ ProjectId projectId, branch = Nothing} - _ -> - ProjectAndBranch {project = Nothing, branch = Nothing} - - toPath :: [NameSegment] -> Path.Absolute - toPath = Path.Absolute . Path.fromList + ppCtx <- + Codebase.runTransaction codebase Codebase.loadCurrentProjectPathCtx <&> \case + Nothing -> + -- TODO: Come up with a better solution for this + error "No current project path context" + Just ppCtx -> ppCtx + let (PP.ProjectPath projName branchName path) = ppCtx ^. PP.ctxAsNames_ + pure $ Current (Just projName) (Just branchName) path From 1a15c3f2124f06d49ce90b2773261e2b05838699 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 21 May 2024 15:48:42 -0700 Subject: [PATCH 013/631] Set currentProjectPath in SQLite --- .../U/Codebase/Sqlite/Queries.hs | 51 ++++--- .../012-add-current-project-path-table.sql | 10 ++ .../unison-codebase-sqlite.cabal | 3 +- parser-typechecker/src/Unison/Codebase.hs | 20 +++ .../Migrations/MigrateSchema16To17.hs | 8 +- parser-typechecker/src/Unison/Project/Util.hs | 142 ------------------ 6 files changed, 67 insertions(+), 167 deletions(-) create mode 100644 codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql delete mode 100644 parser-typechecker/src/Unison/Project/Util.hs diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index dc05c3f185..208875cb10 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -235,9 +235,9 @@ module U.Codebase.Sqlite.Queries -- * elaborate hashes elaborateHashes, - -- * most recent namespace - expectMostRecentNamespace, - setMostRecentNamespace, + -- * current project path + loadCurrentProjectPath, + setCurrentProjectPath, -- * migrations createSchema, @@ -252,6 +252,7 @@ module U.Codebase.Sqlite.Queries addSquashResultTable, addSquashResultTableIfNotExists, cdToProjectRoot, + addCurrentProjectPathTable, -- ** schema version currentSchemaVersion, @@ -488,6 +489,10 @@ schemaVersion = FROM schema_version |] +addCurrentProjectPathTable :: Transaction () +addCurrentProjectPathTable = + executeStatements $(embedProjectStringFile "sql/012-add-current-project-path-table.sql") + data UnexpectedSchemaVersion = UnexpectedSchemaVersion { actual :: SchemaVersion, expected :: SchemaVersion @@ -4249,33 +4254,39 @@ data JsonParseFailure = JsonParseFailure deriving anyclass (SqliteExceptionReason) -- | Get the most recent namespace the user has visited. -expectMostRecentNamespace :: Transaction [NameSegment] -expectMostRecentNamespace = - queryOneColCheck +loadCurrentProjectPath :: Transaction (Maybe (ProjectId, ProjectBranchId, [NameSegment])) +loadCurrentProjectPath = + queryMaybeRowCheck [sql| - SELECT namespace - FROM most_recent_namespace + SELECT project_id, branch_id, path + FROM current_project_path |] check where - check :: Text -> Either JsonParseFailure [NameSegment] - check bytes = - case Aeson.eitherDecodeStrict (Text.encodeUtf8 bytes) of - Left failure -> Left JsonParseFailure {bytes, failure = Text.pack failure} - Right namespace -> Right (map NameSegment namespace) + check :: (ProjectId, ProjectBranchId, Text) -> Either JsonParseFailure (ProjectId, ProjectBranchId, [NameSegment]) + check (projId, branchId, pathText) = + case Aeson.eitherDecodeStrict (Text.encodeUtf8 pathText) of + Left failure -> Left JsonParseFailure {bytes = pathText, failure = Text.pack failure} + Right namespace -> Right (projId, branchId, map NameSegment namespace) -- | Set the most recent namespace the user has visited. -setMostRecentNamespace :: [Text] -> Transaction () -setMostRecentNamespace namespace = +setCurrentProjectPath :: + ProjectId -> + ProjectBranchId -> + [NameSegment] -> + Transaction () +setCurrentProjectPath projId branchId path = do + execute + [sql| TRUNCATE TABLE current_project_path |] execute [sql| - UPDATE most_recent_namespace - SET namespace = :json + INSERT INTO most_recent_namespace(project_id, branch_id, path) + VALUES (:projId, :branchId, :jsonPath) |] where - json :: Text - json = - Text.Lazy.toStrict (Aeson.encodeToLazyText namespace) + jsonPath :: Text + jsonPath = + Text.Lazy.toStrict (Aeson.encodeToLazyText $ map NameSegment.toUnescapedText path) -- | Get the causal hash result from squashing the provided branch hash if we've squashed it -- at some point in the past. diff --git a/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql b/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql new file mode 100644 index 0000000000..5a511a4394 --- /dev/null +++ b/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql @@ -0,0 +1,10 @@ +-- The most recent namespace that a user cd'd to. +-- This table should never have more than one row. +CREATE TABLE current_project_path ( + project_id INTEGER NOT NULL REFERENCES project (id), + branch_id INTEGER NOT NULL REFERENCES project_branch (id), + -- A json array like ["foo", "bar"]; the root namespace is represented by the empty array + path TEXT PRIMARY KEY NOT NULL +) WITHOUT ROWID; + +DROP TABLE "most_recent_namespace"; diff --git a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal index ac1f606921..0791856217 100644 --- a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal +++ b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack @@ -21,6 +21,7 @@ extra-source-files: sql/009-add-squash-cache-table.sql sql/010-ensure-squash-cache-table.sql sql/011-cd-to-project-root.sql + sql/012-add-current-project-path-table.sql sql/create.sql source-repository head diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 65608c0c96..d3df98a50b 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -1,6 +1,10 @@ module Unison.Codebase ( Codebase, + -- * UCM session state + loadCurrentProjectPathCtx, + setCurrentProjectPath, + -- * Terms getTerm, unsafeGetTerm, @@ -120,6 +124,7 @@ import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.DbId qualified as Db import U.Codebase.Sqlite.Operations qualified as Operations +import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries @@ -549,3 +554,18 @@ unsafeGetTermComponent codebase hash = getTermComponentWithTypes codebase hash <&> \case Nothing -> error (reportBug "E769004" ("term component " ++ show hash ++ " not found")) Just terms -> terms + +loadCurrentProjectPathCtx :: Sqlite.Transaction (Maybe PP.ProjectPathCtx) +loadCurrentProjectPathCtx = do + mProjectPath <- Q.loadCurrentProjectPath + case mProjectPath of + Nothing -> pure Nothing + Just (projectId, projectBranchId, path) -> do + Project {name = projectName} <- Q.expectProject projectId + ProjectBranch {name = branchName} <- Q.expectProjectBranch projectId projectBranchId + let absPath = Path.Absolute (Path.fromList path) + pure $ Just (PP.ProjectPath (projectId, projectName) (projectBranchId, branchName) absPath) + +setCurrentProjectPath :: PP.ProjectPathIds -> Sqlite.Transaction () +setCurrentProjectPath (PP.ProjectPath projectId projectBranchId path) = + Q.setCurrentProjectPath projectId projectBranchId (Path.toList (Path.unabsolute path)) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs index 45c41036a2..269f88de43 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs @@ -3,12 +3,12 @@ module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 (migrateSchema16To17) where -import U.Codebase.Sqlite.Queries qualified as Queries +import U.Codebase.Sqlite.Queries qualified as Q import Unison.Sqlite qualified as Sqlite -- | This migration adds the causal_object_id column to the project_branches table. migrateSchema16To17 :: Sqlite.Transaction () migrateSchema16To17 = do - Queries.expectSchemaVersion 16 - error "Impelement MigrateSchema16To17.migrateSchema16To17" - Queries.setSchemaVersion 17 + Q.expectSchemaVersion 16 + Q.addCurrentProjectPathTable + Q.setSchemaVersion 17 diff --git a/parser-typechecker/src/Unison/Project/Util.hs b/parser-typechecker/src/Unison/Project/Util.hs deleted file mode 100644 index edc670c063..0000000000 --- a/parser-typechecker/src/Unison/Project/Util.hs +++ /dev/null @@ -1,142 +0,0 @@ -module Unison.Project.Util - ( projectPath, - projectBranchesPath, - projectBranchPath, - projectBranchSegment, - projectPathPrism, - projectBranchPathPrism, - pattern UUIDNameSegment, - pattern ProjectsNameSegment, - pattern BranchesNameSegment, - ) -where - -import Control.Lens -import Data.Text qualified as Text -import Data.UUID (UUID) -import Data.UUID qualified as UUID -import U.Codebase.Sqlite.DbId (ProjectBranchId (..), ProjectId (..)) -import Unison.Codebase.Path qualified as Path -import Unison.NameSegment (NameSegment (..)) -import Unison.NameSegment qualified as NameSegment -import Unison.Project (ProjectAndBranch (..)) - --- | Get the path that a project is stored at. Users aren't supposed to go here. --- --- >>> projectPath "ABCD" --- .__projects._ABCD -projectPath :: ProjectId -> Path.Absolute -projectPath projectId = - review projectPathPrism projectId - --- | Get the path that a project's branches are stored at. Users aren't supposed to go here. --- --- >>> projectBranchesPath "ABCD" --- .__projects._ABCD.branches -projectBranchesPath :: ProjectId -> Path.Absolute -projectBranchesPath projectId = - snoc (projectPath projectId) BranchesNameSegment - --- | Get the path that a branch is stored at. Users aren't supposed to go here. --- --- >>> projectBranchPath ProjectAndBranch { project = "ABCD", branch = "DEFG" } --- .__projects._ABCD.branches._DEFG -projectBranchPath :: ProjectAndBranch ProjectId ProjectBranchId -> Path.Absolute -projectBranchPath projectAndBranch = - review projectBranchPathPrism (projectAndBranch, Path.empty) - --- | Get the name segment that a branch is stored at. --- --- >>> projectBranchSegment "DEFG" --- "_DEFG" -projectBranchSegment :: ProjectBranchId -> NameSegment -projectBranchSegment (ProjectBranchId branchId) = - UUIDNameSegment branchId - -pattern UUIDNameSegment :: UUID -> NameSegment -pattern UUIDNameSegment uuid <- - ( NameSegment.toUnescapedText -> - (Text.uncons -> Just ('_', UUID.fromText . Text.map (\c -> if c == '_' then '-' else c) -> Just uuid)) - ) - where - UUIDNameSegment uuid = - NameSegment (Text.cons '_' (Text.map (\c -> if c == '-' then '_' else c) (UUID.toText uuid))) - --- | The prism between paths like --- --- @ --- .__projects._XX_XX --- @ --- --- and the project id --- --- @ --- XX-XX --- @ -projectPathPrism :: Prism' Path.Absolute ProjectId -projectPathPrism = - prism' toPath toId - where - toPath :: ProjectId -> Path.Absolute - toPath projectId = - Path.Absolute (Path.fromList [ProjectsNameSegment, UUIDNameSegment (unProjectId projectId)]) - - toId :: Path.Absolute -> Maybe ProjectId - toId path = - case Path.toList (Path.unabsolute path) of - [ProjectsNameSegment, UUIDNameSegment projectId] -> Just (ProjectId projectId) - _ -> Nothing - --- | The prism between paths like --- --- @ --- .__projects._XX_XX.branches._YY_YY.foo.bar --- @ --- --- and the @(project id, branch id, path)@ triple --- --- @ --- (XX-XX, YY-YY, foo.bar) --- @ -projectBranchPathPrism :: Prism' Path.Absolute (ProjectAndBranch ProjectId ProjectBranchId, Path.Path) -projectBranchPathPrism = - prism' toPath toIds - where - toPath :: (ProjectAndBranch ProjectId ProjectBranchId, Path.Path) -> Path.Absolute - toPath (ProjectAndBranch {project = projectId, branch = branchId}, restPath) = - Path.Absolute $ - Path.fromList - ( [ ProjectsNameSegment, - UUIDNameSegment (unProjectId projectId), - BranchesNameSegment, - UUIDNameSegment (unProjectBranchId branchId) - ] - ++ Path.toList restPath - ) - - toIds :: Path.Absolute -> Maybe (ProjectAndBranch ProjectId ProjectBranchId, Path.Path) - toIds path = - case Path.toList (Path.unabsolute path) of - ProjectsNameSegment : UUIDNameSegment projectId : BranchesNameSegment : UUIDNameSegment branchId : restPath -> - Just (ProjectAndBranch {project = ProjectId projectId, branch = ProjectBranchId branchId}, Path.fromList restPath) - _ -> Nothing - -pattern ProjectsNameSegment :: NameSegment -pattern ProjectsNameSegment <- - ((== projectsNameSegment) -> True) - where - ProjectsNameSegment = projectsNameSegment - -pattern BranchesNameSegment :: NameSegment -pattern BranchesNameSegment <- - ((== branchesNameSegment) -> True) - where - BranchesNameSegment = branchesNameSegment - -projectsNameSegment :: NameSegment -projectsNameSegment = - "__projects" - -branchesNameSegment :: NameSegment -branchesNameSegment = - "branches" From dca8431b503127706ae326cc2ecaceef2cacfe36 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 21 May 2024 16:37:36 -0700 Subject: [PATCH 014/631] Add getShallowProjectRootByNames --- .../codebase-sqlite/U/Codebase/Sqlite/Operations.hs | 1 + parser-typechecker/src/Unison/Codebase.hs | 9 +++++++++ unison-share-api/src/Unison/Server/CodebaseServer.hs | 2 +- 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index 45b0950619..b32babbf1c 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -13,6 +13,7 @@ module U.Codebase.Sqlite.Operations saveBranchV3, loadCausalBranchByCausalHash, expectCausalBranchByCausalHash, + expectBranchByCausalHashId, expectBranchByBranchHash, expectBranchByBranchHashId, expectNamespaceStatsByHash, diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index d3df98a50b..6e86831e01 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -55,6 +55,7 @@ module Unison.Codebase getShallowRootCausal, getShallowProjectRootBranch, getShallowBranchAtProjectPath, + getShallowProjectRootByNames, -- * Root branch getRootBranch, @@ -144,6 +145,7 @@ import Unison.Codebase.SqliteCodebase.Operations qualified as SqliteCodebase.Ope import Unison.Codebase.Type (Codebase (..), GitError) import Unison.CodebasePath (CodebasePath, getCodebaseDir) import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) +import Unison.Core.Project (ProjectAndBranch) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DD import Unison.Hash (Hash) @@ -151,6 +153,7 @@ import Unison.Hashing.V2.Convert qualified as Hashing import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Parser import Unison.Prelude +import Unison.Project (ProjectAndBranch (ProjectAndBranch), ProjectBranchName, ProjectName) import Unison.Reference (Reference, TermReferenceId, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent @@ -252,6 +255,12 @@ getShallowBranchAtProjectPath (PP.ProjectPath projectId projectBranchId path) = projectRootBranch <- getShallowProjectRootBranch projectId projectBranchId getShallowBranchAtPath (Path.unabsolute path) projectRootBranch +getShallowProjectRootByNames :: ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe (V2Branch.CausalBranch Sqlite.Transaction)) +getShallowProjectRootByNames (ProjectAndBranch projectName branchName) = runMaybeT do + ProjectBranch {causalHashId} <- MaybeT $ Q.loadProjectBranchByNames projectName branchName + causalHash <- lift $ Q.expectCausalHash causalHashId + lift $ Operations.expectCausalBranchByCausalHash causalHash + -- | Get a v1 branch from the root following the given path. getBranchAtPath :: (MonadIO m) => diff --git a/unison-share-api/src/Unison/Server/CodebaseServer.hs b/unison-share-api/src/Unison/Server/CodebaseServer.hs index eb2332dc7a..88c57c8183 100644 --- a/unison-share-api/src/Unison/Server/CodebaseServer.hs +++ b/unison-share-api/src/Unison/Server/CodebaseServer.hs @@ -613,7 +613,7 @@ serveProjectsCodebaseServerAPI codebase rt projectName branchName = do resolveProjectRoot :: (Codebase IO v a) -> (ProjectAndBranch ProjectName ProjectBranchName) -> Backend IO CausalHash resolveProjectRoot codebase projectAndBranchName@(ProjectAndBranch projectName branchName) = do - mayCH <- liftIO . Codebase.runTransaction codebase $ Backend.causalHashForProjectBranchName @IO projectAndBranchName + mayCH <- liftIO . Codebase.runTransaction codebase $ Codebase.causalHashForProjectBranchName @IO projectAndBranchName case mayCH of Nothing -> throwError (Backend.ProjectBranchNameNotFound projectName branchName) Just ch -> pure ch From e250d0598054f6744f48ea66c90c8ab397330a20 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 14 May 2024 00:27:26 -0600 Subject: [PATCH 015/631] Maintain `NumberedArgs` as structured data This is the first step toward avoiding printing/parsing the values provided via `NumberedArgs`. It simply adds a new sum type to hold all of the types that can be in numbered args and stores it alongside the `Text` representation. It currently gets discarded when we actually expand the arguments. --- unison-cli/src/Unison/Cli/Pretty.hs | 4 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 64 +++++++++-------- .../Editor/HandleInput/FindAndReplace.hs | 4 +- .../src/Unison/Codebase/Editor/Output.hs | 8 ++- .../Codebase/Editor/StructuredArgument.hs | 31 ++++++++ unison-cli/src/Unison/CommandLine.hs | 2 +- .../src/Unison/CommandLine/OutputMessages.hs | 70 +++++++++++-------- unison-cli/tests/Unison/Test/Cli/Monad.hs | 6 +- unison-cli/unison-cli.cabal | 1 + 9 files changed, 124 insertions(+), 66 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index 4ec00b02fe..d3e1f2bfff 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -345,8 +345,8 @@ prettyWhichBranchEmpty = \case WhichBranchEmptyPath path -> prettyPath' path -- | Displays a full, non-truncated Branch.CausalHash to a string, e.g. #abcdef -displayBranchHash :: CausalHash -> String -displayBranchHash = ("#" <>) . Text.unpack . Hash.toBase32HexText . unCausalHash +displayBranchHash :: CausalHash -> Text +displayBranchHash = ("#" <>) . Hash.toBase32HexText . unCausalHash prettyHumanReadableTime :: UTCTime -> UTCTime -> Pretty prettyHumanReadableTime now time = diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index b9e06cd697..bfc6f72f6c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -5,6 +5,7 @@ module Unison.Codebase.Editor.HandleInput (loop) where -- TODO: Don't import backend +import Control.Arrow ((&&&)) import Control.Error.Util qualified as ErrorUtil import Control.Lens hiding (from) import Control.Monad.Reader (ask) @@ -96,6 +97,7 @@ import Unison.Codebase.Editor.Output.DumpNamespace qualified as Output.DN import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Editor.Slurp qualified as Slurp import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult +import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Codebase.IntegrityCheck qualified as IntegrityCheck (integrityCheckFullCodebase) import Unison.Codebase.Metadata qualified as Metadata @@ -288,19 +290,22 @@ loop e = do Cli.respond $ PrintMessage pretty ShowReflogI -> do let numEntriesToShow = 500 - entries <- - Cli.runTransaction do - schLength <- Codebase.branchHashLength - Codebase.getReflog numEntriesToShow <&> fmap (first $ SCH.fromHash schLength) + (schLength, entries) <- + Cli.runTransaction $ + (,) <$> Codebase.branchHashLength <*> Codebase.getReflog numEntriesToShow let moreEntriesToLoad = length entries == numEntriesToShow let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad) - let numberedEntries = expandedEntries <&> \(_time, hash, _reason) -> "#" <> SCH.toString hash + let (shortEntries, numberedEntries) = + unzip $ + expandedEntries <&> \(time, hash, reason) -> + let ((exp, txt), sa) = ((id &&& ("#" <>) . SCH.toText) . SCH.fromHash schLength &&& SA.Namespace) hash + in ((time, exp, reason), (txt, sa)) Cli.setNumberedArgs numberedEntries - Cli.respond $ ShowReflog expandedEntries + Cli.respond $ ShowReflog shortEntries where expandEntries :: - ([Reflog.Entry SCH.ShortCausalHash Text], Maybe SCH.ShortCausalHash, Bool) -> - Maybe ((Maybe UTCTime, SCH.ShortCausalHash, Text), ([Reflog.Entry SCH.ShortCausalHash Text], Maybe SCH.ShortCausalHash, Bool)) + ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool) -> + Maybe ((Maybe UTCTime, CausalHash, Text), ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool)) expandEntries ([], Just expectedHash, moreEntriesToLoad) = if moreEntriesToLoad then Nothing @@ -786,13 +791,13 @@ loop e = do (seg, _) <- Map.toList (Branch._edits b) ] Cli.respond $ ListOfPatches $ Set.fromList patches - Cli.setNumberedArgs $ fmap (Text.unpack . Name.toText) patches + Cli.setNumberedArgs $ fmap (Name.toText &&& SA.Name) patches FindShallowI pathArg -> do Cli.Env {codebase} <- ask pathArgAbs <- Cli.resolvePath' pathArg entries <- liftIO (Backend.lsAtPath codebase Nothing pathArgAbs) - Cli.setNumberedArgs $ fmap entryToHQString entries + Cli.setNumberedArgs $ fmap (entryToHQText &&& SA.ShallowListEntry pathArg) entries pped <- Cli.currentPrettyPrintEnvDecl let suffixifiedPPE = PPED.suffixifiedPPE pped -- This used to be a delayed action which only forced the loading of the root @@ -803,19 +808,20 @@ loop e = do let buildPPE = pure suffixifiedPPE Cli.respond $ ListShallow buildPPE entries where - entryToHQString :: ShallowListEntry v Ann -> String - entryToHQString e = - fixup $ Text.unpack case e of + entryToHQText :: ShallowListEntry v Ann -> Text + entryToHQText e = + fixup $ case e of ShallowTypeEntry te -> Backend.typeEntryDisplayName te ShallowTermEntry te -> Backend.termEntryDisplayName te ShallowBranchEntry ns _ _ -> NameSegment.toEscapedText ns ShallowPatchEntry ns -> NameSegment.toEscapedText ns where - fixup s = case pathArgStr of - "" -> s - p | last p == '.' -> p ++ s - p -> p ++ "." ++ s - pathArgStr = show pathArg + fixup s = + pathArgStr + <> if Text.null pathArgStr || Text.isSuffixOf "." pathArgStr + then s + else "." <> s + pathArgStr = Text.pack $ show pathArg FindI isVerbose fscope ws -> handleFindI isVerbose fscope ws input StructuredFindI _fscope ws -> handleStructuredFindI ws StructuredFindReplaceI ws -> handleStructuredFindReplaceI ws @@ -1495,7 +1501,7 @@ handleFindI isVerbose fscope ws input = do (mapMaybe (HQ.parseTextWith anythingBeforeHash . Text.pack) qs) pure $ uniqueBy SR.toReferent srs let respondResults results = do - Cli.setNumberedArgs $ fmap (searchResultToHQString searchRoot) results + Cli.setNumberedArgs $ fmap (searchResultToHQText searchRoot &&& SA.SearchResult searchRoot) results results' <- Cli.runTransaction (Backend.loadSearchResults codebase results) Cli.respond $ ListOfDefinitions fscope suffixifiedPPE isVerbose results' results <- getResults names @@ -1550,8 +1556,8 @@ handleDependencies hq = do let types = nubOrdOn snd . Name.sortByText (HQ.toText . fst) $ (join $ fst <$> results) let terms = nubOrdOn snd . Name.sortByText (HQ.toText . fst) $ (join $ snd <$> results) Cli.setNumberedArgs $ - map (Text.unpack . Reference.toText . snd) types - <> map (Text.unpack . Reference.toText . Referent.toReference . snd) terms + map ((Reference.toText &&& SA.Ref) . snd) types + <> map ((Reference.toText &&& SA.Ref) . Referent.toReference . snd) terms Cli.respond $ ListDependencies suffixifiedPPE lds (fst <$> types) (fst <$> terms) handleDependents :: HQ.HashQualified Name -> Cli () @@ -1588,7 +1594,7 @@ handleDependents hq = do let sort = nubOrdOn snd . Name.sortByText (HQ.toText . fst) let types = sort [(n, r) | (False, n, r) <- join results] let terms = sort [(n, r) | (True, n, r) <- join results] - Cli.setNumberedArgs $ map (Text.unpack . Reference.toText . view _2) (types <> terms) + Cli.setNumberedArgs . map ((Reference.toText &&& SA.Ref) . view _2) $ types <> terms Cli.respond (ListDependents ppe lds (fst <$> types) (fst <$> terms)) handleDiffNamespaceToPatch :: Text -> DiffNamespaceToPatchInput -> Cli () @@ -1769,9 +1775,7 @@ doShowTodoOutput patch scopePath = do then Cli.respond NoConflictsOrEdits else do Cli.setNumberedArgs - ( Text.unpack . Reference.toText . view _2 - <$> fst (TO.todoFrontierDependents todo) - ) + ((Reference.toText &&& SA.Ref) . view _2 <$> fst (TO.todoFrontierDependents todo)) pped <- Cli.currentPrettyPrintEnvDecl Cli.respondNumbered $ TodoOutput pped todo @@ -1817,11 +1821,11 @@ confirmedCommand i = do loopState <- State.get pure $ Just i == (loopState ^. #lastInput) --- | restores the full hash to these search results, for _numberedArgs purposes -searchResultToHQString :: Maybe Path -> SearchResult -> String -searchResultToHQString oprefix = \case - SR.Tm' n r _ -> Text.unpack $ HQ.toText $ HQ.requalify (addPrefix <$> n) r - SR.Tp' n r _ -> Text.unpack $ HQ.toText $ HQ.requalify (addPrefix <$> n) (Referent.Ref r) +--- | restores the full hash to these search results, for _numberedArgs purposes +searchResultToHQText :: Maybe Path -> SearchResult -> Text +searchResultToHQText oprefix = \case + SR.Tm' n r _ -> HQ.toText $ HQ.requalify (addPrefix <$> n) r + SR.Tp' n r _ -> HQ.toText $ HQ.requalify (addPrefix <$> n) (Referent.Ref r) _ -> error "impossible match failure" where addPrefix :: Name -> Name diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs index 83cc5486ea..9ad17bbcc6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs @@ -4,6 +4,7 @@ module Unison.Codebase.Editor.HandleInput.FindAndReplace ) where +import Control.Arrow ((&&&)) import Control.Lens hiding (at) import Control.Monad.Reader (ask) import Control.Monad.State @@ -18,6 +19,7 @@ import Unison.Cli.Pretty qualified as P import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.Output +import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' import Unison.Name (Name) @@ -87,7 +89,7 @@ handleStructuredFindI rule = do ok t = pure (t, False) results0 <- traverse ok results let results = Alphabetical.sortAlphabeticallyOn fst [(hq, r) | ((hq, r), True) <- results0] - let toNumArgs = Text.unpack . Reference.toText . Referent.toReference . view _2 + let toNumArgs = (Reference.toText &&& SA.Ref) . Referent.toReference . view _2 Cli.setNumberedArgs $ map toNumArgs results Cli.respond (ListStructuredFind (fst <$> results)) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 28ec687dee..751292ba92 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -36,6 +36,7 @@ import Unison.Codebase.Editor.Output.PushPull (PushPull) import Unison.Codebase.Editor.RemoteRepo import Unison.Codebase.Editor.SlurpResult (SlurpResult (..)) import Unison.Codebase.Editor.SlurpResult qualified as SR +import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Codebase.IntegrityCheck (IntegrityResult (..)) import Unison.Codebase.Patch (Patch) @@ -84,7 +85,12 @@ type ListDetailed = Bool type SourceName = Text -type NumberedArgs = [String] +-- | +-- +-- __NB__: This only temporarily holds `Text`. Until all of the inputs are +-- updated to handle `StructuredArgument`s, we need to ensure that the +-- serialization remains unchanged. +type NumberedArgs = [(Text, StructuredArgument)] type HashLength = Int diff --git a/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs new file mode 100644 index 0000000000..935d6ccd27 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs @@ -0,0 +1,31 @@ +module Unison.Codebase.Editor.StructuredArgument where + +import GHC.Generics (Generic) +import U.Codebase.HashTags (CausalHash) +import Unison.Codebase.Editor.Input +import Unison.Codebase.Path (Path, Path') +import Unison.Codebase.Path qualified as Path +import Unison.HashQualified qualified as HQ +import Unison.HashQualified' qualified as HQ' +import Unison.Name (Name) +import Unison.Parser.Ann (Ann) +import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName) +import Unison.Reference (Reference) +import Unison.Server.Backend (ShallowListEntry) +import Unison.Server.SearchResult (SearchResult) +import Unison.Symbol (Symbol) + +-- | The types that can be referenced by a numeric command argument. +data StructuredArgument + = AbsolutePath Path.Absolute + | Name Name + | HashQualified (HQ.HashQualified Name) + | Project ProjectName + | ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + | Ref Reference + | Namespace CausalHash + | NameWithBranchPrefix AbsBranchId Name + | HashQualifiedWithBranchPrefix AbsBranchId (HQ'.HashQualified Name) + | ShallowListEntry Path' (ShallowListEntry Symbol Ann) + | SearchResult (Maybe Path) SearchResult + deriving (Eq, Generic, Show) diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 38d53a4a8b..41cf3ae963 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -173,7 +173,7 @@ expandNumber :: NumberedArgs -> String -> [String] expandNumber numberedArgs s = case expandedNumber of Nothing -> [s] Just nums -> - [s | i <- nums, Just s <- [vargs Vector.!? (i - 1)]] + [Text.unpack (fst s) | i <- nums, Just s <- [vargs Vector.!? (i - 1)]] where vargs = Vector.fromList numberedArgs rangeRegex = "([0-9]+)-([0-9]+)" :: String diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 3464235f1d..af5b1fa1c5 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -5,6 +5,7 @@ module Unison.CommandLine.OutputMessages where +import Control.Arrow ((&&&)) import Control.Lens hiding (at) import Control.Monad.State import Control.Monad.State.Strict qualified as State @@ -61,6 +62,8 @@ import Unison.Codebase.Editor.Output.PushPull qualified as PushPull import Unison.Codebase.Editor.RemoteRepo (ShareUserHandle (..), WriteRemoteNamespace (..), WriteShareRemoteNamespace (..)) import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult +import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) +import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Codebase.GitError import Unison.Codebase.IntegrityCheck (IntegrityResult (..), prettyPrintIntegrityErrors) @@ -348,7 +351,7 @@ notifyNumbered = \case ] branchHashes :: [CausalHash] branchHashes = (fst <$> reversedHistory) <> tailHashes - in (msg, displayBranchHash <$> branchHashes) + in (msg, (displayBranchHash &&& SA.Namespace) <$> branchHashes) where toSCH :: CausalHash -> ShortCausalHash toSCH h = SCH.fromHash schLength h @@ -407,7 +410,7 @@ notifyNumbered = \case ListEdits patch ppe -> showListEdits patch ppe ListProjects projects -> ( P.numberedList (map (prettyProjectName . view #name) projects), - map (Text.unpack . into @Text . view #name) projects + map ((into @Text &&& SA.Project) . view #name) projects ) ListBranches projectName branches -> ( P.columnNHeader @@ -423,7 +426,13 @@ notifyNumbered = \case ] : map (\branch -> ["", "", prettyRemoteBranchInfo branch]) remoteBranches ), - map (\(branchName, _) -> Text.unpack (into @Text (ProjectAndBranch projectName branchName))) branches + map + ( ( (into @Text . ProjectAndBranch projectName) + &&& (SA.ProjectBranch . ProjectAndBranch (pure projectName)) + ) + . fst + ) + branches ) AmbiguousSwitch project (ProjectAndBranch currentProject branch) -> ( P.wrap @@ -448,8 +457,11 @@ notifyNumbered = \case <> switch ["2"] <> " to pick one of these." ), - [ Text.unpack (Text.cons '/' (into @Text branch)), - Text.unpack (into @Text (ProjectAndBranch project (UnsafeProjectBranchName "main"))) + [ (Text.cons '/' . into @Text &&& SA.ProjectBranch . ProjectAndBranch Nothing) branch, + ( (into @Text . ProjectAndBranch project) + &&& (SA.ProjectBranch . ProjectAndBranch (pure project)) + ) + $ UnsafeProjectBranchName "main" ] ) where @@ -478,8 +490,8 @@ notifyNumbered = \case <> reset (resetArgs ["2"]) <> " to pick one of these." ), - [ Text.unpack (Text.cons '/' (into @Text branch)), - Text.unpack (into @Text (show absPath0)) + [ (Text.cons '/' . into @Text &&& SA.ProjectBranch . ProjectAndBranch Nothing) branch, + (into @Text . show &&& SA.AbsolutePath) absPath0 ] ) where @@ -515,13 +527,13 @@ notifyNumbered = \case newNextNum = nextNum + length unnumberedNames in ( newNextNum, ( nameToNum <> (Map.fromList (zip unnumberedNames [nextNum ..])), - args <> fmap Name.toText unnumberedNames + args <> unnumberedNames ) ) ) (1, (mempty, mempty)) & snd - & over (_2 . mapped) Text.unpack + & over (_2 . mapped) (Name.toText &&& SA.Name) externalDepsTable :: Map LabeledDependency (Set Name) -> [(P.Pretty P.ColorText, P.Pretty P.ColorText)] externalDepsTable = ifoldMap $ \ld dependents -> [(prettyLD ld, prettyDependents dependents)] @@ -601,7 +613,7 @@ showListEdits patch ppe = let lhsTermName = PPE.termName ppe (Referent.Ref lhsRef) -- We use the shortHash of the lhs rather than its name for numbered args, -- since its name is likely to be "historical", and won't work if passed to a ucm command. - let lhsHash = Text.unpack . ShortHash.toText . Reference.toShortHash $ lhsRef + let lhsHash = (ShortHash.toText . Reference.toShortHash &&& SA.Ref) $ lhsRef case termEdit of TermEdit.Deprecate -> do lift $ tell ([lhsHash], []) @@ -612,7 +624,7 @@ showListEdits patch ppe = TermEdit.Replace rhsRef _typing -> do n2 <- gets snd <* modify (second succ) let rhsTermName = PPE.termName ppe (Referent.Ref rhsRef) - lift $ tell ([lhsHash], [Text.unpack (HQ.toText rhsTermName)]) + lift $ tell ([lhsHash], [(HQ.toText &&& SA.HashQualified) rhsTermName]) pure ( showNum n1 <> (P.syntaxToColor . prettyHashQualified $ lhsTermName), "-> " <> showNum n2 <> (P.syntaxToColor . prettyHashQualified $ rhsTermName) @@ -626,7 +638,7 @@ showListEdits patch ppe = let lhsTypeName = PPE.typeName ppe lhsRef -- We use the shortHash of the lhs rather than its name for numbered args, -- since its name is likely to be "historical", and won't work if passed to a ucm command. - let lhsHash = Text.unpack . ShortHash.toText . Reference.toShortHash $ lhsRef + let lhsHash = (ShortHash.toText . Reference.toShortHash &&& SA.Ref) $ lhsRef case typeEdit of TypeEdit.Deprecate -> do lift $ tell ([lhsHash], []) @@ -637,7 +649,7 @@ showListEdits patch ppe = TypeEdit.Replace rhsRef -> do n2 <- gets snd <* modify (second succ) let rhsTypeName = PPE.typeName ppe rhsRef - lift $ tell ([lhsHash], [Text.unpack (HQ.toText rhsTypeName)]) + lift $ tell ([lhsHash], [(HQ.toText &&& SA.HashQualified) rhsTypeName]) pure ( showNum n1 <> (P.syntaxToColor . prettyHashQualified $ lhsTypeName), "-> " <> showNum n2 <> (P.syntaxToColor . prettyHashQualified $ rhsTypeName) @@ -1651,7 +1663,7 @@ notifyUser dir = \case prettyNamespaceKey dest <> "is already up-to-date with" <> P.group (prettyNamespaceKey src <> ".") - DumpNumberedArgs args -> pure . P.numberedList $ fmap P.string args + DumpNumberedArgs args -> pure . P.numberedList $ fmap (P.text . fst) args NoConflictsOrEdits -> pure (P.okCallout "No conflicts or edits in progress.") HelpMessage pat -> pure $ IP.showPatternHelp pat @@ -2717,7 +2729,7 @@ renderNameConflicts ppe conflictedNames = do P.lines <$> do for (Map.toList conflictedNames) $ \(name, hashes) -> do prettyConflicts <- for hashes \hash -> do - n <- addNumberedArg (Text.unpack (HQ.toText hash)) + n <- addNumberedArg $ (HQ.toText &&& SA.HashQualified) hash pure $ formatNum n <> (P.blue . P.syntaxToColor . prettyHashQualified $ hash) pure . P.wrap $ ( "The " @@ -2749,7 +2761,7 @@ renderEditConflicts ppe Patch {..} = do <> (fmap Right . Map.toList . R.toMultimap . R.filterManyDom $ _termEdits) numberedHQName :: HQ.HashQualified Name -> Numbered Pretty numberedHQName hqName = do - n <- addNumberedArg (Text.unpack (HQ.toText hqName)) + n <- addNumberedArg $ (HQ.toText &&& SA.HashQualified) hqName pure $ formatNum n <> styleHashQualified P.bold hqName formatTypeEdits :: (Reference, Set TypeEdit.TypeEdit) -> @@ -2788,9 +2800,9 @@ renderEditConflicts ppe Patch {..} = do Numbered Pretty formatConflict = either formatTypeEdits formatTermEdits -type Numbered = State.State (Int, Seq.Seq String) +type Numbered = State.State (Int, Seq.Seq (Text, StructuredArgument)) -addNumberedArg :: String -> Numbered Int +addNumberedArg :: (Text, StructuredArgument) -> Numbered Int addNumberedArg s = do (n, args) <- State.get State.put (n + 1, args Seq.|> s) @@ -2862,11 +2874,11 @@ todoOutput ppe todo = runNumbered do todoEdits :: Numbered Pretty todoEdits = do numberedTypes <- for (unscore <$> dirtyTypes) \(ref, displayObj) -> do - n <- addNumberedArg (Text.unpack (HQ.toText $ PPE.typeName ppeu ref)) + n <- addNumberedArg . (HQ.toText &&& SA.HashQualified) $ PPE.typeName ppeu ref pure $ formatNum n <> prettyDeclPair ppeu (ref, displayObj) let filteredTerms = goodTerms (unscore <$> dirtyTerms) termNumbers <- for filteredTerms \(ref, _, _) -> do - n <- addNumberedArg (Text.unpack (HQ.toText $ PPE.termName ppeu ref)) + n <- addNumberedArg . (HQ.toText &&& SA.HashQualified) $ PPE.termName ppeu ref pure $ formatNum n let formattedTerms = TypePrinter.prettySignaturesCT ppes filteredTerms numberedTerms = zipWith (<>) termNumbers formattedTerms @@ -3166,7 +3178,7 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} = [] -> mempty x : ys -> " (" <> P.commas (x <> " updates" : ys) <> ")" pure $ n <> P.bold " patch " <> prettyName name <> message - -- 18. patch q + -- 18. patch q prettyNamePatch prefix (name, _patchDiff) = do n <- numPatch prefix name pure $ n <> P.bold " patch " <> prettyName name @@ -3271,21 +3283,21 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} = -- DeclPrinter.prettyDeclHeader : HQ -> Either numPatch :: Input.AbsBranchId -> Name -> Numbered Pretty numPatch prefix name = - addNumberedArg' $ prefixBranchId prefix name + addNumberedArg' $ (prefixBranchId prefix &&& SA.NameWithBranchPrefix prefix) name numHQ' :: Input.AbsBranchId -> HQ'.HashQualified Name -> Referent -> Numbered Pretty numHQ' prefix hq r = - addNumberedArg' . HQ'.toStringWith (prefixBranchId prefix) . HQ'.requalify hq $ r + addNumberedArg' . (HQ'.toTextWith (prefixBranchId prefix) &&& SA.HashQualifiedWithBranchPrefix prefix) $ HQ'.requalify hq r -- E.g. - -- prefixBranchId "#abcdef" "base.List.map" -> "#abcdef.base.List.map" + -- prefixBranchId "#abcdef" "base.List.map" -> "#abcdef:.base.List.map" -- prefixBranchId ".base" "List.map" -> ".base.List.map" - prefixBranchId :: Input.AbsBranchId -> Name -> String + prefixBranchId :: Input.AbsBranchId -> Name -> Text prefixBranchId branchId name = case branchId of - Left sch -> "#" <> SCH.toString sch <> ":" <> Text.unpack (Name.toText (Name.makeAbsolute name)) - Right pathPrefix -> Text.unpack (Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name)) + Left sch -> "#" <> SCH.toText sch <> ":" <> Name.toText (Name.makeAbsolute name) + Right pathPrefix -> Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name) - addNumberedArg' :: String -> Numbered Pretty + addNumberedArg' :: (Text, StructuredArgument) -> Numbered Pretty addNumberedArg' s = case sn of ShowNumbers -> do n <- addNumberedArg s @@ -3540,7 +3552,7 @@ numberedArgsForEndangerments (PPED.unsuffixifiedPPE -> ppe) m = m & Map.elems & concatMap toList - & fmap (Text.unpack . HQ.toText . PPE.labeledRefName ppe) + & fmap ((HQ.toText &&& SA.HashQualified) . PPE.labeledRefName ppe) -- | Format and render all dependents which are endangered by references going extinct. endangeredDependentsTable :: diff --git a/unison-cli/tests/Unison/Test/Cli/Monad.hs b/unison-cli/tests/Unison/Test/Cli/Monad.hs index 3b9407da11..0edb1dc3de 100644 --- a/unison-cli/tests/Unison/Test/Cli/Monad.hs +++ b/unison-cli/tests/Unison/Test/Cli/Monad.hs @@ -6,6 +6,8 @@ where import Control.Lens import EasyTest import Unison.Cli.Monad qualified as Cli +import Unison.Codebase.Editor.StructuredArgument qualified as SA +import Unison.Reference qualified as Reference test :: Test () test = @@ -16,13 +18,13 @@ test = Cli.runCli dummyEnv dummyLoopState do Cli.label \goto -> do Cli.label \_ -> do - Cli.setNumberedArgs ["foo"] + Cli.setNumberedArgs [SA.Ref $ Reference.ReferenceBuiltin "foo"] goto (1 :: Int) pure 2 -- test that 'goto' short-circuits, as expected expectEqual' (Cli.Success 1) r -- test that calling 'goto' doesn't lose state changes made along the way - expectEqual' ["foo"] (state ^. #numberedArgs) + expectEqual' [SA.Ref $ Reference.ReferenceBuiltin "foo"] (state ^. #numberedArgs) ok ] diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 804f0f4ef2..43b6756ff6 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -93,6 +93,7 @@ library Unison.Codebase.Editor.Slurp Unison.Codebase.Editor.SlurpComponent Unison.Codebase.Editor.SlurpResult + Unison.Codebase.Editor.StructuredArgument Unison.Codebase.Editor.TodoOutput Unison.Codebase.Editor.UCMVersion Unison.Codebase.Editor.UriParser From 8a95c5fe52f5f4395b21bacd542080ab5ff15616 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 14 May 2024 21:18:08 -0600 Subject: [PATCH 016/631] Push `StructuredArgument`s into `InputPattern`s MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This forces each `InputPattern.parse` function to serialize any `StructuredArgument` in its arguments. It’s a stop-gap that allows us to incrementally handle the structured arguments command-by-command. --- unison-cli/src/Unison/CommandLine.hs | 27 +- .../src/Unison/CommandLine/InputPattern.hs | 13 +- .../src/Unison/CommandLine/InputPatterns.hs | 548 ++++++++++-------- unison-cli/src/Unison/CommandLine/Main.hs | 7 +- 4 files changed, 332 insertions(+), 263 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 41cf3ae963..2c8be9bf43 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -131,7 +131,7 @@ parseInput :: [String] -> -- Returns either an error message or the fully expanded arguments list and parsed input. -- If the output is `Nothing`, the user cancelled the input (e.g. ctrl-c) - IO (Either (P.Pretty CT.ColorText) (Maybe ([String], Input))) + IO (Either (P.Pretty CT.ColorText) (Maybe (InputPattern.Arguments, Input))) parseInput codebase currentPath numberedArgs patterns segments = runExceptT do let getCurrentBranch0 :: IO (Branch0 IO) getCurrentBranch0 = Branch.head <$> Codebase.getBranchAtPath codebase currentPath @@ -141,16 +141,16 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do [] -> throwE "" command : args -> case Map.lookup command patterns of Just pat@(InputPattern {parse, help}) -> do - let expandedNumbers :: [String] + let expandedNumbers :: InputPattern.Arguments expandedNumbers = - foldMap (expandNumber numberedArgs) args + foldMap (\arg -> maybe [Left arg] (fmap pure) $ expandNumber numberedArgs arg) args lift (fzfResolve codebase projCtx getCurrentBranch0 pat expandedNumbers) >>= \case Left (NoFZFResolverForArgumentType _argDesc) -> throwError help Left (NoFZFOptions argDesc) -> throwError (noCompletionsMessage argDesc) Left FZFCancelled -> pure Nothing Right resolvedArgs -> do parsedInput <- except . parse $ resolvedArgs - pure $ Just (command : resolvedArgs, parsedInput) + pure $ Just (Left command : resolvedArgs, parsedInput) Nothing -> throwE . warn @@ -169,11 +169,9 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do ] -- Expand a numeric argument like `1` or a range like `3-9` -expandNumber :: NumberedArgs -> String -> [String] -expandNumber numberedArgs s = case expandedNumber of - Nothing -> [s] - Just nums -> - [Text.unpack (fst s) | i <- nums, Just s <- [vargs Vector.!? (i - 1)]] +expandNumber :: NumberedArgs -> String -> Maybe NumberedArgs +expandNumber numberedArgs s = + (\nums -> [arg | i <- nums, Just arg <- [vargs Vector.!? (i - 1)]]) <$> expandedNumber where vargs = Vector.fromList numberedArgs rangeRegex = "([0-9]+)-([0-9]+)" :: String @@ -194,13 +192,13 @@ data FZFResolveFailure | NoFZFOptions Text {- argument description -} | FZFCancelled -fzfResolve :: Codebase IO Symbol Ann -> ProjectContext -> (IO (Branch0 IO)) -> InputPattern -> [String] -> IO (Either FZFResolveFailure [String]) +fzfResolve :: Codebase IO Symbol Ann -> ProjectContext -> (IO (Branch0 IO)) -> InputPattern -> InputPattern.Arguments -> IO (Either FZFResolveFailure InputPattern.Arguments) fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do -- We resolve args in two steps, first we check that all arguments that will require a fzf -- resolver have one, and only if so do we prompt the user to actually do a fuzzy search. -- Otherwise, we might ask the user to perform a search only to realize we don't have a resolver -- for a later arg. - argumentResolvers :: [ExceptT FZFResolveFailure IO [String]] <- + argumentResolvers :: [ExceptT FZFResolveFailure IO InputPattern.Arguments] <- (Align.align (InputPattern.args pat) args) & traverse \case This (argName, opt, InputPattern.ArgumentType {fzfResolver}) @@ -213,7 +211,7 @@ fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do These _ arg -> pure $ pure [arg] argumentResolvers & foldMapM id where - fuzzyFillArg :: InputPattern.IsOptional -> Text -> InputPattern.FZFResolver -> ExceptT FZFResolveFailure IO [String] + fuzzyFillArg :: InputPattern.IsOptional -> Text -> InputPattern.FZFResolver -> ExceptT FZFResolveFailure IO InputPattern.Arguments fuzzyFillArg opt argDesc InputPattern.FZFResolver {getOptions} = do currentBranch <- Branch.withoutTransitiveLibs <$> liftIO getCurrentBranch options <- liftIO $ getOptions codebase projCtx currentBranch @@ -224,8 +222,9 @@ fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do `whenNothingM` throwError FZFCancelled -- If the user triggered the fuzzy finder, but selected nothing, abort the command rather than continuing execution -- with no arguments. - when (null results) $ throwError FZFCancelled - pure (Text.unpack <$> results) + if null results + then throwError FZFCancelled + else pure (Left . Text.unpack <$> results) multiSelectForOptional :: InputPattern.IsOptional -> Bool multiSelectForOptional = \case diff --git a/unison-cli/src/Unison/CommandLine/InputPattern.hs b/unison-cli/src/Unison/CommandLine/InputPattern.hs index f72506bab5..15f58eb73b 100644 --- a/unison-cli/src/Unison/CommandLine/InputPattern.hs +++ b/unison-cli/src/Unison/CommandLine/InputPattern.hs @@ -4,8 +4,10 @@ module Unison.CommandLine.InputPattern ( InputPattern (..), + Argument, ArgumentType (..), ArgumentDescription, + Arguments, argType, FZFResolver (..), IsOptional (..), @@ -25,6 +27,7 @@ import System.Console.Haskeline qualified as Line import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Codebase (Codebase) import Unison.Codebase.Editor.Input (Input (..)) +import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) import Unison.Codebase.Path as Path import Unison.CommandLine.FZFResolvers (FZFResolver (..)) import Unison.Prelude @@ -44,6 +47,14 @@ data IsOptional data Visibility = Hidden | Visible deriving (Show, Eq, Ord) +-- | An argument to a command is either a string provided by the user which +-- needs to be parsed or a numbered argument that doesn’t need to be parsed, as +-- we’ve preserved its representation (although the numbered argument could +-- still be of the wrong type, which should result in an error). +type Argument = Either String (Text, StructuredArgument) + +type Arguments = [Argument] + -- | Argument description -- It should fit grammatically into sentences like "I was expecting an argument for the " -- e.g. "namespace to merge", "definition to delete", "remote target to push to" etc. @@ -55,7 +66,7 @@ data InputPattern = InputPattern visibility :: Visibility, -- Allow hiding certain commands when debugging or work-in-progress args :: [(ArgumentDescription, IsOptional, ArgumentType)], help :: P.Pretty CT.ColorText, - parse :: [String] -> Either (P.Pretty CT.ColorText) Input + parse :: Arguments -> Either (P.Pretty CT.ColorText) Input } data ArgumentType = ArgumentType diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 9068042514..f82e3c8dcd 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -66,6 +66,26 @@ import Unison.Util.ColorText qualified as CT import Unison.Util.Monoid (intercalateMap) import Unison.Util.Pretty qualified as P +-- | +-- +-- __TODO__: Temporary. This may stick around in a handful of cases, but it’ll +-- have to actually serialize the `StructuredArgument` rather than +-- relying on the parallel `Text`. +unifyArgument :: I.Argument -> String +unifyArgument = either id (Text.unpack . fst) + +-- | Reversed composition, here temporarily to support the deferred parsing. +-- +-- __TODO__: Temporary. +andThen :: (a -> b) -> (b -> c) -> a -> c +andThen = flip (.) + +-- | +-- +-- __TODO__: Temporary. +unifyArguments :: [I.Argument] -> [String] +unifyArguments = fmap unifyArgument + showPatternHelp :: InputPattern -> P.Pretty CT.ColorText showPatternHelp i = P.lines @@ -107,7 +127,7 @@ mergeBuiltins = I.Hidden [("namespace", Optional, namespaceArg)] "Adds the builtins (excluding `io` and misc) to the specified namespace. Defaults to `builtin.`" - \case + $ unifyArguments `andThen` \case [] -> pure . Input.MergeBuiltinsI $ Nothing [p] -> first P.text do p <- Path.parsePath p @@ -122,7 +142,7 @@ mergeIOBuiltins = I.Hidden [("namespace", Optional, namespaceArg)] "Adds all the builtins, including `io` and misc., to the specified namespace. Defaults to `builtin.`" - \case + $ unifyArguments `andThen` \case [] -> pure . Input.MergeIOBuiltinsI $ Nothing [p] -> first P.text do p <- Path.parsePath p @@ -162,7 +182,7 @@ todo = ) ] ) - ( \case + ( unifyArguments `andThen` \case patchStr : ws -> mapLeft (warn . P.text) $ do patch <- Path.parseSplit' patchStr branch <- case ws of @@ -189,7 +209,7 @@ load = ) ] ) - ( \case + ( unifyArguments `andThen` \case [] -> pure $ Input.LoadI Nothing [file] -> pure $ Input.LoadI . Just $ file _ -> Left (I.help load) @@ -223,7 +243,7 @@ add = ( "`add` adds to the codebase all the definitions from the most recently " <> "typechecked file." ) - \ws -> pure $ Input.AddI (Set.fromList $ map (Name.unsafeParseText . Text.pack) ws) + $ pure . Input.AddI . Set.fromList . map (Name.unsafeParseText . Text.pack) . unifyArguments previewAdd :: InputPattern previewAdd = @@ -237,7 +257,7 @@ previewAdd = <> "results. Use `load` to reparse & typecheck the file if the context " <> "has changed." ) - \ws -> pure $ Input.PreviewAddI (Set.fromList $ map (Name.unsafeParseText . Text.pack) ws) + $ pure . Input.PreviewAddI . Set.fromList . map (Name.unsafeParseText . Text.pack) . unifyArguments update :: InputPattern update = @@ -284,12 +304,11 @@ updateOldNoPatch = ) ] ) - ( \case - ws -> do - pure $ - Input.UpdateI - Input.NoPatch - (Set.fromList $ map (Name.unsafeParseText . Text.pack) ws) + ( pure + . Input.UpdateI Input.NoPatch + . Set.fromList + . map (Name.unsafeParseText . Text.pack) + . unifyArguments ) updateOld :: InputPattern @@ -324,7 +343,7 @@ updateOld = ) ] ) - \case + $ unifyArguments `andThen` \case patchStr : ws -> do patch <- first P.text $ Path.parseSplit' patchStr pure $ @@ -345,7 +364,7 @@ previewUpdate = <> "typechecking results. Use `load` to reparse & typecheck the file if " <> "the context has changed." ) - \ws -> pure $ Input.PreviewUpdateI (Set.fromList $ map (Name.unsafeParseText . Text.pack) ws) + $ pure . Input.PreviewUpdateI . Set.fromList . map (Name.unsafeParseText . Text.pack) . unifyArguments patch :: InputPattern patch = @@ -373,7 +392,7 @@ patch = ] ] ) - \case + $ unifyArguments `andThen` \case patchStr : ws -> first P.text do patch <- Path.parseSplit' patchStr branch <- case ws of @@ -404,7 +423,7 @@ view = <> "not `List.map.doc` (since ? only matches 1 name segment)." ] ) - ( \case + ( unifyArguments `andThen` \case (x : xs) -> (x NE.:| xs) & traverse parseHashQualifiedName @@ -424,7 +443,7 @@ viewGlobal = "`view.global` without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH." ] ) - ( \case + ( unifyArguments `andThen` \case (x : xs) -> (x NE.:| xs) & traverse parseHashQualifiedName @@ -444,7 +463,7 @@ display = "`display` without arguments invokes a search to select a definition to display, which requires that `fzf` can be found within your PATH." ] ) - \case + $ unifyArguments `andThen` \case (x : xs) -> (x NE.:| xs) & traverse parseHashQualifiedName @@ -462,7 +481,7 @@ displayTo = makeExample displayTo ["", "foo"] <> "prints a rendered version of the term `foo` to the given file." ) - \case + $ unifyArguments `andThen` \case file : (x : xs) -> (x NE.:| xs) & traverse parseHashQualifiedName @@ -481,7 +500,7 @@ docs = "`docs` without arguments invokes a search to select which definition to view documentation for, which requires that `fzf` can be found within your PATH." ] ) - ( \case + ( unifyArguments `andThen` \case x : xs -> (x NE.:| xs) & traverse Path.parseHQSplit' @@ -507,12 +526,13 @@ ui = visibility = I.Visible, args = [("definition to load", Optional, namespaceOrDefinitionArg)], help = P.wrap "`ui` opens the Local UI in the default browser.", - parse = \case - [] -> pure $ Input.UiI Path.relativeEmpty' - [path] -> first P.text $ do - p <- Path.parsePath' path - pure $ Input.UiI p - _ -> Left (I.help ui) + parse = + unifyArguments `andThen` \case + [] -> pure $ Input.UiI Path.relativeEmpty' + [path] -> first P.text $ do + p <- Path.parsePath' path + pure $ Input.UiI p + _ -> Left (I.help ui) } undo :: InputPattern @@ -535,11 +555,12 @@ viewByPrefix = "`view.recursive Foo` prints the definitions of `Foo` and `Foo.blah`." ( fmap (Input.ShowDefinitionByPrefixI Input.ConsoleLocation) . traverse parseHashQualifiedName + . unifyArguments ) sfind :: InputPattern sfind = - InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse + InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg $ parse . unifyArguments where parse [q] = Input.StructuredFindI (Input.FindLocal Path.empty) <$> parseHashQualifiedName q parse _ = Left "expected exactly one argument" @@ -570,7 +591,7 @@ sfind = sfindReplace :: InputPattern sfindReplace = - InputPattern "rewrite" ["sfind.replace"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse + InputPattern "rewrite" ["sfind.replace"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg $ parse . unifyArguments where parse [q] = Input.StructuredFindReplaceI <$> parseHashQualifiedName q parse _ = Left "expected exactly one argument" @@ -619,7 +640,7 @@ findIn' cmd mkfscope = I.Visible [("namespace", Required, namespaceArg), ("query", ZeroPlus, exactDefinitionArg)] findHelp - \case + $ unifyArguments `andThen` \case p : args -> first P.text do p <- Path.parsePath p pure (Input.FindI False (mkfscope p) args) @@ -669,7 +690,7 @@ find' cmd fscope = I.Visible [("query", ZeroPlus, exactDefinitionArg)] findHelp - (pure . Input.FindI False fscope) + (pure . Input.FindI False fscope . unifyArguments) findShallow :: InputPattern findShallow = @@ -684,7 +705,7 @@ findShallow = ("`list .foo`", "lists the '.foo' namespace.") ] ) - ( \case + ( unifyArguments `andThen` \case [] -> pure $ Input.FindShallowI Path.relativeEmpty' [path] -> first P.text $ do p <- Path.parsePath' path @@ -702,7 +723,7 @@ findVerbose = ( "`find.verbose` searches for definitions like `find`, but includes hashes " <> "and aliases in the results." ) - (pure . Input.FindI True (Input.FindLocal Path.empty)) + (pure . Input.FindI True (Input.FindLocal Path.empty) . unifyArguments) findVerboseAll :: InputPattern findVerboseAll = @@ -714,7 +735,7 @@ findVerboseAll = ( "`find.all.verbose` searches for definitions like `find.all`, but includes hashes " <> "and aliases in the results." ) - (pure . Input.FindI True (Input.FindLocalAndDeps Path.empty)) + (pure . Input.FindI True (Input.FindLocalAndDeps Path.empty) . unifyArguments) findPatch :: InputPattern findPatch = @@ -738,7 +759,7 @@ renameTerm = ("new location", Required, newNameArg) ] "`move.term foo bar` renames `foo` to `bar`." - ( \case + ( unifyArguments `andThen` \case [oldName, newName] -> first P.text do src <- Path.parseHQSplit' oldName target <- Path.parseSplit' newName @@ -759,7 +780,7 @@ moveAll = ("new location", Required, newNameArg) ] "`move foo bar` renames the term, type, and namespace foo to bar." - ( \case + ( unifyArguments `andThen` \case [oldName, newName] -> first P.text $ do src <- Path.parsePath' oldName target <- Path.parsePath' newName @@ -780,7 +801,7 @@ renameType = ("new location", Required, newNameArg) ] "`move.type foo bar` renames `foo` to `bar`." - ( \case + ( unifyArguments `andThen` \case [oldName, newName] -> first P.text do src <- Path.parseHQSplit' oldName target <- Path.parseSplit' newName @@ -828,7 +849,7 @@ deleteGen suffix queryCompletionArg target mkTarget = I.Visible [("definition to delete", OnePlus, queryCompletionArg)] info - ( \case + ( unifyArguments `andThen` \case [] -> Left . P.warnCallout $ P.wrap warn queries -> first P.text do paths <- traverse Path.parseHQSplit' queries @@ -876,7 +897,7 @@ deleteReplacement isTerm = <> str <> " - not the one in place after the edit." ) - ( \case + ( unifyArguments `andThen` \case query : patch -> do patch <- first P.text . traverse Path.parseSplit' $ listToMaybe patch q <- parseHashQualifiedName query @@ -912,11 +933,12 @@ deleteProject = P.wrapColumn2 [ ("`delete.project foo`", "deletes the local project `foo`") ], - parse = \case - [name] - | Right project <- tryInto @ProjectName (Text.pack name) -> - Right (Input.DeleteI (DeleteTarget'Project project)) - _ -> Left (showPatternHelp deleteProject) + parse = + unifyArguments `andThen` \case + [name] + | Right project <- tryInto @ProjectName (Text.pack name) -> + Right (Input.DeleteI (DeleteTarget'Project project)) + _ -> Left (showPatternHelp deleteProject) } deleteBranch :: InputPattern @@ -931,12 +953,13 @@ deleteBranch = [ ("`delete.branch foo/bar`", "deletes the branch `bar` in the project `foo`"), ("`delete.branch /bar`", "deletes the branch `bar` in the current project") ], - parse = \case - [name] -> - case tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) (Text.pack name) of - Left _ -> Left (showPatternHelp deleteBranch) - Right projectAndBranch -> Right (Input.DeleteI (DeleteTarget'ProjectBranch projectAndBranch)) - _ -> Left (showPatternHelp deleteBranch) + parse = + unifyArguments `andThen` \case + [name] -> + case tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) (Text.pack name) of + Left _ -> Left (showPatternHelp deleteBranch) + Right projectAndBranch -> Right (Input.DeleteI (DeleteTarget'ProjectBranch projectAndBranch)) + _ -> Left (showPatternHelp deleteBranch) } where suggestionsConfig = @@ -960,7 +983,7 @@ aliasTerm = I.Visible [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)] "`alias.term foo bar` introduces `bar` with the same definition as `foo`." - \case + $ unifyArguments `andThen` \case [oldName, newName] -> first P.text do source <- Path.parseShortHashOrHQSplit' oldName target <- Path.parseSplit' newName @@ -978,7 +1001,7 @@ aliasType = I.Visible [("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)] "`alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`." - \case + $ unifyArguments `andThen` \case [oldName, newName] -> first P.text do source <- Path.parseShortHashOrHQSplit' oldName target <- Path.parseSplit' newName @@ -1004,7 +1027,7 @@ aliasMany = <> "creates aliases `.quux.foo.foo` and `.quux.bar.bar`." ] ) - \case + $ unifyArguments `andThen` \case srcs@(_ : _) Cons.:> dest -> first P.text do sourceDefinitions <- traverse Path.parseHQSplit srcs destNamespace <- Path.parsePath' dest @@ -1050,7 +1073,7 @@ cd = ] ] ) - \case + $ unifyArguments `andThen` \case [".."] -> Right Input.UpI [p] -> first P.text do p <- Path.parsePath' p @@ -1082,7 +1105,7 @@ deleteNamespace = I.Visible [("namespace to delete", Required, namespaceArg)] "`delete.namespace ` deletes the namespace `foo`" - (deleteNamespaceParser (I.help deleteNamespace) Input.Try) + (deleteNamespaceParser (I.help deleteNamespace) Input.Try . unifyArguments) deleteNamespaceForce :: InputPattern deleteNamespaceForce = @@ -1094,7 +1117,7 @@ deleteNamespaceForce = ( "`delete.namespace.force ` deletes the namespace `foo`," <> "deletion will proceed even if other code depends on definitions in foo." ) - (deleteNamespaceParser (I.help deleteNamespaceForce) Input.Force) + (deleteNamespaceParser (I.help deleteNamespaceForce) Input.Force . unifyArguments) deleteNamespaceParser :: P.Pretty CT.ColorText -> Input.Insistence -> [String] -> Either (P.Pretty CT.ColorText) Input deleteNamespaceParser helpText insistence = \case @@ -1115,7 +1138,7 @@ deletePatch = I.Visible [("patch to delete", Required, patchArg)] "`delete.patch ` deletes the patch `foo`" - \case + $ unifyArguments `andThen` \case [p] -> first P.text do p <- Path.parseSplit' p pure . Input.DeleteI $ DeleteTarget'Patch p @@ -1141,7 +1164,7 @@ copyPatch = I.Visible [("patch to copy", Required, patchArg), ("copy destination", Required, newNameArg)] "`copy.patch foo bar` copies the patch `foo` to `bar`." - \case + $ unifyArguments `andThen` \case [src, dest] -> copyPatch' src dest _ -> Left (I.help copyPatch) @@ -1153,7 +1176,7 @@ renamePatch = I.Visible [("patch", Required, patchArg), ("new location", Required, newNameArg)] "`move.patch foo bar` renames the patch `foo` to `bar`." - \case + $ unifyArguments `andThen` \case [src, dest] -> movePatch src dest _ -> Left (I.help renamePatch) @@ -1165,7 +1188,7 @@ renameBranch = I.Visible [("namespace to move", Required, namespaceArg), ("new location", Required, newNameArg)] "`move.namespace foo bar` renames the path `foo` to `bar`." - \case + $ unifyArguments `andThen` \case [src, dest] -> first P.text do src <- Path.parsePath' src dest <- Path.parsePath' dest @@ -1188,7 +1211,7 @@ history = ) ] ) - \case + $ unifyArguments `andThen` \case [src] -> first P.text do p <- Input.parseBranchId src pure $ Input.HistoryI (Just 10) (Just 10) p @@ -1216,7 +1239,7 @@ forkLocal = ) ] ) - \case + $ unifyArguments `andThen` \case [src, dest] -> do src <- Input.parseBranchId2 src dest <- parseBranchRelativePath dest @@ -1239,15 +1262,18 @@ reset = ("`reset #pvfd222s8n /topic`", "reset the branch `topic` of the current project to the causal `#pvfd222s8n`.") ] ) - ( maybeToEither (I.help reset) . \case - arg0 : restArgs -> do - arg0 <- branchIdOrProject arg0 - arg1 <- case restArgs of - [] -> pure Nothing - arg1 : [] -> Just <$> parseLooseCodeOrProject arg1 - _ -> Nothing - Just (Input.ResetI arg0 arg1) - _ -> Nothing + ( maybeToEither (I.help reset) + . ( \case + arg0 : restArgs -> do + arg0 <- branchIdOrProject arg0 + arg1 <- case restArgs of + [] -> pure Nothing + arg1 : [] -> Just <$> parseLooseCodeOrProject arg1 + _ -> Nothing + Just (Input.ResetI arg0 arg1) + _ -> Nothing + ) + . unifyArguments ) where branchIdOrProject :: @@ -1293,7 +1319,7 @@ resetRoot = ] ] ) - \case + $ unifyArguments `andThen` \case [src] -> first P.text $ do src <- Input.parseBranchId src pure $ Input.ResetRootI src @@ -1361,21 +1387,24 @@ pullImpl name aliases verbosity pullMode addendum = do explainRemote Pull ], parse = - maybeToEither (I.help self) . \case - [] -> Just $ Input.PullRemoteBranchI Input.PullSourceTarget0 SyncMode.ShortCircuit pullMode verbosity - [sourceString] -> do - source <- parsePullSource (Text.pack sourceString) - Just $ Input.PullRemoteBranchI (Input.PullSourceTarget1 source) SyncMode.ShortCircuit pullMode verbosity - [sourceString, targetString] -> do - source <- parsePullSource (Text.pack sourceString) - target <- parseLooseCodeOrProject targetString - Just $ - Input.PullRemoteBranchI - (Input.PullSourceTarget2 source target) - SyncMode.ShortCircuit - pullMode - verbosity - _ -> Nothing + maybeToEither (I.help self) + . ( \case + [] -> Just $ Input.PullRemoteBranchI Input.PullSourceTarget0 SyncMode.ShortCircuit pullMode verbosity + [sourceString] -> do + source <- parsePullSource (Text.pack sourceString) + Just $ Input.PullRemoteBranchI (Input.PullSourceTarget1 source) SyncMode.ShortCircuit pullMode verbosity + [sourceString, targetString] -> do + source <- parsePullSource (Text.pack sourceString) + target <- parseLooseCodeOrProject targetString + Just $ + Input.PullRemoteBranchI + (Input.PullSourceTarget2 source target) + SyncMode.ShortCircuit + pullMode + verbosity + _ -> Nothing + ) + . unifyArguments } pullExhaustive :: InputPattern @@ -1396,32 +1425,35 @@ pullExhaustive = <> "versions M1l and earlier. It may be extra slow!" ] ) - ( maybeToEither (I.help pullExhaustive) . \case - [] -> - Just $ - Input.PullRemoteBranchI - Input.PullSourceTarget0 - SyncMode.Complete - Input.PullWithHistory - Verbosity.Verbose - [sourceString] -> do - source <- parsePullSource (Text.pack sourceString) - Just $ - Input.PullRemoteBranchI - (Input.PullSourceTarget1 source) - SyncMode.Complete - Input.PullWithHistory - Verbosity.Verbose - [sourceString, targetString] -> do - source <- parsePullSource (Text.pack sourceString) - target <- parseLooseCodeOrProject targetString - Just $ - Input.PullRemoteBranchI - (Input.PullSourceTarget2 source target) - SyncMode.Complete - Input.PullWithHistory - Verbosity.Verbose - _ -> Nothing + ( maybeToEither (I.help pullExhaustive) + . ( \case + [] -> + Just $ + Input.PullRemoteBranchI + Input.PullSourceTarget0 + SyncMode.Complete + Input.PullWithHistory + Verbosity.Verbose + [sourceString] -> do + source <- parsePullSource (Text.pack sourceString) + Just $ + Input.PullRemoteBranchI + (Input.PullSourceTarget1 source) + SyncMode.Complete + Input.PullWithHistory + Verbosity.Verbose + [sourceString, targetString] -> do + source <- parsePullSource (Text.pack sourceString) + target <- parseLooseCodeOrProject targetString + Just $ + Input.PullRemoteBranchI + (Input.PullSourceTarget2 source target) + SyncMode.Complete + Input.PullWithHistory + Verbosity.Verbose + _ -> Nothing + ) + . unifyArguments ) debugTabCompletion :: InputPattern @@ -1436,9 +1468,7 @@ debugTabCompletion = P.wrap $ "Completions which are finished are prefixed with a * represent finished completions." ] ) - ( \inputs -> - Right $ Input.DebugTabCompletionI inputs - ) + (Right . Input.DebugTabCompletionI . unifyArguments) debugFuzzyOptions :: InputPattern debugFuzzyOptions = @@ -1455,7 +1485,7 @@ debugFuzzyOptions = P.wrap $ "or `debug.fuzzy-options merge - _`" ] ) - \case + $ unifyArguments `andThen` \case (cmd : args) -> Right $ Input.DebugFuzzyOptionsI cmd args _ -> Left (I.help debugFuzzyOptions) @@ -1508,7 +1538,7 @@ push = explainRemote Push ] ) - \args -> do + $ unifyArguments `andThen` \args -> do sourceTarget <- case args of [] -> Right Input.PushSourceTarget0 @@ -1564,7 +1594,7 @@ pushCreate = explainRemote Push ] ) - \args -> do + $ unifyArguments `andThen` \args -> do sourceTarget <- case args of [] -> Right Input.PushSourceTarget0 @@ -1599,7 +1629,7 @@ pushForce = I.Hidden [("remote destination", Optional, remoteNamespaceArg), ("local source", Optional, namespaceOrProjectBranchArg suggestionsConfig)] (P.wrap "Like `push`, but overwrites any remote namespace.") - \args -> do + $ unifyArguments `andThen` \args -> do sourceTarget <- case args of [] -> Right Input.PushSourceTarget0 @@ -1644,7 +1674,7 @@ pushExhaustive = <> "versions M1l and earlier. It may be extra slow!" ] ) - \args -> do + $ unifyArguments `andThen` \args -> do sourceTarget <- case args of [] -> Right Input.PushSourceTarget0 @@ -1686,12 +1716,15 @@ squashMerge = <> "The resulting `dest` will have (at most) 1" <> "additional history entry.", parse = - maybeToEither (I.help squashMerge) . \case - [src, dest] -> do - src <- parseLooseCodeOrProject src - dest <- parseLooseCodeOrProject dest - Just $ Input.MergeLocalBranchI src dest Branch.SquashMerge - _ -> Nothing + maybeToEither (I.help squashMerge) + . ( \case + [src, dest] -> do + src <- parseLooseCodeOrProject src + dest <- parseLooseCodeOrProject dest + Just $ Input.MergeLocalBranchI src dest Branch.SquashMerge + _ -> Nothing + ) + . unifyArguments } where suggestionsConfig = @@ -1731,15 +1764,18 @@ mergeLocal = ) ] ) - ( maybeToEither (I.help mergeLocal) . \case - [src] -> do - src <- parseLooseCodeOrProject src - Just $ Input.MergeLocalBranchI src (This Path.relativeEmpty') Branch.RegularMerge - [src, dest] -> do - src <- parseLooseCodeOrProject src - dest <- parseLooseCodeOrProject dest - Just $ Input.MergeLocalBranchI src dest Branch.RegularMerge - _ -> Nothing + ( maybeToEither (I.help mergeLocal) + . ( \case + [src] -> do + src <- parseLooseCodeOrProject src + Just $ Input.MergeLocalBranchI src (This Path.relativeEmpty') Branch.RegularMerge + [src, dest] -> do + src <- parseLooseCodeOrProject src + dest <- parseLooseCodeOrProject dest + Just $ Input.MergeLocalBranchI src dest Branch.RegularMerge + _ -> Nothing + ) + . unifyArguments ) where config = @@ -1778,7 +1814,7 @@ diffNamespace = ) ] ) - ( \case + ( unifyArguments `andThen` \case [before, after] -> first P.text do before <- Input.parseBranchId before after <- Input.parseBranchId after @@ -1812,15 +1848,18 @@ previewMergeLocal = ) ] ) - ( maybeToEither (I.help previewMergeLocal) . \case - [src] -> do - src <- parseLooseCodeOrProject src - pure $ Input.PreviewMergeLocalBranchI src (This Path.relativeEmpty') - [src, dest] -> do - src <- parseLooseCodeOrProject src - dest <- parseLooseCodeOrProject dest - pure $ Input.PreviewMergeLocalBranchI src dest - _ -> Nothing + ( maybeToEither (I.help previewMergeLocal) + . ( \case + [src] -> do + src <- parseLooseCodeOrProject src + pure $ Input.PreviewMergeLocalBranchI src (This Path.relativeEmpty') + [src, dest] -> do + src <- parseLooseCodeOrProject src + dest <- parseLooseCodeOrProject dest + pure $ Input.PreviewMergeLocalBranchI src dest + _ -> Nothing + ) + . unifyArguments ) where suggestionsConfig = @@ -1857,7 +1896,7 @@ replaceEdit f = self ) ] ) - ( \case + ( unifyArguments `andThen` \case source : target : patch -> do patch <- first P.text <$> traverse Path.parseSplit' $ listToMaybe patch sourcehq <- parseHashQualifiedName source @@ -1898,7 +1937,7 @@ edit = "`edit` without arguments invokes a search to select a definition for editing, which requires that `fzf` can be found within your PATH." ], parse = - \case + unifyArguments `andThen` \case (x : xs) -> (x NE.:| xs) & traverse parseHashQualifiedName @@ -1918,7 +1957,7 @@ editNamespace = [ "`edit.namespace` will load all terms and types contained within the current namespace into your scratch file. This includes definitions in namespaces, but excludes libraries.", "`edit.namespace ns1 ns2 ...` loads the terms and types contained within the provided namespaces." ], - parse = Right . Input.EditNamespaceI . fmap (Path.unsafeParseText . Text.pack) + parse = Right . Input.EditNamespaceI . fmap (Path.unsafeParseText . Text.pack) . unifyArguments } topicNameArg :: ArgumentType @@ -1946,7 +1985,7 @@ helpTopics = I.Visible [("topic", Optional, topicNameArg)] ("`help-topics` lists all topics and `help-topics ` shows an explanation of that topic.") - ( \case + ( unifyArguments `andThen` \case [] -> Left topics [topic] -> case Map.lookup topic helpTopicsMap of Nothing -> Left . warn $ "I don't know of that topic. Try `help-topics`." @@ -2129,7 +2168,7 @@ help = I.Visible [("command", Optional, commandNameArg)] "`help` shows general help and `help ` shows help for one command." - \case + $ unifyArguments `andThen` \case [] -> Left $ intercalateMap @@ -2191,7 +2230,7 @@ viewPatch = ) ] ) - \case + $ unifyArguments `andThen` \case [] -> Right $ Input.ListEditsI Nothing [patchStr] -> mapLeft P.text do patch <- Path.parseSplit' patchStr @@ -2206,7 +2245,7 @@ names isGlobal = I.Visible [("name or hash", Required, definitionQueryArg)] (P.wrap $ makeExample (names isGlobal) ["foo"] <> " shows the hash and all known names for `foo`.") - \case + $ unifyArguments `andThen` \case [thing] -> case HQ.parseText (Text.pack thing) of Just hq -> Right $ Input.NamesI isGlobal hq Nothing -> @@ -2225,7 +2264,7 @@ dependents = I.Visible [("definition", Required, definitionQueryArg)] "List the named dependents of the specified definition." - \case + $ unifyArguments `andThen` \case [thing] -> fmap Input.ListDependentsI $ parseHashQualifiedName thing _ -> Left (I.help dependents) dependencies = @@ -2235,7 +2274,7 @@ dependencies = I.Visible [("definition", Required, definitionQueryArg)] "List the dependencies of the specified definition." - \case + $ unifyArguments `andThen` \case [thing] -> fmap Input.ListDependenciesI $ parseHashQualifiedName thing _ -> Left (I.help dependencies) @@ -2247,7 +2286,7 @@ namespaceDependencies = I.Visible [("namespace", Optional, namespaceArg)] "List the external dependencies of the specified namespace." - \case + $ unifyArguments `andThen` \case [p] -> first P.text do p <- Path.parsePath' p pure $ Input.NamespaceDependenciesI (Just p) @@ -2302,7 +2341,7 @@ debugTerm = I.Hidden [("term", Required, exactDefinitionTermQueryArg)] "View debugging information for a given term." - ( \case + ( unifyArguments `andThen` \case [thing] -> fmap (Input.DebugTermI False) $ parseHashQualifiedName thing _ -> Left (I.help debugTerm) ) @@ -2315,7 +2354,7 @@ debugTermVerbose = I.Hidden [("term", Required, exactDefinitionTermQueryArg)] "View verbose debugging information for a given term." - ( \case + ( unifyArguments `andThen` \case [thing] -> fmap (Input.DebugTermI True) $ parseHashQualifiedName thing _ -> Left (I.help debugTermVerbose) ) @@ -2328,7 +2367,7 @@ debugType = I.Hidden [("type", Required, exactDefinitionTypeQueryArg)] "View debugging information for a given type." - ( \case + ( unifyArguments `andThen` \case [thing] -> fmap (Input.DebugTypeI) $ parseHashQualifiedName thing _ -> Left (I.help debugType) ) @@ -2376,7 +2415,7 @@ debugNameDiff = args = [("before namespace", Required, namespaceArg), ("after namespace", Required, namespaceArg)], help = P.wrap "List all name changes between two causal hashes. Does not detect patch changes.", parse = - ( \case + ( unifyArguments `andThen` \case [from, to] -> first fromString $ do fromSCH <- Input.parseShortCausalHash from toSCH <- Input.parseShortCausalHash to @@ -2435,7 +2474,7 @@ docsToHtml = ) ] ) - \case + $ unifyArguments `andThen` \case [namespacePath, destinationFilePath] -> first P.text do np <- Path.parsePath' namespacePath pure $ Input.DocsToHtmlI np destinationFilePath @@ -2454,7 +2493,7 @@ docToMarkdown = ) ] ) - \case + $ unifyArguments `andThen` \case [docNameText] -> first fromString $ do docName <- maybeToEither "Invalid name" . Name.parseText . Text.pack $ docNameText pure $ Input.DocToMarkdownI docName @@ -2476,7 +2515,7 @@ execute = ) ] ) - \case + $ unifyArguments `andThen` \case [w] -> pure $ Input.ExecuteI (Text.pack w) [] w : ws -> pure $ Input.ExecuteI (Text.pack w) ws _ -> Left $ showPatternHelp execute @@ -2491,7 +2530,7 @@ saveExecuteResult = ( "`add.run name` adds to the codebase the result of the most recent `run` command" <> "as `name`." ) - \case + $ unifyArguments `andThen` \case [w] -> pure $ Input.SaveExecuteResultI (Name.unsafeParseText (Text.pack w)) _ -> Left $ showPatternHelp saveExecuteResult @@ -2508,9 +2547,10 @@ ioTest = "Runs `!mytest`, where `mytest` is a delayed test that can use the `IO` and `Exception` abilities." ) ], - parse = \case - [thing] -> fmap Input.IOTestI $ parseHashQualifiedName thing - _ -> Left $ showPatternHelp ioTest + parse = + unifyArguments `andThen` \case + [thing] -> fmap Input.IOTestI $ parseHashQualifiedName thing + _ -> Left $ showPatternHelp ioTest } ioTestAll :: InputPattern @@ -2546,7 +2586,7 @@ makeStandalone = ) ] ) - \case + $ unifyArguments `andThen` \case [main, file] -> Input.MakeStandaloneI file <$> parseHashQualifiedName main _ -> Left $ showPatternHelp makeStandalone @@ -2564,7 +2604,7 @@ runScheme = ) ] ) - \case + $ unifyArguments `andThen` \case main : args -> Right $ Input.ExecuteSchemeI (Text.pack main) args _ -> Left $ showPatternHelp runScheme @@ -2583,7 +2623,7 @@ compileScheme = ) ] ) - \case + $ unifyArguments `andThen` \case [main, file] -> Input.CompileSchemeI (Text.pack file) <$> parseHashQualifiedName main _ -> Left $ showPatternHelp compileScheme @@ -2606,7 +2646,7 @@ createAuthor = <> backtick (P.group ("metadata.copyrightHolders" <> ".")) ) ) - ( \case + ( unifyArguments `andThen` \case symbolStr : authorStr@(_ : _) -> first P.text do symbol <- Megaparsec.runParser (Megaparsec.withParsecT (fmap NameSegment.renderParseErr) NameSegment.segmentP <* Megaparsec.eof) "" symbolStr @@ -2641,7 +2681,7 @@ gist = <> "`push.create` of the current namespace to your Unison Share codebase wherever you like!" ] ) - ( \case + ( unifyArguments `andThen` \case [repoString] -> do repo <- parseWriteGitRepo "gist git repo" repoString pure (Input.GistI (Input.GistInput repo)) @@ -2688,14 +2728,15 @@ diffNamespaceToPatch = visibility = I.Visible, args = [], help = P.wrap "Create a patch from a namespace diff.", - parse = \case - [branchId1, branchId2, patch] -> - mapLeft P.text do - branchId1 <- Input.parseBranchId branchId1 - branchId2 <- Input.parseBranchId branchId2 - patch <- Path.parseSplit' patch - pure (Input.DiffNamespaceToPatchI Input.DiffNamespaceToPatchInput {branchId1, branchId2, patch}) - _ -> Left (showPatternHelp diffNamespaceToPatch) + parse = + unifyArguments `andThen` \case + [branchId1, branchId2, patch] -> + mapLeft P.text do + branchId1 <- Input.parseBranchId branchId1 + branchId2 <- Input.parseBranchId branchId2 + patch <- Path.parseSplit' patch + pure (Input.DiffNamespaceToPatchI Input.DiffNamespaceToPatchInput {branchId1, branchId2, patch}) + _ -> Left (showPatternHelp diffNamespaceToPatch) } projectCreate :: InputPattern @@ -2710,12 +2751,13 @@ projectCreate = [ ("`project.create`", "creates a project with a random name"), ("`project.create foo`", "creates a project named `foo`") ], - parse = \case - [name] -> - case tryInto @ProjectName (Text.pack name) of - Left _ -> Left "Invalid project name." - Right name1 -> Right (Input.ProjectCreateI True (Just name1)) - _ -> Right (Input.ProjectCreateI True Nothing) + parse = + unifyArguments `andThen` \case + [name] -> + case tryInto @ProjectName (Text.pack name) of + Left _ -> Left "Invalid project name." + Right name1 -> Right (Input.ProjectCreateI True (Just name1)) + _ -> Right (Input.ProjectCreateI True Nothing) } projectCreateEmptyInputPattern :: InputPattern @@ -2730,12 +2772,13 @@ projectCreateEmptyInputPattern = [ ("`project.create-empty`", "creates an empty project with a random name"), ("`project.create-empty foo`", "creates an empty project named `foo`") ], - parse = \case - [name] -> - case tryInto @ProjectName (Text.pack name) of - Left _ -> Left "Invalid project name." - Right name1 -> Right (Input.ProjectCreateI False (Just name1)) - _ -> Right (Input.ProjectCreateI False Nothing) + parse = + unifyArguments `andThen` \case + [name] -> + case tryInto @ProjectName (Text.pack name) of + Left _ -> Left "Invalid project name." + Right name1 -> Right (Input.ProjectCreateI False (Just name1)) + _ -> Right (Input.ProjectCreateI False Nothing) } projectRenameInputPattern :: InputPattern @@ -2749,9 +2792,10 @@ projectRenameInputPattern = P.wrapColumn2 [ ("`project.rename foo`", "renames the current project to `foo`") ], - parse = \case - [nameString] | Right name <- tryInto (Text.pack nameString) -> Right (Input.ProjectRenameI name) - _ -> Left (showPatternHelp projectRenameInputPattern) + parse = + unifyArguments `andThen` \case + [nameString] | Right name <- tryInto (Text.pack nameString) -> Right (Input.ProjectRenameI name) + _ -> Left (showPatternHelp projectRenameInputPattern) } projectSwitch :: InputPattern @@ -2768,12 +2812,13 @@ projectSwitch = ("`switch foo/`", "switches to the last branch you visited in the project `foo`"), ("`switch /bar`", "switches to the branch `bar` in the current project") ], - parse = \case - [name] -> - case tryInto @ProjectAndBranchNames (Text.pack name) of - Left _ -> Left (showPatternHelp projectSwitch) - Right projectAndBranch -> Right (Input.ProjectSwitchI projectAndBranch) - _ -> Left (showPatternHelp projectSwitch) + parse = + unifyArguments `andThen` \case + [name] -> + case tryInto @ProjectAndBranchNames (Text.pack name) of + Left _ -> Left (showPatternHelp projectSwitch) + Right projectAndBranch -> Right (Input.ProjectSwitchI projectAndBranch) + _ -> Left (showPatternHelp projectSwitch) } where suggestionsConfig = @@ -2806,10 +2851,11 @@ branchesInputPattern = [ ("`branches`", "lists all branches in the current project"), ("`branches foo", "lists all branches in the project `foo`") ], - parse = \case - [] -> Right (Input.BranchesI Nothing) - [nameString] | Right name <- tryFrom (Text.pack nameString) -> Right (Input.BranchesI (Just name)) - _ -> Left (showPatternHelp branchesInputPattern) + parse = + unifyArguments `andThen` \case + [] -> Right (Input.BranchesI Nothing) + [nameString] | Right name <- tryFrom (Text.pack nameString) -> Right (Input.BranchesI (Just name)) + _ -> Left (showPatternHelp branchesInputPattern) } branchInputPattern :: InputPattern @@ -2829,21 +2875,24 @@ branchInputPattern = ("`branch .bar foo`", "forks the path `.bar` of the current project to a new branch `foo`") ], parse = - maybeToEither (showPatternHelp branchInputPattern) . \case - [source0, name] -> do - source <- parseLooseCodeOrProject source0 - projectAndBranch <- - Text.pack name - & tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - & eitherToMaybe - Just (Input.BranchI (Input.BranchSourceI'LooseCodeOrProject source) projectAndBranch) - [name] -> do - projectAndBranch <- - Text.pack name - & tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - & eitherToMaybe - Just (Input.BranchI Input.BranchSourceI'CurrentContext projectAndBranch) - _ -> Nothing + maybeToEither (showPatternHelp branchInputPattern) + . ( \case + [source0, name] -> do + source <- parseLooseCodeOrProject source0 + projectAndBranch <- + Text.pack name + & tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + & eitherToMaybe + Just (Input.BranchI (Input.BranchSourceI'LooseCodeOrProject source) projectAndBranch) + [name] -> do + projectAndBranch <- + Text.pack name + & tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + & eitherToMaybe + Just (Input.BranchI Input.BranchSourceI'CurrentContext projectAndBranch) + _ -> Nothing + ) + . unifyArguments } where newBranchNameArg = @@ -2867,12 +2916,13 @@ branchEmptyInputPattern = visibility = I.Visible, args = [], help = P.wrap "Create a new empty branch.", - parse = \case - [name] -> - first (\_ -> showPatternHelp branchEmptyInputPattern) do - projectAndBranch <- tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) (Text.pack name) - Right (Input.BranchI Input.BranchSourceI'Empty projectAndBranch) - _ -> Left (showPatternHelp branchEmptyInputPattern) + parse = + unifyArguments `andThen` \case + [name] -> + first (\_ -> showPatternHelp branchEmptyInputPattern) do + projectAndBranch <- tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) (Text.pack name) + Right (Input.BranchI Input.BranchSourceI'Empty projectAndBranch) + _ -> Left (showPatternHelp branchEmptyInputPattern) } branchRenameInputPattern :: InputPattern @@ -2886,9 +2936,10 @@ branchRenameInputPattern = P.wrapColumn2 [ ("`branch.rename foo`", "renames the current branch to `foo`") ], - parse = \case - [nameString] | Right name <- tryInto (Text.pack nameString) -> Right (Input.BranchRenameI name) - _ -> Left (showPatternHelp branchRenameInputPattern) + parse = + unifyArguments `andThen` \case + [nameString] | Right name <- tryInto (Text.pack nameString) -> Right (Input.BranchRenameI name) + _ -> Left (showPatternHelp branchRenameInputPattern) } clone :: InputPattern @@ -2921,15 +2972,18 @@ clone = ) ], parse = - maybe (Left (showPatternHelp clone)) Right . \case - [remoteNamesString] -> do - remoteNames <- eitherToMaybe (tryInto @ProjectAndBranchNames (Text.pack remoteNamesString)) - Just (Input.CloneI remoteNames Nothing) - [remoteNamesString, localNamesString] -> do - remoteNames <- eitherToMaybe (tryInto @ProjectAndBranchNames (Text.pack remoteNamesString)) - localNames <- eitherToMaybe (tryInto @ProjectAndBranchNames (Text.pack localNamesString)) - Just (Input.CloneI remoteNames (Just localNames)) - _ -> Nothing + maybe (Left (showPatternHelp clone)) Right + . ( \case + [remoteNamesString] -> do + remoteNames <- eitherToMaybe (tryInto @ProjectAndBranchNames (Text.pack remoteNamesString)) + Just (Input.CloneI remoteNames Nothing) + [remoteNamesString, localNamesString] -> do + remoteNames <- eitherToMaybe (tryInto @ProjectAndBranchNames (Text.pack remoteNamesString)) + localNames <- eitherToMaybe (tryInto @ProjectAndBranchNames (Text.pack localNamesString)) + Just (Input.CloneI remoteNames (Just localNames)) + _ -> Nothing + ) + . unifyArguments } releaseDraft :: InputPattern @@ -2940,9 +2994,10 @@ releaseDraft = visibility = I.Visible, args = [], help = P.wrap "Draft a release.", - parse = \case - [tryInto @Semver . Text.pack -> Right semver] -> Right (Input.ReleaseDraftI semver) - _ -> Left (showPatternHelp releaseDraft) + parse = + unifyArguments `andThen` \case + [tryInto @Semver . Text.pack -> Right semver] -> Right (Input.ReleaseDraftI semver) + _ -> Left (showPatternHelp releaseDraft) } upgrade :: InputPattern @@ -2956,11 +3011,14 @@ upgrade = P.wrap $ "`upgrade old new` upgrades library dependency `lib.old` to `lib.new`, and, if successful, deletes `lib.old`.", parse = - maybeToEither (I.help upgrade) . \args -> do - [oldString, newString] <- Just args - old <- parseRelativeNameSegment oldString - new <- parseRelativeNameSegment newString - Just (Input.UpgradeI old new) + maybeToEither (I.help upgrade) + . ( \args -> do + [oldString, newString] <- Just args + old <- parseRelativeNameSegment oldString + new <- parseRelativeNameSegment newString + Just (Input.UpgradeI old new) + ) + . unifyArguments } where parseRelativeNameSegment :: String -> Maybe NameSegment diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 0e948b5da0..18a0c8f9c8 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -113,10 +113,11 @@ getUserInput codebase authHTTPClient currentPath numberedArgs = -- Ctrl-c or some input cancel, re-run the prompt go Right (Just (expandedArgs, i)) -> do - let expandedArgsStr = unwords expandedArgs - when (expandedArgs /= ws) $ do + let expandedArgs' = IP.unifyArguments expandedArgs + expandedArgsStr = unwords expandedArgs' + when (expandedArgs' /= ws) $ do liftIO . putStrLn $ fullPrompt <> expandedArgsStr - Line.modifyHistory $ Line.addHistoryUnlessConsecutiveDupe $ unwords expandedArgs + Line.modifyHistory $ Line.addHistoryUnlessConsecutiveDupe $ expandedArgsStr pure i settings :: Line.Settings IO settings = From 0a94308d625a413e61ee190258ecf188479fe057 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 15 May 2024 23:21:24 -0600 Subject: [PATCH 017/631] Have `InputPattern`s handle `NumberedRef` This converts the commands to accept structured numbered arguments, rather than turning them all into strings. --- .../src/Unison/Codebase/Editor/HandleInput.hs | 12 +- .../src/Unison/CommandLine/InputPatterns.hs | 1646 +++++++++++------ unison-cli/src/Unison/CommandLine/Main.hs | 2 +- 3 files changed, 1032 insertions(+), 628 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index bfc6f72f6c..4886caeb48 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -1501,7 +1501,7 @@ handleFindI isVerbose fscope ws input = do (mapMaybe (HQ.parseTextWith anythingBeforeHash . Text.pack) qs) pure $ uniqueBy SR.toReferent srs let respondResults results = do - Cli.setNumberedArgs $ fmap (searchResultToHQText searchRoot &&& SA.SearchResult searchRoot) results + Cli.setNumberedArgs $ fmap (HQ.toText . IP.searchResultToHQ searchRoot &&& SA.SearchResult searchRoot) results results' <- Cli.runTransaction (Backend.loadSearchResults codebase results) Cli.respond $ ListOfDefinitions fscope suffixifiedPPE isVerbose results' results <- getResults names @@ -1821,16 +1821,6 @@ confirmedCommand i = do loopState <- State.get pure $ Just i == (loopState ^. #lastInput) ---- | restores the full hash to these search results, for _numberedArgs purposes -searchResultToHQText :: Maybe Path -> SearchResult -> Text -searchResultToHQText oprefix = \case - SR.Tm' n r _ -> HQ.toText $ HQ.requalify (addPrefix <$> n) r - SR.Tp' n r _ -> HQ.toText $ HQ.requalify (addPrefix <$> n) (Referent.Ref r) - _ -> error "impossible match failure" - where - addPrefix :: Name -> Name - addPrefix = maybe id Path.prefixName2 oprefix - -- return `name` and `name....` _searchBranchPrefix :: Branch m -> Name -> [SearchResult] _searchBranchPrefix b n = case Path.unsnoc (Path.fromName n) of diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index f82e3c8dcd..ebae14662a 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -20,7 +20,7 @@ import System.Console.Haskeline.Completion (Completion (Completion)) import System.Console.Haskeline.Completion qualified as Haskeline import System.Console.Haskeline.Completion qualified as Line import Text.Megaparsec qualified as Megaparsec -import Text.Megaparsec.Internal qualified as Megaparsec (withParsecT) +import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries @@ -35,23 +35,30 @@ import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output.PushPull (PushPull (Pull, Push)) import Unison.Codebase.Editor.Output.PushPull qualified as PushPull import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteGitRepo, WriteRemoteNamespace) +import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Editor.SlurpResult qualified as SR +import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) +import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.Codebase.Editor.UriParser (readRemoteNamespaceParser) import Unison.Codebase.Editor.UriParser qualified as UriParser +import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path import Unison.Codebase.PushBehavior qualified as PushBehavior +import Unison.Codebase.ShortCausalHash (ShortCausalHash) +import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.Codebase.SyncMode qualified as SyncMode import Unison.Codebase.Verbosity (Verbosity) import Unison.Codebase.Verbosity qualified as Verbosity import Unison.CommandLine -import Unison.CommandLine.BranchRelativePath (parseBranchRelativePath, parseIncrementalBranchRelativePath) +import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..), parseBranchRelativePath, parseIncrementalBranchRelativePath) import Unison.CommandLine.BranchRelativePath qualified as BranchRelativePath import Unison.CommandLine.Completion import Unison.CommandLine.FZFResolvers qualified as Resolvers import Unison.CommandLine.InputPattern (ArgumentType (..), InputPattern (InputPattern), IsOptional (..), unionSuggestions) import Unison.CommandLine.InputPattern qualified as I import Unison.HashQualified qualified as HQ +import Unison.HashQualified' qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) @@ -59,13 +66,23 @@ import Unison.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (..), ProjectBranchName, ProjectBranchNameOrLatestRelease (..), ProjectBranchSpecifier (..), ProjectName, Semver) import Unison.Project.Util (ProjectContext (..), projectContextFromPath) +import Unison.Reference qualified as Reference +import Unison.Referent qualified as Referent +import Unison.Server.SearchResult (SearchResult) +import Unison.Server.SearchResult qualified as SR +import Unison.ShortHash (ShortHash) import Unison.Syntax.HashQualified qualified as HQ (parseText) -import Unison.Syntax.Name qualified as Name (parseText, unsafeParseText) -import Unison.Syntax.NameSegment qualified as NameSegment (renderParseErr, segmentP) +import Unison.Syntax.Name qualified as Name (parseTextEither) import Unison.Util.ColorText qualified as CT import Unison.Util.Monoid (intercalateMap) import Unison.Util.Pretty qualified as P +-- | +-- +-- __FIXME__: Don’t hardcode this +schLength :: Int +schLength = 10 + -- | -- -- __TODO__: Temporary. This may stick around in a handful of cases, but it’ll @@ -74,18 +91,6 @@ import Unison.Util.Pretty qualified as P unifyArgument :: I.Argument -> String unifyArgument = either id (Text.unpack . fst) --- | Reversed composition, here temporarily to support the deferred parsing. --- --- __TODO__: Temporary. -andThen :: (a -> b) -> (b -> c) -> a -> c -andThen = flip (.) - --- | --- --- __TODO__: Temporary. -unifyArguments :: [I.Argument] -> [String] -unifyArguments = fmap unifyArgument - showPatternHelp :: InputPattern -> P.Pretty CT.ColorText showPatternHelp i = P.lines @@ -98,6 +103,51 @@ showPatternHelp i = I.help i ] +-- | restores the full hash to these search results, for _numberedArgs purposes +searchResultToHQ :: Maybe Path -> SearchResult -> HQ.HashQualified Name +searchResultToHQ oprefix = \case + SR.Tm' n r _ -> HQ.requalify (addPrefix <$> n) r + SR.Tp' n r _ -> HQ.requalify (addPrefix <$> n) (Referent.Ref r) + _ -> error "impossible match failure" + where + addPrefix :: Name -> Name + addPrefix = maybe id Path.prefixName2 oprefix + +unsupportedStructuredArgument :: + Text -> I.Argument -> Either (P.Pretty CT.ColorText) String +unsupportedStructuredArgument expected = + either + pure + (const . Left . P.text $ "can’t use a numbered argument for " <> expected) + +expectedButActually :: Text -> Text -> Text -> Text +expectedButActually expected actualValue actualType = + "Expected " + <> expected + <> ", but the numbered arg resulted in " + <> actualValue + <> ", which is " + <> actualType + <> "." + +wrongStructuredArgument :: Text -> (Text, StructuredArgument) -> Text +wrongStructuredArgument expected (actualStr, actual) = + expectedButActually + expected + actualStr + case actual of + SA.Ref _ -> "a reference" + SA.Name _ -> "a name" + SA.AbsolutePath _ -> "an absolute path" + SA.Namespace _ -> "a namespace" + SA.Project _ -> "a project" + SA.ProjectBranch _ -> "a branch" + SA.HashQualified _ -> "a hash-qualified name" + SA.NameWithBranchPrefix _ _ -> "a name" + SA.HashQualifiedWithBranchPrefix _ _ -> "a hash-qualified name" + SA.ShallowListEntry _ _ -> "an annotated symbol" + SA.SearchResult _ _ -> "a search result" + patternName :: InputPattern -> P.Pretty P.ColorText patternName = fromString . I.patternName @@ -117,7 +167,411 @@ makeExampleEOS p args = backtick (intercalateMap " " id (P.nonEmpty $ fromString (I.patternName p) : args)) <> "." helpFor :: InputPattern -> P.Pretty CT.ColorText -helpFor p = I.help p +helpFor = I.help + +handleProjectArg :: I.Argument -> Either Text ProjectName +handleProjectArg = + either + ( \name -> + first + (const $ "“" <> Text.pack name <> "” is an invalid project name") + . tryInto @ProjectName + $ Text.pack name + ) + ( \case + (_, SA.Project project) -> pure project + -- __FIXME__: Do we want to treat a project branch as a project? + (_, SA.ProjectBranch (ProjectAndBranch (Just project) _)) -> pure project + otherArgType -> Left $ wrongStructuredArgument "a path" otherArgType + ) + +handleLooseCodeOrProjectArg :: + I.Argument -> Either Text Input.LooseCodeOrProject +handleLooseCodeOrProjectArg = + either + ( maybe (Left "invalid path or project branch") pure + . parseLooseCodeOrProject + ) + ( \case + (_, SA.AbsolutePath path) -> pure . This $ Path.absoluteToPath' path + (_, SA.ProjectBranch pb) -> pure $ That pb + otherArgType -> + Left $ wrongStructuredArgument "a path or project branch" otherArgType + ) + +handleProjectAndBranchArg :: + I.Argument -> + Either Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) +handleProjectAndBranchArg = + either + ( \name -> + first + (const $ "couldn’t find a branch named “" <> Text.pack name <> "”") + . tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + $ Text.pack name + ) + ( \case + (_, SA.ProjectBranch pb) -> pure pb + otherArgType -> Left $ wrongStructuredArgument "a branch" otherArgType + ) + +handleHashQualifiedNameArg :: + I.Argument -> Either (P.Pretty CT.ColorText) (HQ.HashQualified Name) +handleHashQualifiedNameArg = + either + parseHashQualifiedName + ( \case + (_, SA.Name name) -> pure $ HQ.NameOnly name + (_, SA.NameWithBranchPrefix (Left _) name) -> pure $ HQ.NameOnly name + (_, SA.NameWithBranchPrefix (Right prefix) name) -> + pure . HQ.NameOnly . Name.makeAbsolute $ Path.prefixName prefix name + (_, SA.Ref ref) -> pure . HQ.HashOnly $ Reference.toShortHash ref + (_, SA.HashQualified hqname) -> pure hqname + (_, SA.HashQualifiedWithBranchPrefix (Left _) hqname) -> pure $ HQ'.toHQ hqname + (_, SA.HashQualifiedWithBranchPrefix (Right prefix) hqname) -> + pure . HQ'.toHQ $ Name.makeAbsolute . Path.prefixName prefix <$> hqname + (_, SA.SearchResult mpath result) -> pure $ searchResultToHQ mpath result + otherArgType -> + Left . P.text $ wrongStructuredArgument "a hash-qualified name" otherArgType + ) + +handlePathArg :: I.Argument -> Either Text Path.Path +handlePathArg = + either + Path.parsePath + \case + (_, SA.Name name) -> pure $ Path.fromName name + (_, SA.NameWithBranchPrefix (Left _) name) -> pure $ Path.fromName name + (_, SA.NameWithBranchPrefix (Right prefix) name) -> + pure . Path.fromName $ Path.prefixName prefix name + otherArgType -> + Left $ wrongStructuredArgument "a relative path" otherArgType + +handlePath'Arg :: I.Argument -> Either Text Path.Path' +handlePath'Arg = + either + Path.parsePath' + ( \case + (_, SA.AbsolutePath path) -> pure $ Path.absoluteToPath' path + (_, SA.Name name) -> pure $ Path.fromName' name + (_, SA.NameWithBranchPrefix (Left _) name) -> pure $ Path.fromName' name + (_, SA.NameWithBranchPrefix (Right prefix) name) -> + pure . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + otherArgType -> Left $ wrongStructuredArgument "a namespace" otherArgType + ) + +handleNewName :: I.Argument -> Either Text Path.Split' +handleNewName = + either + Path.parseSplit' + (const . Left $ "can’t use a numbered argument for a new name") + +handleNewPath :: I.Argument -> Either Text Path.Path' +handleNewPath = + either + Path.parsePath' + (const . Left $ "can’t use a numbered argument for a new namespace") + +handleSplit'Arg :: I.Argument -> Either Text Path.Split' +handleSplit'Arg = + either + Path.parseSplit' + ( \case + (_, SA.Name name) -> pure $ Path.splitFromName' name + (_, SA.NameWithBranchPrefix (Left _) name) -> pure $ Path.splitFromName' name + (_, SA.NameWithBranchPrefix (Right prefix) name) -> + pure . Path.splitFromName' . Name.makeAbsolute $ Path.prefixName prefix name + otherNumArg -> Left $ wrongStructuredArgument "a split name" otherNumArg + ) + +neSnoc :: [a] -> a -> NE.NonEmpty a +neSnoc xs x = foldr NE.cons (pure x) xs + +handleProjectBranchNameArg :: I.Argument -> Either Text ProjectBranchName +handleProjectBranchNameArg = + either + (first (const "Wanted a branch name, but it wasn’t") . tryInto . Text.pack) + ( \case + (_, SA.ProjectBranch (ProjectAndBranch _ branch)) -> pure branch + otherNumArg -> Left $ wrongStructuredArgument "a branch name" otherNumArg + ) + +handleBranchIdArg :: I.Argument -> Either Text Input.BranchId +handleBranchIdArg = + either + Input.parseBranchId + ( \case + (_, SA.AbsolutePath path) -> pure . pure $ Path.absoluteToPath' path + (_, SA.Name name) -> pure . pure $ Path.fromName' name + (_, SA.NameWithBranchPrefix (Left _) name) -> + pure . pure $ Path.fromName' name + (_, SA.NameWithBranchPrefix (Right prefix) name) -> + pure . pure . Path.fromName' . Name.makeAbsolute $ + Path.prefixName prefix name + (_, SA.Namespace hash) -> pure . Left $ SCH.fromHash schLength hash + otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg + ) + +handleBranchIdOrProjectArg :: + I.Argument -> + Either + Text + ( These + Input.BranchId + (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + ) +handleBranchIdOrProjectArg = + either + ( maybe (Left "Expected a branch or project, but it’s not") pure + . branchIdOrProject + ) + ( \case + (_, SA.Namespace hash) -> + pure . This . Left $ SCH.fromHash schLength hash + (_, SA.AbsolutePath path) -> + pure . This . pure $ Path.absoluteToPath' path + (_, SA.Name name) -> pure . This . pure $ Path.fromName' name + (_, SA.NameWithBranchPrefix (Left _) name) -> + pure . This . pure $ Path.fromName' name + (_, SA.NameWithBranchPrefix (Right prefix) name) -> + pure . This . pure . Path.fromName' . Name.makeAbsolute $ + Path.prefixName prefix name + (_, SA.ProjectBranch pb) -> pure $ pure pb + otherArgType -> Left $ wrongStructuredArgument "a branch" otherArgType + ) + where + branchIdOrProject :: + String -> + Maybe + ( These + Input.BranchId + (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + ) + branchIdOrProject str = + let branchIdRes = Input.parseBranchId str + projectRes = + tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + (Text.pack str) + in case (branchIdRes, projectRes) of + (Left _, Left _) -> Nothing + (Left _, Right pr) -> Just (That pr) + (Right bid, Left _) -> Just (This bid) + (Right bid, Right pr) -> Just (These bid pr) + +handleBranchId2Arg :: + I.Argument -> Either (P.Pretty P.ColorText) (Either ShortCausalHash BranchRelativePath) +handleBranchId2Arg = + either + Input.parseBranchId2 + ( \case + (_, SA.Namespace hash) -> pure . Left $ SCH.fromHash schLength hash + (_, SA.AbsolutePath path) -> + pure . pure . LoosePath $ Path.absoluteToPath' path + (_, SA.Name name) -> pure . pure . LoosePath $ Path.fromName' name + (_, SA.NameWithBranchPrefix (Left _) name) -> + pure . pure . LoosePath $ Path.fromName' name + (_, SA.NameWithBranchPrefix (Right prefix) name) -> + pure . pure . LoosePath . Path.fromName' . Name.makeAbsolute $ + Path.prefixName prefix name + (_, SA.ProjectBranch (ProjectAndBranch mproject branch)) -> + pure . pure . BranchRelative . This $ + maybe (Left branch) (pure . (,branch)) mproject + otherNumArg -> + Left . P.text $ wrongStructuredArgument "a branch id" otherNumArg + ) + +handleBranchRelativePathArg :: + I.Argument -> Either (P.Pretty P.ColorText) BranchRelativePath +handleBranchRelativePathArg = + either + parseBranchRelativePath + ( \case + (_, SA.AbsolutePath path) -> pure . LoosePath $ Path.absoluteToPath' path + (_, SA.Name name) -> pure . LoosePath $ Path.fromName' name + (_, SA.NameWithBranchPrefix (Left _) name) -> + pure . LoosePath $ Path.fromName' name + (_, SA.NameWithBranchPrefix (Right prefix) name) -> + pure . LoosePath . Path.fromName' . Name.makeAbsolute $ + Path.prefixName prefix name + (_, SA.ProjectBranch (ProjectAndBranch mproject branch)) -> + pure . BranchRelative . This $ + maybe (Left branch) (pure . (,branch)) mproject + otherNumArg -> + Left . P.text $ wrongStructuredArgument "a branch id" otherNumArg + ) + +hqNameToSplit' :: HQ.HashQualified Name -> Either Text Path.HQSplit' +hqNameToSplit' = \case + HQ.HashOnly _ -> Left "Only have a hash" + HQ.NameOnly name -> pure . fmap HQ'.NameOnly $ Path.splitFromName' name + HQ.HashQualified name hash -> pure . fmap (`HQ'.HashQualified` hash) $ Path.splitFromName' name + +hqNameToSplit :: HQ.HashQualified Name -> Either Text Path.HQSplit +hqNameToSplit = \case + HQ.HashOnly _ -> Left "Only have a hash" + HQ.NameOnly name -> pure . fmap HQ'.NameOnly $ Path.splitFromName name + HQ.HashQualified name hash -> pure . fmap (`HQ'.HashQualified` hash) $ Path.splitFromName name + +hq'NameToSplit' :: HQ'.HashQualified Name -> Path.HQSplit' +hq'NameToSplit' = \case + HQ'.NameOnly name -> HQ'.NameOnly <$> Path.splitFromName' name + HQ'.HashQualified name hash -> flip HQ'.HashQualified hash <$> Path.splitFromName' name + +hq'NameToSplit :: HQ'.HashQualified Name -> Path.HQSplit +hq'NameToSplit = \case + HQ'.NameOnly name -> HQ'.NameOnly <$> Path.splitFromName name + HQ'.HashQualified name hash -> flip HQ'.HashQualified hash <$> Path.splitFromName name + +handleHashQualifiedSplit'Arg :: I.Argument -> Either Text Path.HQSplit' +handleHashQualifiedSplit'Arg = + either + Path.parseHQSplit' + ( \case + (_, SA.HashQualified name) -> hqNameToSplit' name + (_, SA.HashQualifiedWithBranchPrefix (Left _) hqname) -> pure $ hq'NameToSplit' hqname + (_, SA.HashQualifiedWithBranchPrefix (Right prefix) hqname) -> + pure . hq'NameToSplit' $ Name.makeAbsolute . Path.prefixName prefix <$> hqname + (_, SA.SearchResult mpath result) -> hqNameToSplit' $ searchResultToHQ mpath result + otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg + ) + +handleHashQualifiedSplitArg :: I.Argument -> Either Text Path.HQSplit +handleHashQualifiedSplitArg = + either + Path.parseHQSplit + ( \case + (_, SA.HashQualified name) -> hqNameToSplit name + (_, SA.HashQualifiedWithBranchPrefix (Left _) hqname) -> pure $ hq'NameToSplit hqname + (_, SA.HashQualifiedWithBranchPrefix (Right prefix) hqname) -> + pure . hq'NameToSplit $ Name.makeAbsolute . Path.prefixName prefix <$> hqname + (_, SA.SearchResult mpath result) -> hqNameToSplit $ searchResultToHQ mpath result + otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg + ) + +handleShortCausalHashArg :: I.Argument -> Either Text ShortCausalHash +handleShortCausalHashArg = + either + (first Text.pack . Input.parseShortCausalHash) + ( \case + (_, SA.Namespace hash) -> pure $ SCH.fromHash schLength hash + otherNumArg -> Left $ wrongStructuredArgument "a causal hash" otherNumArg + ) + +handleShortHashOrHQSplit'Arg :: + I.Argument -> Either Text (Either ShortHash Path.HQSplit') +handleShortHashOrHQSplit'Arg = + either + Path.parseShortHashOrHQSplit' + ( \case + (_, SA.Ref ref) -> pure $ Left $ Reference.toShortHash ref + (_, SA.HashQualified name) -> pure <$> hqNameToSplit' name + (_, SA.HashQualifiedWithBranchPrefix (Left _) hqname) -> pure . pure $ hq'NameToSplit' hqname + (_, SA.HashQualifiedWithBranchPrefix (Right prefix) hqname) -> + pure . pure $ hq'NameToSplit' (Name.makeAbsolute . Path.prefixName prefix <$> hqname) + (_, SA.SearchResult mpath result) -> + fmap pure . hqNameToSplit' $ searchResultToHQ mpath result + otherNumArg -> Left $ wrongStructuredArgument "a hash or name" otherNumArg + ) + +handleRelativeNameSegmentArg :: I.Argument -> Either Text NameSegment +handleRelativeNameSegmentArg arg = do + name <- handleNameArg arg + let (segment NE.:| tail) = Name.reverseSegments name + if Name.isRelative name && null tail + then pure segment + else Left "Wanted a single relative name segment, but it wasn’t." + +handleNameArg :: I.Argument -> Either Text Name +handleNameArg = + either + (Name.parseTextEither . Text.pack) + ( \case + (_, SA.Name name) -> pure name + (_, SA.NameWithBranchPrefix (Left _) name) -> pure name + (_, SA.NameWithBranchPrefix (Right prefix) name) -> + pure . Name.makeAbsolute $ Path.prefixName prefix name + (_, SA.HashQualified hqname) -> + maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname + (_, SA.HashQualifiedWithBranchPrefix (Left _) hqname) -> pure $ HQ'.toName hqname + (_, SA.HashQualifiedWithBranchPrefix (Right prefix) hqname) -> + pure . Name.makeAbsolute . Path.prefixName prefix $ HQ'.toName hqname + (_, SA.SearchResult mpath result) -> + maybe (Left "can’t find a name from the numbered arg") pure + . HQ.toName + $ searchResultToHQ mpath result + otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg + ) + +handlePullSourceArg :: + I.Argument -> + Either + Text + (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease)) +handlePullSourceArg = + either + (maybe (Left "not a pull source") pure . parsePullSource . Text.pack) + ( \case + (_, SA.Project project) -> + pure . RemoteRepo.ReadShare'ProjectBranch $ This project + (_, SA.ProjectBranch (ProjectAndBranch project branch)) -> + pure . RemoteRepo.ReadShare'ProjectBranch . maybe That These project $ + ProjectBranchNameOrLatestRelease'Name branch + otherNumArg -> + Left $ wrongStructuredArgument "a source to pull from" otherNumArg + ) + +handlePushTargetArg :: + I.Argument -> + Either Text (WriteRemoteNamespace (These ProjectName ProjectBranchName)) +handlePushTargetArg = + either + ( maybe (Left "Wanted a source to push from, but this ain’t it.") pure + . parsePushTarget + ) + ( fmap RemoteRepo.WriteRemoteProjectBranch + . \case + (_, SA.Project project) -> pure $ This project + (_, SA.ProjectBranch (ProjectAndBranch project branch)) -> + pure $ maybe That These project branch + otherNumArg -> + Left $ wrongStructuredArgument "a source to push from" otherNumArg + ) + +handlePushSourceArg :: I.Argument -> Either Text Input.PushSource +handlePushSourceArg = + either + ( maybe (Left "Wanted a source to push from, but this ain’t it.") pure + . parsePushSource + ) + ( \case + (_, SA.AbsolutePath path) -> pure . Input.PathySource $ Path.absoluteToPath' path + (_, SA.Name name) -> pure . Input.PathySource $ Path.fromName' name + (_, SA.NameWithBranchPrefix (Left _) name) -> + pure . Input.PathySource $ Path.fromName' name + (_, SA.NameWithBranchPrefix (Right prefix) name) -> + pure . Input.PathySource . Path.fromName' . Name.makeAbsolute $ + Path.prefixName prefix name + (_, SA.Project project) -> pure . Input.ProjySource $ This project + (_, SA.ProjectBranch (ProjectAndBranch project branch)) -> + pure . Input.ProjySource . maybe That These project $ branch + otherNumArg -> + Left $ wrongStructuredArgument "a source to push from" otherNumArg + ) + +handleProjectAndBranchNamesArg :: I.Argument -> Either Text ProjectAndBranchNames +handleProjectAndBranchNamesArg = + either + ( first (const "The argument wasn’t a project or branch") + . tryInto @ProjectAndBranchNames + . Text.pack + ) + ( fmap ProjectAndBranchNames'Unambiguous . \case + (_, SA.Project project) -> pure $ This project + (_, SA.ProjectBranch (ProjectAndBranch mproj branch)) -> + pure $ maybe That These mproj branch + otherNumArg -> + Left $ wrongStructuredArgument "a project or branch" otherNumArg + ) mergeBuiltins :: InputPattern mergeBuiltins = @@ -127,11 +581,9 @@ mergeBuiltins = I.Hidden [("namespace", Optional, namespaceArg)] "Adds the builtins (excluding `io` and misc) to the specified namespace. Defaults to `builtin.`" - $ unifyArguments `andThen` \case + $ \case [] -> pure . Input.MergeBuiltinsI $ Nothing - [p] -> first P.text do - p <- Path.parsePath p - pure . Input.MergeBuiltinsI $ Just p + [p] -> bimap P.text (Input.MergeBuiltinsI . Just) $ handlePathArg p _ -> Left (I.help mergeBuiltins) mergeIOBuiltins :: InputPattern @@ -142,11 +594,9 @@ mergeIOBuiltins = I.Hidden [("namespace", Optional, namespaceArg)] "Adds all the builtins, including `io` and misc., to the specified namespace. Defaults to `builtin.`" - $ unifyArguments `andThen` \case + \case [] -> pure . Input.MergeIOBuiltinsI $ Nothing - [p] -> first P.text do - p <- Path.parsePath p - pure . Input.MergeIOBuiltinsI $ Just p + [p] -> bimap P.text (Input.MergeIOBuiltinsI . Just) $ handlePathArg p _ -> Left (I.help mergeBuiltins) updateBuiltins :: InputPattern @@ -182,12 +632,12 @@ todo = ) ] ) - ( unifyArguments `andThen` \case - patchStr : ws -> mapLeft (warn . P.text) $ do - patch <- Path.parseSplit' patchStr + ( \case + patchStr : ws -> first (warn . P.text) $ do + patch <- handleSplit'Arg patchStr branch <- case ws of [] -> pure Path.relativeEmpty' - [pathStr] -> Path.parsePath' pathStr + [pathStr] -> handlePath'Arg pathStr _ -> Left "`todo` just takes a patch and one optional namespace" Right $ Input.TodoI (Just patch) branch [] -> Right $ Input.TodoI Nothing Path.relativeEmpty' @@ -209,9 +659,11 @@ load = ) ] ) - ( unifyArguments `andThen` \case + ( \case [] -> pure $ Input.LoadI Nothing - [file] -> pure $ Input.LoadI . Just $ file + [file] -> + Input.LoadI . Just + <$> unsupportedStructuredArgument "a file name" file _ -> Left (I.help load) ) @@ -229,7 +681,7 @@ clear = ] ) ( \case - [] -> pure $ Input.ClearI + [] -> pure Input.ClearI _ -> Left (I.help clear) ) @@ -243,7 +695,7 @@ add = ( "`add` adds to the codebase all the definitions from the most recently " <> "typechecked file." ) - $ pure . Input.AddI . Set.fromList . map (Name.unsafeParseText . Text.pack) . unifyArguments + $ bimap P.text (Input.AddI . Set.fromList) . traverse handleNameArg previewAdd :: InputPattern previewAdd = @@ -257,7 +709,7 @@ previewAdd = <> "results. Use `load` to reparse & typecheck the file if the context " <> "has changed." ) - $ pure . Input.PreviewAddI . Set.fromList . map (Name.unsafeParseText . Text.pack) . unifyArguments + $ bimap P.text (Input.PreviewAddI . Set.fromList) . traverse handleNameArg update :: InputPattern update = @@ -272,10 +724,9 @@ update = <> "replacing existing definitions having the same name, and attempts to update all the existing dependents accordingly. If the process" <> "can't be completed automatically, the dependents will be added back to the scratch file" <> "for your review.", - parse = - maybeToEither (I.help update) . \case - [] -> Just Input.Update2I - _ -> Nothing + parse = \case + [] -> pure Input.Update2I + _ -> Left $ I.help update } updateOldNoPatch :: InputPattern @@ -304,12 +755,8 @@ updateOldNoPatch = ) ] ) - ( pure - . Input.UpdateI Input.NoPatch - . Set.fromList - . map (Name.unsafeParseText . Text.pack) - . unifyArguments - ) + $ bimap P.text (Input.UpdateI Input.NoPatch . Set.fromList) + . traverse handleNameArg updateOld :: InputPattern updateOld = @@ -343,13 +790,11 @@ updateOld = ) ] ) - $ unifyArguments `andThen` \case - patchStr : ws -> do - patch <- first P.text $ Path.parseSplit' patchStr - pure $ - Input.UpdateI - (Input.UsePatch patch) - (Set.fromList $ map (Name.unsafeParseText . Text.pack) ws) + \case + patchStr : ws -> first P.text do + patch <- handleSplit'Arg patchStr + Input.UpdateI (Input.UsePatch patch) . Set.fromList + <$> traverse handleNameArg ws [] -> Right $ Input.UpdateI Input.DefaultPatch mempty previewUpdate :: InputPattern @@ -364,7 +809,8 @@ previewUpdate = <> "typechecking results. Use `load` to reparse & typecheck the file if " <> "the context has changed." ) - $ pure . Input.PreviewUpdateI . Set.fromList . map (Name.unsafeParseText . Text.pack) . unifyArguments + $ bimap P.text (Input.PreviewUpdateI . Set.fromList) + . traverse handleNameArg patch :: InputPattern patch = @@ -392,13 +838,16 @@ patch = ] ] ) - $ unifyArguments `andThen` \case - patchStr : ws -> first P.text do - patch <- Path.parseSplit' patchStr - branch <- case ws of - [pathStr] -> Path.parsePath' pathStr - _ -> pure Path.relativeEmpty' - pure $ Input.PropagatePatchI patch branch + $ \case + patchStr : ws -> + Input.PropagatePatchI + <$> first P.text (handleSplit'Arg patchStr) + <*> case ws of + [] -> pure Path.relativeEmpty' + [pathStr] -> first P.text $ handlePath'Arg pathStr + -- __FIXME__: This is a breaking change (previously, too many 3+ would + -- work the same as only one arg) + _ -> Left $ I.help patch [] -> Left $ warn $ @@ -423,12 +872,12 @@ view = <> "not `List.map.doc` (since ? only matches 1 name segment)." ] ) - ( unifyArguments `andThen` \case - (x : xs) -> - (x NE.:| xs) - & traverse parseHashQualifiedName - & fmap (Input.ShowDefinitionI Input.ConsoleLocation Input.ShowDefinitionLocal) - _ -> Left (I.help view) + ( maybe + (Left $ I.help view) + ( fmap (Input.ShowDefinitionI Input.ConsoleLocation Input.ShowDefinitionLocal) + . traverse handleHashQualifiedNameArg + ) + . NE.nonEmpty ) viewGlobal :: InputPattern @@ -443,12 +892,12 @@ viewGlobal = "`view.global` without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH." ] ) - ( unifyArguments `andThen` \case - (x : xs) -> - (x NE.:| xs) - & traverse parseHashQualifiedName - & fmap (Input.ShowDefinitionI Input.ConsoleLocation Input.ShowDefinitionGlobal) - _ -> Left (I.help viewGlobal) + ( maybe + (Left $ I.help viewGlobal) + ( fmap (Input.ShowDefinitionI Input.ConsoleLocation Input.ShowDefinitionGlobal) + . traverse handleHashQualifiedNameArg + ) + . NE.nonEmpty ) display :: InputPattern @@ -463,12 +912,12 @@ display = "`display` without arguments invokes a search to select a definition to display, which requires that `fzf` can be found within your PATH." ] ) - $ unifyArguments `andThen` \case - (x : xs) -> - (x NE.:| xs) - & traverse parseHashQualifiedName - <&> Input.DisplayI Input.ConsoleLocation - _ -> Left (I.help display) + $ maybe + (Left $ I.help display) + ( fmap (Input.DisplayI Input.ConsoleLocation) + . traverse handleHashQualifiedNameArg + ) + . NE.nonEmpty displayTo :: InputPattern displayTo = @@ -481,11 +930,16 @@ displayTo = makeExample displayTo ["", "foo"] <> "prints a rendered version of the term `foo` to the given file." ) - $ unifyArguments `andThen` \case - file : (x : xs) -> - (x NE.:| xs) - & traverse parseHashQualifiedName - <&> Input.DisplayI (Input.FileLocation file) + $ \case + file : defs -> + maybe + (Left $ I.help displayTo) + ( \defs -> + Input.DisplayI . Input.FileLocation + <$> unsupportedStructuredArgument "a file name" file + <*> traverse handleHashQualifiedNameArg defs + ) + $ NE.nonEmpty defs _ -> Left (I.help displayTo) docs :: InputPattern @@ -500,13 +954,10 @@ docs = "`docs` without arguments invokes a search to select which definition to view documentation for, which requires that `fzf` can be found within your PATH." ] ) - ( unifyArguments `andThen` \case - x : xs -> - (x NE.:| xs) - & traverse Path.parseHQSplit' - & bimap P.text Input.DocsI - _ -> Left (I.help docs) - ) + $ maybe + (Left $ I.help docs) + (bimap P.text Input.DocsI . traverse handleHashQualifiedSplit'Arg) + . NE.nonEmpty api :: InputPattern api = @@ -526,13 +977,10 @@ ui = visibility = I.Visible, args = [("definition to load", Optional, namespaceOrDefinitionArg)], help = P.wrap "`ui` opens the Local UI in the default browser.", - parse = - unifyArguments `andThen` \case - [] -> pure $ Input.UiI Path.relativeEmpty' - [path] -> first P.text $ do - p <- Path.parsePath' path - pure $ Input.UiI p - _ -> Left (I.help ui) + parse = \case + [] -> pure $ Input.UiI Path.relativeEmpty' + [path] -> bimap P.text Input.UiI $ handlePath'Arg path + _ -> Left (I.help ui) } undo :: InputPattern @@ -554,15 +1002,16 @@ viewByPrefix = [("definition to view", OnePlus, definitionQueryArg)] "`view.recursive Foo` prints the definitions of `Foo` and `Foo.blah`." ( fmap (Input.ShowDefinitionByPrefixI Input.ConsoleLocation) - . traverse parseHashQualifiedName - . unifyArguments + . traverse handleHashQualifiedNameArg ) sfind :: InputPattern sfind = - InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg $ parse . unifyArguments + InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse where - parse [q] = Input.StructuredFindI (Input.FindLocal Path.empty) <$> parseHashQualifiedName q + parse [q] = + Input.StructuredFindI (Input.FindLocal Path.empty) + <$> handleHashQualifiedNameArg q parse _ = Left "expected exactly one argument" msg = P.lines @@ -591,9 +1040,9 @@ sfind = sfindReplace :: InputPattern sfindReplace = - InputPattern "rewrite" ["sfind.replace"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg $ parse . unifyArguments + InputPattern "rewrite" ["sfind.replace"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse where - parse [q] = Input.StructuredFindReplaceI <$> parseHashQualifiedName q + parse [q] = Input.StructuredFindReplaceI <$> handleHashQualifiedNameArg q parse _ = Left "expected exactly one argument" msg :: P.Pretty CT.ColorText msg = @@ -640,10 +1089,17 @@ findIn' cmd mkfscope = I.Visible [("namespace", Required, namespaceArg), ("query", ZeroPlus, exactDefinitionArg)] findHelp - $ unifyArguments `andThen` \case - p : args -> first P.text do - p <- Path.parsePath p - pure (Input.FindI False (mkfscope p) args) + $ \case + p : args -> + Input.FindI False . mkfscope + <$> first P.text (handlePathArg p) + -- __FIXME__: This changes things a bit. Previously, `find` and + -- friends would just expand the numbered args and search + -- for them like any other string, but now it recognizes + -- that you’re trying to look up something you already + -- have, and refuses to. Is that the right thing to do? We + -- _could_ still serialize in this case. + <*> traverse (unsupportedStructuredArgument "text") args _ -> Left findHelp findHelp :: P.Pretty CT.ColorText @@ -690,7 +1146,7 @@ find' cmd fscope = I.Visible [("query", ZeroPlus, exactDefinitionArg)] findHelp - (pure . Input.FindI False fscope . unifyArguments) + (fmap (Input.FindI False fscope) . traverse (unsupportedStructuredArgument "text")) findShallow :: InputPattern findShallow = @@ -705,11 +1161,9 @@ findShallow = ("`list .foo`", "lists the '.foo' namespace.") ] ) - ( unifyArguments `andThen` \case - [] -> pure $ Input.FindShallowI Path.relativeEmpty' - [path] -> first P.text $ do - p <- Path.parsePath' path - pure $ Input.FindShallowI p + ( fmap Input.FindShallowI . \case + [] -> pure Path.relativeEmpty' + [path] -> first P.text $ handlePath'Arg path _ -> Left (I.help findShallow) ) @@ -723,7 +1177,9 @@ findVerbose = ( "`find.verbose` searches for definitions like `find`, but includes hashes " <> "and aliases in the results." ) - (pure . Input.FindI True (Input.FindLocal Path.empty) . unifyArguments) + ( fmap (Input.FindI True $ Input.FindLocal Path.empty) + . traverse (unsupportedStructuredArgument "text") + ) findVerboseAll :: InputPattern findVerboseAll = @@ -735,7 +1191,9 @@ findVerboseAll = ( "`find.all.verbose` searches for definitions like `find.all`, but includes hashes " <> "and aliases in the results." ) - (pure . Input.FindI True (Input.FindLocalAndDeps Path.empty) . unifyArguments) + ( fmap (Input.FindI True $ Input.FindLocalAndDeps Path.empty) + . traverse (unsupportedStructuredArgument "text") + ) findPatch :: InputPattern findPatch = @@ -759,11 +1217,12 @@ renameTerm = ("new location", Required, newNameArg) ] "`move.term foo bar` renames `foo` to `bar`." - ( unifyArguments `andThen` \case - [oldName, newName] -> first P.text do - src <- Path.parseHQSplit' oldName - target <- Path.parseSplit' newName - pure $ Input.MoveTermI src target + ( \case + [oldName, newName] -> + first P.text $ + Input.MoveTermI + <$> handleHashQualifiedSplit'Arg oldName + <*> handleNewName newName _ -> Left . P.warnCallout $ P.wrap @@ -780,11 +1239,12 @@ moveAll = ("new location", Required, newNameArg) ] "`move foo bar` renames the term, type, and namespace foo to bar." - ( unifyArguments `andThen` \case - [oldName, newName] -> first P.text $ do - src <- Path.parsePath' oldName - target <- Path.parsePath' newName - pure $ Input.MoveAllI src target + ( \case + [oldName, newName] -> + first P.text $ + Input.MoveAllI + <$> handlePath'Arg oldName + <*> handleNewPath newName _ -> Left . P.warnCallout $ P.wrap @@ -801,11 +1261,12 @@ renameType = ("new location", Required, newNameArg) ] "`move.type foo bar` renames `foo` to `bar`." - ( unifyArguments `andThen` \case - [oldName, newName] -> first P.text do - src <- Path.parseHQSplit' oldName - target <- Path.parseSplit' newName - pure $ Input.MoveTypeI src target + ( \case + [oldName, newName] -> + first P.text $ + Input.MoveTypeI + <$> handleHashQualifiedSplit'Arg oldName + <*> handleNewName newName _ -> Left . P.warnCallout $ P.wrap @@ -849,11 +1310,11 @@ deleteGen suffix queryCompletionArg target mkTarget = I.Visible [("definition to delete", OnePlus, queryCompletionArg)] info - ( unifyArguments `andThen` \case + ( \case [] -> Left . P.warnCallout $ P.wrap warn - queries -> first P.text do - paths <- traverse Path.parseHQSplit' queries - pure $ Input.DeleteI (mkTarget paths) + queries -> + bimap P.text (Input.DeleteI . mkTarget) $ + traverse handleHashQualifiedSplit'Arg queries ) delete :: InputPattern @@ -897,11 +1358,11 @@ deleteReplacement isTerm = <> str <> " - not the one in place after the edit." ) - ( unifyArguments `andThen` \case - query : patch -> do - patch <- first P.text . traverse Path.parseSplit' $ listToMaybe patch - q <- parseHashQualifiedName query - pure $ input q patch + ( \case + query : patch -> + input + <$> handleHashQualifiedNameArg query + <*> first P.text (traverse handleSplit'Arg $ listToMaybe patch) _ -> Left . P.warnCallout @@ -933,12 +1394,11 @@ deleteProject = P.wrapColumn2 [ ("`delete.project foo`", "deletes the local project `foo`") ], - parse = - unifyArguments `andThen` \case - [name] - | Right project <- tryInto @ProjectName (Text.pack name) -> - Right (Input.DeleteI (DeleteTarget'Project project)) - _ -> Left (showPatternHelp deleteProject) + parse = \case + [name] -> + bimap P.text (Input.DeleteI . DeleteTarget'Project) $ + handleProjectArg name + _ -> Left (showPatternHelp deleteProject) } deleteBranch :: InputPattern @@ -953,13 +1413,11 @@ deleteBranch = [ ("`delete.branch foo/bar`", "deletes the branch `bar` in the project `foo`"), ("`delete.branch /bar`", "deletes the branch `bar` in the current project") ], - parse = - unifyArguments `andThen` \case - [name] -> - case tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) (Text.pack name) of - Left _ -> Left (showPatternHelp deleteBranch) - Right projectAndBranch -> Right (Input.DeleteI (DeleteTarget'ProjectBranch projectAndBranch)) - _ -> Left (showPatternHelp deleteBranch) + parse = \case + [name] -> + bimap P.text (Input.DeleteI . DeleteTarget'ProjectBranch) $ + handleProjectAndBranchArg name + _ -> Left (showPatternHelp deleteBranch) } where suggestionsConfig = @@ -983,11 +1441,12 @@ aliasTerm = I.Visible [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)] "`alias.term foo bar` introduces `bar` with the same definition as `foo`." - $ unifyArguments `andThen` \case - [oldName, newName] -> first P.text do - source <- Path.parseShortHashOrHQSplit' oldName - target <- Path.parseSplit' newName - pure $ Input.AliasTermI source target + $ \case + [oldName, newName] -> + first P.text $ + Input.AliasTermI + <$> handleShortHashOrHQSplit'Arg oldName + <*> handleSplit'Arg newName _ -> Left . warn $ P.wrap @@ -1001,11 +1460,12 @@ aliasType = I.Visible [("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)] "`alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`." - $ unifyArguments `andThen` \case - [oldName, newName] -> first P.text do - source <- Path.parseShortHashOrHQSplit' oldName - target <- Path.parseSplit' newName - pure $ Input.AliasTypeI source target + $ \case + [oldName, newName] -> + first P.text $ + Input.AliasTypeI + <$> handleShortHashOrHQSplit'Arg oldName + <*> handleSplit'Arg newName _ -> Left . warn $ P.wrap @@ -1027,11 +1487,12 @@ aliasMany = <> "creates aliases `.quux.foo.foo` and `.quux.bar.bar`." ] ) - $ unifyArguments `andThen` \case - srcs@(_ : _) Cons.:> dest -> first P.text do - sourceDefinitions <- traverse Path.parseHQSplit srcs - destNamespace <- Path.parsePath' dest - pure $ Input.AliasManyI sourceDefinitions destNamespace + $ \case + srcs@(_ : _) Cons.:> dest -> + first P.text $ + Input.AliasManyI + <$> traverse handleHashQualifiedSplitArg srcs + <*> handlePath'Arg dest _ -> Left (I.help aliasMany) up :: InputPattern @@ -1073,11 +1534,9 @@ cd = ] ] ) - $ unifyArguments `andThen` \case - [".."] -> Right Input.UpI - [p] -> first P.text do - p <- Path.parsePath' p - pure . Input.SwitchBranchI $ p + $ \case + [Left ".."] -> Right Input.UpI + [p] -> bimap P.text Input.SwitchBranchI $ handlePath'Arg p _ -> Left (I.help cd) back :: InputPattern @@ -1105,7 +1564,7 @@ deleteNamespace = I.Visible [("namespace to delete", Required, namespaceArg)] "`delete.namespace ` deletes the namespace `foo`" - (deleteNamespaceParser (I.help deleteNamespace) Input.Try . unifyArguments) + (deleteNamespaceParser (I.help deleteNamespace) Input.Try) deleteNamespaceForce :: InputPattern deleteNamespaceForce = @@ -1117,17 +1576,17 @@ deleteNamespaceForce = ( "`delete.namespace.force ` deletes the namespace `foo`," <> "deletion will proceed even if other code depends on definitions in foo." ) - (deleteNamespaceParser (I.help deleteNamespaceForce) Input.Force . unifyArguments) + (deleteNamespaceParser (I.help deleteNamespaceForce) Input.Force) -deleteNamespaceParser :: P.Pretty CT.ColorText -> Input.Insistence -> [String] -> Either (P.Pretty CT.ColorText) Input +deleteNamespaceParser :: P.Pretty CT.ColorText -> Input.Insistence -> I.Arguments -> Either (P.Pretty CT.ColorText) Input deleteNamespaceParser helpText insistence = \case - ["."] -> + [Left "."] -> first fromString . pure $ Input.DeleteI (DeleteTarget'Namespace insistence Nothing) - [p] -> first P.text do - p <- Path.parseSplit' p - pure $ Input.DeleteI (DeleteTarget'Namespace insistence (Just p)) + [p] -> + bimap P.text (Input.DeleteI . DeleteTarget'Namespace insistence . pure) $ + handleSplit'Arg p _ -> Left helpText deletePatch :: InputPattern @@ -1138,23 +1597,20 @@ deletePatch = I.Visible [("patch to delete", Required, patchArg)] "`delete.patch ` deletes the patch `foo`" - $ unifyArguments `andThen` \case - [p] -> first P.text do - p <- Path.parseSplit' p - pure . Input.DeleteI $ DeleteTarget'Patch p + $ \case + [p] -> + bimap P.text (Input.DeleteI . DeleteTarget'Patch) $ handleSplit'Arg p _ -> Left (I.help deletePatch) -movePatch :: String -> String -> Either (P.Pretty CT.ColorText) Input -movePatch src dest = first P.text do - src <- Path.parseSplit' src - dest <- Path.parseSplit' dest - pure $ Input.MovePatchI src dest +movePatch :: I.Argument -> I.Argument -> Either (P.Pretty CT.ColorText) Input +movePatch src dest = + first P.text $ + Input.MovePatchI <$> handleSplit'Arg src <*> handleSplit'Arg dest -copyPatch' :: String -> String -> Either (P.Pretty CT.ColorText) Input -copyPatch' src dest = first P.text do - src <- Path.parseSplit' src - dest <- Path.parseSplit' dest - pure $ Input.CopyPatchI src dest +copyPatch' :: I.Argument -> I.Argument -> Either (P.Pretty CT.ColorText) Input +copyPatch' src dest = + first P.text $ + Input.CopyPatchI <$> handleSplit'Arg src <*> handleSplit'Arg dest copyPatch :: InputPattern copyPatch = @@ -1164,7 +1620,7 @@ copyPatch = I.Visible [("patch to copy", Required, patchArg), ("copy destination", Required, newNameArg)] "`copy.patch foo bar` copies the patch `foo` to `bar`." - $ unifyArguments `andThen` \case + $ \case [src, dest] -> copyPatch' src dest _ -> Left (I.help copyPatch) @@ -1176,7 +1632,7 @@ renamePatch = I.Visible [("patch", Required, patchArg), ("new location", Required, newNameArg)] "`move.patch foo bar` renames the patch `foo` to `bar`." - $ unifyArguments `andThen` \case + $ \case [src, dest] -> movePatch src dest _ -> Left (I.help renamePatch) @@ -1188,11 +1644,10 @@ renameBranch = I.Visible [("namespace to move", Required, namespaceArg), ("new location", Required, newNameArg)] "`move.namespace foo bar` renames the path `foo` to `bar`." - $ unifyArguments `andThen` \case - [src, dest] -> first P.text do - src <- Path.parsePath' src - dest <- Path.parsePath' dest - pure $ Input.MoveBranchI src dest + $ \case + [src, dest] -> + first P.text $ + Input.MoveBranchI <$> handlePath'Arg src <*> handlePath'Arg dest _ -> Left (I.help renameBranch) history :: InputPattern @@ -1211,10 +1666,10 @@ history = ) ] ) - $ unifyArguments `andThen` \case - [src] -> first P.text do - p <- Input.parseBranchId src - pure $ Input.HistoryI (Just 10) (Just 10) p + $ \case + [src] -> + bimap P.text (Input.HistoryI (Just 10) (Just 10)) $ + handleBranchIdArg src [] -> pure $ Input.HistoryI (Just 10) (Just 10) (Right Path.currentPath) _ -> Left (I.help history) @@ -1239,11 +1694,11 @@ forkLocal = ) ] ) - $ unifyArguments `andThen` \case - [src, dest] -> do - src <- Input.parseBranchId2 src - dest <- parseBranchRelativePath dest - pure $ Input.ForkLocalBranchI src dest + $ \case + [src, dest] -> + Input.ForkLocalBranchI + <$> handleBranchId2Arg src + <*> handleBranchRelativePathArg dest _ -> Left (I.help forkLocal) reset :: InputPattern @@ -1262,35 +1717,18 @@ reset = ("`reset #pvfd222s8n /topic`", "reset the branch `topic` of the current project to the causal `#pvfd222s8n`.") ] ) - ( maybeToEither (I.help reset) - . ( \case - arg0 : restArgs -> do - arg0 <- branchIdOrProject arg0 - arg1 <- case restArgs of - [] -> pure Nothing - arg1 : [] -> Just <$> parseLooseCodeOrProject arg1 - _ -> Nothing - Just (Input.ResetI arg0 arg1) - _ -> Nothing - ) - . unifyArguments + ( \case + [arg0] -> + Input.ResetI + <$> first P.text (handleBranchIdOrProjectArg arg0) + <*> pure Nothing + [arg0, arg1] -> + Input.ResetI + <$> first P.text (handleBranchIdOrProjectArg arg0) + <*> bimap P.text pure (handleLooseCodeOrProjectArg arg1) + _ -> Left $ I.help reset ) where - branchIdOrProject :: - String -> - Maybe - ( These - Input.BranchId - (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - ) - branchIdOrProject str = - let branchIdRes = Input.parseBranchId str - projectRes = tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) (Text.pack str) - in case (branchIdRes, projectRes) of - (Left _, Left _) -> Nothing - (Left _, Right pr) -> Just (That pr) - (Right bid, Left _) -> Just (This bid) - (Right bid, Right pr) -> Just (These bid pr) config = ProjectBranchSuggestionsConfig { showProjectCompletions = False, @@ -1319,10 +1757,8 @@ resetRoot = ] ] ) - $ unifyArguments `andThen` \case - [src] -> first P.text $ do - src <- Input.parseBranchId src - pure $ Input.ResetRootI src + $ \case + [src] -> bimap P.text Input.ResetRootI $ handleBranchIdArg src _ -> Left (I.help resetRoot) pull :: InputPattern @@ -1387,24 +1823,27 @@ pullImpl name aliases verbosity pullMode addendum = do explainRemote Pull ], parse = - maybeToEither (I.help self) + fmap + ( \sourceTarget -> + Input.PullRemoteBranchI + sourceTarget + SyncMode.ShortCircuit + pullMode + verbosity + ) . ( \case - [] -> Just $ Input.PullRemoteBranchI Input.PullSourceTarget0 SyncMode.ShortCircuit pullMode verbosity - [sourceString] -> do - source <- parsePullSource (Text.pack sourceString) - Just $ Input.PullRemoteBranchI (Input.PullSourceTarget1 source) SyncMode.ShortCircuit pullMode verbosity - [sourceString, targetString] -> do - source <- parsePullSource (Text.pack sourceString) - target <- parseLooseCodeOrProject targetString - Just $ - Input.PullRemoteBranchI - (Input.PullSourceTarget2 source target) - SyncMode.ShortCircuit - pullMode - verbosity - _ -> Nothing + [] -> pure $ Input.PullSourceTarget0 + [sourceString] -> + first P.text $ + Input.PullSourceTarget1 + <$> handlePullSourceArg sourceString + [sourceString, targetString] -> + first P.text $ + Input.PullSourceTarget2 + <$> handlePullSourceArg sourceString + <*> handleLooseCodeOrProjectArg targetString + _ -> Left $ I.help self ) - . unifyArguments } pullExhaustive :: InputPattern @@ -1425,35 +1864,27 @@ pullExhaustive = <> "versions M1l and earlier. It may be extra slow!" ] ) - ( maybeToEither (I.help pullExhaustive) + ( fmap + ( \sourceTarget -> + Input.PullRemoteBranchI + sourceTarget + SyncMode.Complete + Input.PullWithHistory + Verbosity.Verbose + ) . ( \case - [] -> - Just $ - Input.PullRemoteBranchI - Input.PullSourceTarget0 - SyncMode.Complete - Input.PullWithHistory - Verbosity.Verbose - [sourceString] -> do - source <- parsePullSource (Text.pack sourceString) - Just $ - Input.PullRemoteBranchI - (Input.PullSourceTarget1 source) - SyncMode.Complete - Input.PullWithHistory - Verbosity.Verbose - [sourceString, targetString] -> do - source <- parsePullSource (Text.pack sourceString) - target <- parseLooseCodeOrProject targetString - Just $ - Input.PullRemoteBranchI - (Input.PullSourceTarget2 source target) - SyncMode.Complete - Input.PullWithHistory - Verbosity.Verbose - _ -> Nothing + [] -> pure $ Input.PullSourceTarget0 + [sourceString] -> + first P.text $ + Input.PullSourceTarget1 + <$> handlePullSourceArg sourceString + [sourceString, targetString] -> + first P.text $ + Input.PullSourceTarget2 + <$> handlePullSourceArg sourceString + <*> handleLooseCodeOrProjectArg targetString + _ -> Left $ I.help pullExhaustive ) - . unifyArguments ) debugTabCompletion :: InputPattern @@ -1468,7 +1899,7 @@ debugTabCompletion = P.wrap $ "Completions which are finished are prefixed with a * represent finished completions." ] ) - (Right . Input.DebugTabCompletionI . unifyArguments) + (fmap Input.DebugTabCompletionI . traverse (unsupportedStructuredArgument "text")) debugFuzzyOptions :: InputPattern debugFuzzyOptions = @@ -1485,9 +1916,11 @@ debugFuzzyOptions = P.wrap $ "or `debug.fuzzy-options merge - _`" ] ) - $ unifyArguments `andThen` \case + $ \case (cmd : args) -> - Right $ Input.DebugFuzzyOptionsI cmd args + Input.DebugFuzzyOptionsI + <$> unsupportedStructuredArgument "a command" cmd + <*> traverse (unsupportedStructuredArgument "text") args _ -> Left (I.help debugFuzzyOptions) debugFormat :: InputPattern @@ -1538,25 +1971,25 @@ push = explainRemote Push ] ) - $ unifyArguments `andThen` \args -> do - sourceTarget <- - case args of - [] -> Right Input.PushSourceTarget0 - [targetStr] -> do - target <- parsePushTarget targetStr - Right (Input.PushSourceTarget1 target) - [targetStr, sourceStr] -> do - target <- parsePushTarget targetStr - source <- parsePushSource sourceStr - Right (Input.PushSourceTarget2 source target) - _ -> Left (I.help push) - Right $ - Input.PushRemoteBranchI - Input.PushRemoteBranchInput - { sourceTarget, - pushBehavior = PushBehavior.RequireNonEmpty, - syncMode = SyncMode.ShortCircuit - } + $ fmap + ( \sourceTarget -> + Input.PushRemoteBranchI + Input.PushRemoteBranchInput + { sourceTarget, + pushBehavior = PushBehavior.RequireNonEmpty, + syncMode = SyncMode.ShortCircuit + } + ) + . \case + [] -> pure Input.PushSourceTarget0 + [targetStr] -> + bimap P.text Input.PushSourceTarget1 $ handlePushTargetArg targetStr + [targetStr, sourceStr] -> + first P.text $ + Input.PushSourceTarget2 + <$> handlePushSourceArg sourceStr + <*> handlePushTargetArg targetStr + _ -> Left (I.help push) where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -1594,25 +2027,25 @@ pushCreate = explainRemote Push ] ) - $ unifyArguments `andThen` \args -> do - sourceTarget <- - case args of - [] -> Right Input.PushSourceTarget0 - [targetStr] -> do - target <- parsePushTarget targetStr - Right (Input.PushSourceTarget1 target) - [targetStr, sourceStr] -> do - target <- parsePushTarget targetStr - source <- parsePushSource sourceStr - Right (Input.PushSourceTarget2 source target) - _ -> Left (I.help pushForce) - Right $ - Input.PushRemoteBranchI - Input.PushRemoteBranchInput - { sourceTarget, - pushBehavior = PushBehavior.RequireEmpty, - syncMode = SyncMode.ShortCircuit - } + $ fmap + ( \sourceTarget -> + Input.PushRemoteBranchI + Input.PushRemoteBranchInput + { sourceTarget, + pushBehavior = PushBehavior.RequireEmpty, + syncMode = SyncMode.ShortCircuit + } + ) + . \case + [] -> pure Input.PushSourceTarget0 + [targetStr] -> + bimap P.text Input.PushSourceTarget1 $ handlePushTargetArg targetStr + [targetStr, sourceStr] -> + first P.text $ + Input.PushSourceTarget2 + <$> handlePushSourceArg sourceStr + <*> handlePushTargetArg targetStr + _ -> Left (I.help pushForce) where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -1629,25 +2062,25 @@ pushForce = I.Hidden [("remote destination", Optional, remoteNamespaceArg), ("local source", Optional, namespaceOrProjectBranchArg suggestionsConfig)] (P.wrap "Like `push`, but overwrites any remote namespace.") - $ unifyArguments `andThen` \args -> do - sourceTarget <- - case args of - [] -> Right Input.PushSourceTarget0 - [targetStr] -> do - target <- parsePushTarget targetStr - Right (Input.PushSourceTarget1 target) - [targetStr, sourceStr] -> do - target <- parsePushTarget targetStr - source <- parsePushSource sourceStr - Right (Input.PushSourceTarget2 source target) - _ -> Left (I.help pushForce) - Right $ - Input.PushRemoteBranchI - Input.PushRemoteBranchInput - { sourceTarget, - pushBehavior = PushBehavior.ForcePush, - syncMode = SyncMode.ShortCircuit - } + $ fmap + ( \sourceTarget -> + Input.PushRemoteBranchI + Input.PushRemoteBranchInput + { sourceTarget, + pushBehavior = PushBehavior.ForcePush, + syncMode = SyncMode.ShortCircuit + } + ) + . \case + [] -> pure Input.PushSourceTarget0 + [targetStr] -> + bimap P.text Input.PushSourceTarget1 $ handlePushTargetArg targetStr + [targetStr, sourceStr] -> + first P.text $ + Input.PushSourceTarget2 + <$> handlePushSourceArg sourceStr + <*> handlePushTargetArg targetStr + _ -> Left (I.help pushForce) where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -1674,25 +2107,25 @@ pushExhaustive = <> "versions M1l and earlier. It may be extra slow!" ] ) - $ unifyArguments `andThen` \args -> do - sourceTarget <- - case args of - [] -> Right Input.PushSourceTarget0 - [targetStr] -> do - target <- parsePushTarget targetStr - Right (Input.PushSourceTarget1 target) - [targetStr, sourceStr] -> do - target <- parsePushTarget targetStr - source <- parsePushSource sourceStr - Right (Input.PushSourceTarget2 source target) - _ -> Left (I.help pushExhaustive) - Right $ - Input.PushRemoteBranchI - Input.PushRemoteBranchInput - { sourceTarget, - pushBehavior = PushBehavior.RequireNonEmpty, - syncMode = SyncMode.Complete - } + $ fmap + ( \sourceTarget -> + Input.PushRemoteBranchI + Input.PushRemoteBranchInput + { sourceTarget, + pushBehavior = PushBehavior.RequireNonEmpty, + syncMode = SyncMode.Complete + } + ) + . \case + [] -> pure Input.PushSourceTarget0 + [targetStr] -> + bimap P.text Input.PushSourceTarget1 $ handlePushTargetArg targetStr + [targetStr, sourceStr] -> + first P.text $ + Input.PushSourceTarget2 + <$> handlePushSourceArg sourceStr + <*> handlePushTargetArg targetStr + _ -> Left (I.help pushExhaustive) where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -1715,16 +2148,14 @@ squashMerge = <> "discarding the history of `src` in the process." <> "The resulting `dest` will have (at most) 1" <> "additional history entry.", - parse = - maybeToEither (I.help squashMerge) - . ( \case - [src, dest] -> do - src <- parseLooseCodeOrProject src - dest <- parseLooseCodeOrProject dest - Just $ Input.MergeLocalBranchI src dest Branch.SquashMerge - _ -> Nothing - ) - . unifyArguments + parse = \case + [src, dest] -> + first P.text $ + Input.MergeLocalBranchI + <$> handleLooseCodeOrProjectArg src + <*> handleLooseCodeOrProjectArg dest + <*> pure Branch.SquashMerge + _ -> Left $ I.help squashMerge } where suggestionsConfig = @@ -1764,18 +2195,20 @@ mergeLocal = ) ] ) - ( maybeToEither (I.help mergeLocal) - . ( \case - [src] -> do - src <- parseLooseCodeOrProject src - Just $ Input.MergeLocalBranchI src (This Path.relativeEmpty') Branch.RegularMerge - [src, dest] -> do - src <- parseLooseCodeOrProject src - dest <- parseLooseCodeOrProject dest - Just $ Input.MergeLocalBranchI src dest Branch.RegularMerge - _ -> Nothing - ) - . unifyArguments + ( \case + [src] -> + first P.text $ + Input.MergeLocalBranchI + <$> handleLooseCodeOrProjectArg src + <*> pure (This Path.relativeEmpty') + <*> pure Branch.RegularMerge + [src, dest] -> + first P.text $ + Input.MergeLocalBranchI + <$> handleLooseCodeOrProjectArg src + <*> handleLooseCodeOrProjectArg dest + <*> pure Branch.RegularMerge + _ -> Left $ I.help mergeLocal ) where config = @@ -1814,14 +2247,17 @@ diffNamespace = ) ] ) - ( unifyArguments `andThen` \case - [before, after] -> first P.text do - before <- Input.parseBranchId before - after <- Input.parseBranchId after - pure $ Input.DiffNamespaceI before after - [before] -> first P.text do - before <- Input.parseBranchId before - pure $ Input.DiffNamespaceI before (Right Path.currentPath) + ( \case + [before, after] -> + first P.text $ + Input.DiffNamespaceI + <$> handleBranchIdArg before + <*> handleBranchIdArg after + [before] -> + first P.text $ + Input.DiffNamespaceI + <$> handleBranchIdArg before + <*> pure (pure Path.currentPath) _ -> Left $ I.help diffNamespace ) where @@ -1848,18 +2284,18 @@ previewMergeLocal = ) ] ) - ( maybeToEither (I.help previewMergeLocal) - . ( \case - [src] -> do - src <- parseLooseCodeOrProject src - pure $ Input.PreviewMergeLocalBranchI src (This Path.relativeEmpty') - [src, dest] -> do - src <- parseLooseCodeOrProject src - dest <- parseLooseCodeOrProject dest - pure $ Input.PreviewMergeLocalBranchI src dest - _ -> Nothing - ) - . unifyArguments + ( \case + [src] -> + first P.text $ + Input.PreviewMergeLocalBranchI + <$> handleLooseCodeOrProjectArg src + <*> pure (This Path.relativeEmpty') + [src, dest] -> + first P.text $ + Input.PreviewMergeLocalBranchI + <$> handleLooseCodeOrProjectArg src + <*> handleLooseCodeOrProjectArg dest + _ -> Left $ I.help previewMergeLocal ) where suggestionsConfig = @@ -1896,12 +2332,12 @@ replaceEdit f = self ) ] ) - ( unifyArguments `andThen` \case - source : target : patch -> do - patch <- first P.text <$> traverse Path.parseSplit' $ listToMaybe patch - sourcehq <- parseHashQualifiedName source - targethq <- parseHashQualifiedName target - pure $ f sourcehq targethq patch + ( \case + source : target : patch -> + f + <$> handleHashQualifiedNameArg source + <*> handleHashQualifiedNameArg target + <*> first P.text (traverse handleSplit'Arg $ listToMaybe patch) _ -> Left $ I.help self ) @@ -1937,12 +2373,12 @@ edit = "`edit` without arguments invokes a search to select a definition for editing, which requires that `fzf` can be found within your PATH." ], parse = - unifyArguments `andThen` \case - (x : xs) -> - (x NE.:| xs) - & traverse parseHashQualifiedName - <&> (Input.ShowDefinitionI Input.LatestFileLocation Input.ShowDefinitionLocal) - [] -> Left (I.help edit) + maybe + (Left $ I.help edit) + ( fmap (Input.ShowDefinitionI Input.LatestFileLocation Input.ShowDefinitionLocal) + . traverse handleHashQualifiedNameArg + ) + . NE.nonEmpty } editNamespace :: InputPattern @@ -1957,7 +2393,7 @@ editNamespace = [ "`edit.namespace` will load all terms and types contained within the current namespace into your scratch file. This includes definitions in namespaces, but excludes libraries.", "`edit.namespace ns1 ns2 ...` loads the terms and types contained within the provided namespaces." ], - parse = Right . Input.EditNamespaceI . fmap (Path.unsafeParseText . Text.pack) . unifyArguments + parse = bimap P.text Input.EditNamespaceI . traverse handlePathArg } topicNameArg :: ArgumentType @@ -1965,7 +2401,7 @@ topicNameArg = let topics = Map.keys helpTopicsMap in ArgumentType { typeName = "topic", - suggestions = \q _ _ _ -> pure (exactComplete q $ topics), + suggestions = \q _ _ _ -> pure (exactComplete q topics), fzfResolver = Just $ Resolvers.fuzzySelectFromList (Text.pack <$> topics) } @@ -1985,11 +2421,13 @@ helpTopics = I.Visible [("topic", Optional, topicNameArg)] ("`help-topics` lists all topics and `help-topics ` shows an explanation of that topic.") - ( unifyArguments `andThen` \case + ( \case [] -> Left topics - [topic] -> case Map.lookup topic helpTopicsMap of - Nothing -> Left . warn $ "I don't know of that topic. Try `help-topics`." - Just t -> Left t + [topic] -> do + topic <- unsupportedStructuredArgument "a help topic" topic + case Map.lookup topic helpTopicsMap of + Nothing -> Left . warn $ "I don't know of that topic. Try `help-topics`." + Just t -> Left t _ -> Left $ warn "Use `help-topics ` or `help-topics`." ) where @@ -2168,14 +2606,15 @@ help = I.Visible [("command", Optional, commandNameArg)] "`help` shows general help and `help ` shows help for one command." - $ unifyArguments `andThen` \case + $ \case [] -> Left $ intercalateMap "\n\n" showPatternHelp visibleInputs - [cmd] -> + [cmd] -> do + cmd <- unsupportedStructuredArgument "a command" cmd case (Map.lookup cmd commandsByName, isHelp cmd) of (Nothing, Just msg) -> Left msg (Nothing, Nothing) -> Left . warn $ "I don't know of that command. Try `help`." @@ -2230,11 +2669,10 @@ viewPatch = ) ] ) - $ unifyArguments `andThen` \case + $ \case [] -> Right $ Input.ListEditsI Nothing - [patchStr] -> mapLeft P.text do - patch <- Path.parseSplit' patchStr - Right $ Input.ListEditsI (Just patch) + [patchStr] -> + bimap P.text (Input.ListEditsI . pure) $ handleSplit'Arg patchStr _ -> Left $ warn "`view.patch` takes a patch and that's it." names :: Input.IsGlobal -> InputPattern @@ -2245,13 +2683,8 @@ names isGlobal = I.Visible [("name or hash", Required, definitionQueryArg)] (P.wrap $ makeExample (names isGlobal) ["foo"] <> " shows the hash and all known names for `foo`.") - $ unifyArguments `andThen` \case - [thing] -> case HQ.parseText (Text.pack thing) of - Just hq -> Right $ Input.NamesI isGlobal hq - Nothing -> - Left $ - "I was looking for one of these forms: " - <> P.blue "foo .foo.bar foo#abc #abcde .foo.bar#asdf" + $ \case + [thing] -> Input.NamesI isGlobal <$> handleHashQualifiedNameArg thing _ -> Left (I.help (names isGlobal)) where cmdName = if isGlobal then "names.global" else "names" @@ -2264,8 +2697,8 @@ dependents = I.Visible [("definition", Required, definitionQueryArg)] "List the named dependents of the specified definition." - $ unifyArguments `andThen` \case - [thing] -> fmap Input.ListDependentsI $ parseHashQualifiedName thing + $ \case + [thing] -> Input.ListDependentsI <$> handleHashQualifiedNameArg thing _ -> Left (I.help dependents) dependencies = InputPattern @@ -2274,8 +2707,8 @@ dependencies = I.Visible [("definition", Required, definitionQueryArg)] "List the dependencies of the specified definition." - $ unifyArguments `andThen` \case - [thing] -> fmap Input.ListDependenciesI $ parseHashQualifiedName thing + $ \case + [thing] -> Input.ListDependenciesI <$> handleHashQualifiedNameArg thing _ -> Left (I.help dependencies) namespaceDependencies :: InputPattern @@ -2286,10 +2719,9 @@ namespaceDependencies = I.Visible [("namespace", Optional, namespaceArg)] "List the external dependencies of the specified namespace." - $ unifyArguments `andThen` \case - [p] -> first P.text do - p <- Path.parsePath' p - pure $ Input.NamespaceDependenciesI (Just p) + $ \case + [p] -> + bimap P.text (Input.NamespaceDependenciesI . pure) $ handlePath'Arg p [] -> pure (Input.NamespaceDependenciesI Nothing) _ -> Left (I.help namespaceDependencies) @@ -2341,8 +2773,8 @@ debugTerm = I.Hidden [("term", Required, exactDefinitionTermQueryArg)] "View debugging information for a given term." - ( unifyArguments `andThen` \case - [thing] -> fmap (Input.DebugTermI False) $ parseHashQualifiedName thing + ( \case + [thing] -> Input.DebugTermI False <$> handleHashQualifiedNameArg thing _ -> Left (I.help debugTerm) ) @@ -2354,8 +2786,8 @@ debugTermVerbose = I.Hidden [("term", Required, exactDefinitionTermQueryArg)] "View verbose debugging information for a given term." - ( unifyArguments `andThen` \case - [thing] -> fmap (Input.DebugTermI True) $ parseHashQualifiedName thing + ( \case + [thing] -> Input.DebugTermI True <$> handleHashQualifiedNameArg thing _ -> Left (I.help debugTermVerbose) ) @@ -2367,8 +2799,8 @@ debugType = I.Hidden [("type", Required, exactDefinitionTypeQueryArg)] "View debugging information for a given type." - ( unifyArguments `andThen` \case - [thing] -> fmap (Input.DebugTypeI) $ parseHashQualifiedName thing + ( \case + [thing] -> Input.DebugTypeI <$> handleHashQualifiedNameArg thing _ -> Left (I.help debugType) ) @@ -2415,11 +2847,12 @@ debugNameDiff = args = [("before namespace", Required, namespaceArg), ("after namespace", Required, namespaceArg)], help = P.wrap "List all name changes between two causal hashes. Does not detect patch changes.", parse = - ( unifyArguments `andThen` \case - [from, to] -> first fromString $ do - fromSCH <- Input.parseShortCausalHash from - toSCH <- Input.parseShortCausalHash to - pure $ Input.DebugNameDiffI fromSCH toSCH + ( \case + [from, to] -> + first P.text $ + Input.DebugNameDiffI + <$> handleShortCausalHashArg from + <*> handleShortCausalHashArg to _ -> Left (I.help debugNameDiff) ) } @@ -2474,10 +2907,11 @@ docsToHtml = ) ] ) - $ unifyArguments `andThen` \case - [namespacePath, destinationFilePath] -> first P.text do - np <- Path.parsePath' namespacePath - pure $ Input.DocsToHtmlI np destinationFilePath + $ \case + [namespacePath, destinationFilePath] -> + Input.DocsToHtmlI + <$> first P.text (handlePath'Arg namespacePath) + <*> unsupportedStructuredArgument "a file name" destinationFilePath _ -> Left $ showPatternHelp docsToHtml docToMarkdown :: InputPattern @@ -2493,10 +2927,9 @@ docToMarkdown = ) ] ) - $ unifyArguments `andThen` \case - [docNameText] -> first fromString $ do - docName <- maybeToEither "Invalid name" . Name.parseText . Text.pack $ docNameText - pure $ Input.DocToMarkdownI docName + $ \case + [docNameText] -> + bimap P.text Input.DocToMarkdownI $ handleNameArg docNameText _ -> Left $ showPatternHelp docToMarkdown execute :: InputPattern @@ -2515,9 +2948,10 @@ execute = ) ] ) - $ unifyArguments `andThen` \case - [w] -> pure $ Input.ExecuteI (Text.pack w) [] - w : ws -> pure $ Input.ExecuteI (Text.pack w) ws + $ \case + main : args -> + Input.ExecuteI (Text.pack $ unifyArgument main) + <$> traverse (unsupportedStructuredArgument "a command-line argument") args _ -> Left $ showPatternHelp execute saveExecuteResult :: InputPattern @@ -2530,8 +2964,8 @@ saveExecuteResult = ( "`add.run name` adds to the codebase the result of the most recent `run` command" <> "as `name`." ) - $ unifyArguments `andThen` \case - [w] -> pure $ Input.SaveExecuteResultI (Name.unsafeParseText (Text.pack w)) + $ \case + [w] -> first P.text $ Input.SaveExecuteResultI <$> handleNameArg w _ -> Left $ showPatternHelp saveExecuteResult ioTest :: InputPattern @@ -2547,10 +2981,9 @@ ioTest = "Runs `!mytest`, where `mytest` is a delayed test that can use the `IO` and `Exception` abilities." ) ], - parse = - unifyArguments `andThen` \case - [thing] -> fmap Input.IOTestI $ parseHashQualifiedName thing - _ -> Left $ showPatternHelp ioTest + parse = \case + [thing] -> Input.IOTestI <$> handleHashQualifiedNameArg thing + _ -> Left $ showPatternHelp ioTest } ioTestAll :: InputPattern @@ -2586,9 +3019,11 @@ makeStandalone = ) ] ) - $ unifyArguments `andThen` \case + $ \case [main, file] -> - Input.MakeStandaloneI file <$> parseHashQualifiedName main + Input.MakeStandaloneI + <$> unsupportedStructuredArgument "a file name" file + <*> handleHashQualifiedNameArg main _ -> Left $ showPatternHelp makeStandalone runScheme :: InputPattern @@ -2604,8 +3039,10 @@ runScheme = ) ] ) - $ unifyArguments `andThen` \case - main : args -> Right $ Input.ExecuteSchemeI (Text.pack main) args + $ \case + main : args -> + Input.ExecuteSchemeI (Text.pack $ unifyArgument main) + <$> traverse (unsupportedStructuredArgument "a command-line argument") args _ -> Left $ showPatternHelp runScheme compileScheme :: InputPattern @@ -2623,9 +3060,11 @@ compileScheme = ) ] ) - $ unifyArguments `andThen` \case + $ \case [main, file] -> - Input.CompileSchemeI (Text.pack file) <$> parseHashQualifiedName main + Input.CompileSchemeI . Text.pack + <$> unsupportedStructuredArgument "a file name" file + <*> handleHashQualifiedNameArg main _ -> Left $ showPatternHelp compileScheme createAuthor :: InputPattern @@ -2646,19 +3085,21 @@ createAuthor = <> backtick (P.group ("metadata.copyrightHolders" <> ".")) ) ) - ( unifyArguments `andThen` \case - symbolStr : authorStr@(_ : _) -> first P.text do - symbol <- - Megaparsec.runParser (Megaparsec.withParsecT (fmap NameSegment.renderParseErr) NameSegment.segmentP <* Megaparsec.eof) "" symbolStr - & mapLeft (Text.pack . Megaparsec.errorBundlePretty) - -- let's have a real parser in not too long - let author :: Text - author = Text.pack $ case (unwords authorStr) of - quoted@('"' : _) -> (init . tail) quoted - bare -> bare - pure $ Input.CreateAuthorI symbol author - _ -> Left $ showPatternHelp createAuthor - ) + \case + symbolStr : authorStr@(_ : _) -> + Input.CreateAuthorI + <$> first P.text (handleRelativeNameSegmentArg symbolStr) + <*> fmap + (parseAuthorName . unwords) + (traverse (unsupportedStructuredArgument "text") authorStr) + _ -> Left $ showPatternHelp createAuthor + where + -- let's have a real parser in not too long + parseAuthorName :: String -> Text + parseAuthorName = + Text.pack . \case + ('"' : quoted) -> init quoted + bare -> bare gist :: InputPattern gist = @@ -2681,10 +3122,11 @@ gist = <> "`push.create` of the current namespace to your Unison Share codebase wherever you like!" ] ) - ( unifyArguments `andThen` \case - [repoString] -> do - repo <- parseWriteGitRepo "gist git repo" repoString - pure (Input.GistI (Input.GistInput repo)) + ( \case + [repoString] -> + fmap (Input.GistI . Input.GistInput) + . parseWriteGitRepo "gist git repo" + =<< unsupportedStructuredArgument "a VCS repository" repoString _ -> Left (showPatternHelp gist) ) @@ -2728,15 +3170,14 @@ diffNamespaceToPatch = visibility = I.Visible, args = [], help = P.wrap "Create a patch from a namespace diff.", - parse = - unifyArguments `andThen` \case - [branchId1, branchId2, patch] -> - mapLeft P.text do - branchId1 <- Input.parseBranchId branchId1 - branchId2 <- Input.parseBranchId branchId2 - patch <- Path.parseSplit' patch - pure (Input.DiffNamespaceToPatchI Input.DiffNamespaceToPatchInput {branchId1, branchId2, patch}) - _ -> Left (showPatternHelp diffNamespaceToPatch) + parse = \case + [branchId1, branchId2, patch] -> + bimap P.text Input.DiffNamespaceToPatchI $ + Input.DiffNamespaceToPatchInput + <$> handleBranchIdArg branchId1 + <*> handleBranchIdArg branchId2 + <*> handleSplit'Arg patch + _ -> Left (showPatternHelp diffNamespaceToPatch) } projectCreate :: InputPattern @@ -2751,13 +3192,12 @@ projectCreate = [ ("`project.create`", "creates a project with a random name"), ("`project.create foo`", "creates a project named `foo`") ], - parse = - unifyArguments `andThen` \case - [name] -> - case tryInto @ProjectName (Text.pack name) of - Left _ -> Left "Invalid project name." - Right name1 -> Right (Input.ProjectCreateI True (Just name1)) - _ -> Right (Input.ProjectCreateI True Nothing) + parse = \case + [] -> Right (Input.ProjectCreateI True Nothing) + [name] -> + bimap P.text (Input.ProjectCreateI True . pure) $ + handleProjectArg name + _ -> Left $ showPatternHelp projectCreate } projectCreateEmptyInputPattern :: InputPattern @@ -2772,13 +3212,12 @@ projectCreateEmptyInputPattern = [ ("`project.create-empty`", "creates an empty project with a random name"), ("`project.create-empty foo`", "creates an empty project named `foo`") ], - parse = - unifyArguments `andThen` \case - [name] -> - case tryInto @ProjectName (Text.pack name) of - Left _ -> Left "Invalid project name." - Right name1 -> Right (Input.ProjectCreateI False (Just name1)) - _ -> Right (Input.ProjectCreateI False Nothing) + parse = \case + [] -> Right (Input.ProjectCreateI False Nothing) + [name] -> + bimap P.text (Input.ProjectCreateI False . pure) $ + handleProjectArg name + _ -> Left $ showPatternHelp projectCreateEmptyInputPattern } projectRenameInputPattern :: InputPattern @@ -2792,10 +3231,10 @@ projectRenameInputPattern = P.wrapColumn2 [ ("`project.rename foo`", "renames the current project to `foo`") ], - parse = - unifyArguments `andThen` \case - [nameString] | Right name <- tryInto (Text.pack nameString) -> Right (Input.ProjectRenameI name) - _ -> Left (showPatternHelp projectRenameInputPattern) + parse = \case + [nameString] -> + bimap P.text Input.ProjectRenameI $ handleProjectArg nameString + _ -> Left (showPatternHelp projectRenameInputPattern) } projectSwitch :: InputPattern @@ -2812,13 +3251,11 @@ projectSwitch = ("`switch foo/`", "switches to the last branch you visited in the project `foo`"), ("`switch /bar`", "switches to the branch `bar` in the current project") ], - parse = - unifyArguments `andThen` \case - [name] -> - case tryInto @ProjectAndBranchNames (Text.pack name) of - Left _ -> Left (showPatternHelp projectSwitch) - Right projectAndBranch -> Right (Input.ProjectSwitchI projectAndBranch) - _ -> Left (showPatternHelp projectSwitch) + parse = \case + [name] -> + bimap P.text Input.ProjectSwitchI $ + handleProjectAndBranchNamesArg name + _ -> Left (showPatternHelp projectSwitch) } where suggestionsConfig = @@ -2851,11 +3288,11 @@ branchesInputPattern = [ ("`branches`", "lists all branches in the current project"), ("`branches foo", "lists all branches in the project `foo`") ], - parse = - unifyArguments `andThen` \case - [] -> Right (Input.BranchesI Nothing) - [nameString] | Right name <- tryFrom (Text.pack nameString) -> Right (Input.BranchesI (Just name)) - _ -> Left (showPatternHelp branchesInputPattern) + parse = \case + [] -> Right (Input.BranchesI Nothing) + [nameString] -> + bimap P.text (Input.BranchesI . pure) $ handleProjectArg nameString + _ -> Left (showPatternHelp branchesInputPattern) } branchInputPattern :: InputPattern @@ -2874,25 +3311,17 @@ branchInputPattern = ("`branch /bar foo`", "forks the branch `bar` of the current project to a new branch `foo`"), ("`branch .bar foo`", "forks the path `.bar` of the current project to a new branch `foo`") ], - parse = - maybeToEither (showPatternHelp branchInputPattern) - . ( \case - [source0, name] -> do - source <- parseLooseCodeOrProject source0 - projectAndBranch <- - Text.pack name - & tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - & eitherToMaybe - Just (Input.BranchI (Input.BranchSourceI'LooseCodeOrProject source) projectAndBranch) - [name] -> do - projectAndBranch <- - Text.pack name - & tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - & eitherToMaybe - Just (Input.BranchI Input.BranchSourceI'CurrentContext projectAndBranch) - _ -> Nothing - ) - . unifyArguments + parse = \case + [source0, name] -> + first P.text $ + Input.BranchI . Input.BranchSourceI'LooseCodeOrProject + <$> handleLooseCodeOrProjectArg source0 + <*> handleProjectAndBranchArg name + [name] -> + first P.text $ + Input.BranchI Input.BranchSourceI'CurrentContext + <$> handleProjectAndBranchArg name + _ -> Left $ showPatternHelp branchInputPattern } where newBranchNameArg = @@ -2916,13 +3345,11 @@ branchEmptyInputPattern = visibility = I.Visible, args = [], help = P.wrap "Create a new empty branch.", - parse = - unifyArguments `andThen` \case - [name] -> - first (\_ -> showPatternHelp branchEmptyInputPattern) do - projectAndBranch <- tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) (Text.pack name) - Right (Input.BranchI Input.BranchSourceI'Empty projectAndBranch) - _ -> Left (showPatternHelp branchEmptyInputPattern) + parse = \case + [name] -> + bimap P.text (Input.BranchI Input.BranchSourceI'Empty) $ + handleProjectAndBranchArg name + _ -> Left (showPatternHelp branchEmptyInputPattern) } branchRenameInputPattern :: InputPattern @@ -2934,12 +3361,11 @@ branchRenameInputPattern = args = [], help = P.wrapColumn2 - [ ("`branch.rename foo`", "renames the current branch to `foo`") - ], - parse = - unifyArguments `andThen` \case - [nameString] | Right name <- tryInto (Text.pack nameString) -> Right (Input.BranchRenameI name) - _ -> Left (showPatternHelp branchRenameInputPattern) + [("`branch.rename foo`", "renames the current branch to `foo`")], + parse = \case + [name] -> + bimap P.text Input.BranchRenameI $ handleProjectBranchNameArg name + _ -> Left (showPatternHelp branchRenameInputPattern) } clone :: InputPattern @@ -2971,19 +3397,18 @@ clone = <> P.group (makeExample helpTopics ["remotes"] <> ")") ) ], - parse = - maybe (Left (showPatternHelp clone)) Right - . ( \case - [remoteNamesString] -> do - remoteNames <- eitherToMaybe (tryInto @ProjectAndBranchNames (Text.pack remoteNamesString)) - Just (Input.CloneI remoteNames Nothing) - [remoteNamesString, localNamesString] -> do - remoteNames <- eitherToMaybe (tryInto @ProjectAndBranchNames (Text.pack remoteNamesString)) - localNames <- eitherToMaybe (tryInto @ProjectAndBranchNames (Text.pack localNamesString)) - Just (Input.CloneI remoteNames (Just localNames)) - _ -> Nothing - ) - . unifyArguments + parse = \case + [remoteNames] -> do + first P.text $ + Input.CloneI + <$> handleProjectAndBranchNamesArg remoteNames + <*> pure Nothing + [remoteNames, localNames] -> + first P.text $ + Input.CloneI + <$> handleProjectAndBranchNamesArg remoteNames + <*> fmap pure (handleProjectAndBranchNamesArg localNames) + _ -> Left $ showPatternHelp clone } releaseDraft :: InputPattern @@ -2994,10 +3419,13 @@ releaseDraft = visibility = I.Visible, args = [], help = P.wrap "Draft a release.", - parse = - unifyArguments `andThen` \case - [tryInto @Semver . Text.pack -> Right semver] -> Right (Input.ReleaseDraftI semver) - _ -> Left (showPatternHelp releaseDraft) + parse = \case + [semverString] -> + bimap (const "Couldn’t parse version number") Input.ReleaseDraftI + . tryInto @Semver + . Text.pack + =<< unsupportedStructuredArgument "a version number" semverString + _ -> Left (showPatternHelp releaseDraft) } upgrade :: InputPattern @@ -3010,23 +3438,14 @@ upgrade = help = P.wrap $ "`upgrade old new` upgrades library dependency `lib.old` to `lib.new`, and, if successful, deletes `lib.old`.", - parse = - maybeToEither (I.help upgrade) - . ( \args -> do - [oldString, newString] <- Just args - old <- parseRelativeNameSegment oldString - new <- parseRelativeNameSegment newString - Just (Input.UpgradeI old new) - ) - . unifyArguments + parse = \case + [oldString, newString] -> + first P.text $ + Input.UpgradeI + <$> handleRelativeNameSegmentArg oldString + <*> handleRelativeNameSegmentArg newString + _ -> Left $ I.help upgrade } - where - parseRelativeNameSegment :: String -> Maybe NameSegment - parseRelativeNameSegment string = do - name <- Name.parseText (Text.pack string) - guard (Name.isRelative name) - segment NE.:| [] <- Just (Name.reverseSegments name) - Just segment validInputs :: [InputPattern] validInputs = @@ -3347,7 +3766,7 @@ data ProjectInclusion = OnlyWithinCurrentProject | OnlyOutsideCurrentProject | A data BranchInclusion = ExcludeCurrentBranch | AllBranches deriving stock (Eq, Ord, Show) -projectsByPrefix :: MonadIO m => ProjectInclusion -> Codebase m v a -> Path.Absolute -> Text -> m [(ProjectId, ProjectName)] +projectsByPrefix :: (MonadIO m) => ProjectInclusion -> Codebase m v a -> Path.Absolute -> Text -> m [(ProjectId, ProjectName)] projectsByPrefix projectInclusion codebase path query = do allProjectMatches <- Codebase.runTransaction codebase do Queries.loadAllProjectsBeginningWith (Just query) @@ -3427,7 +3846,7 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient path = do ProjectBranchPath projectId branchId _ -> (Just projectId, Just branchId) handleAmbiguousComplete :: - MonadIO m => + (MonadIO m) => Text -> Codebase m v a -> m [Completion] @@ -3516,7 +3935,7 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient path = do then projectCompletions else branchCompletions ++ projectCompletions - handleBranchesComplete :: MonadIO m => Text -> Codebase m v a -> Path.Absolute -> m [Completion] + handleBranchesComplete :: (MonadIO m) => Text -> Codebase m v a -> Path.Absolute -> m [Completion] handleBranchesComplete branchName codebase path = do branches <- case preview ProjectUtils.projectBranchPathPrism path of @@ -3557,7 +3976,7 @@ projectBranchToCompletion projectName (_, branchName) = } handleBranchesComplete :: - MonadIO m => + (MonadIO m) => ProjectBranchSuggestionsConfig -> Text -> Codebase m v a -> @@ -3593,7 +4012,7 @@ currentProjectBranchToCompletion (_, branchName) = } branchRelativePathSuggestions :: - MonadIO m => + (MonadIO m) => ProjectBranchSuggestionsConfig -> String -> Codebase m v a -> @@ -3699,7 +4118,7 @@ branchRelativePathSuggestions config inputStr codebase _httpClient currentPath = branchPathSepPretty = P.hiBlack branchPathSep - branchPathSep :: IsString s => s + branchPathSep :: (IsString s) => s branchPathSep = ":" -- | A project name, branch name, or both. @@ -3758,7 +4177,7 @@ data OptionalSlash | NoSlash projectNameSuggestions :: - MonadIO m => + (MonadIO m) => OptionalSlash -> String -> Codebase m v a -> @@ -3789,21 +4208,16 @@ parsePullSource = Megaparsec.parseMaybe (readRemoteNamespaceParser ProjectBranchSpecifier'NameOrLatestRelease) -- | Parse a 'Input.PushSource'. -parsePushSource :: String -> Either (P.Pretty CT.ColorText) Input.PushSource +parsePushSource :: String -> Maybe Input.PushSource parsePushSource sourceStr = - case tryFrom (Text.pack sourceStr) of - Left _ -> - case Path.parsePath' sourceStr of - Left _ -> Left (I.help push) - Right path -> Right (Input.PathySource path) - Right branch -> Right (Input.ProjySource branch) + fixup Input.ProjySource (tryFrom $ Text.pack sourceStr) + <|> fixup Input.PathySource (Path.parsePath' sourceStr) + where + fixup = either (const Nothing) . (pure .) -- | Parse a push target. -parsePushTarget :: String -> Either (P.Pretty CT.ColorText) (WriteRemoteNamespace (These ProjectName ProjectBranchName)) -parsePushTarget target = - case Megaparsec.parseMaybe UriParser.writeRemoteNamespace (Text.pack target) of - Nothing -> Left (I.help push) - Just path -> Right path +parsePushTarget :: String -> Maybe (WriteRemoteNamespace (These ProjectName ProjectBranchName)) +parsePushTarget = Megaparsec.parseMaybe UriParser.writeRemoteNamespace . Text.pack parseHashQualifiedName :: String -> Either (P.Pretty CT.ColorText) (HQ.HashQualified Name) diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 18a0c8f9c8..f675f91896 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -113,7 +113,7 @@ getUserInput codebase authHTTPClient currentPath numberedArgs = -- Ctrl-c or some input cancel, re-run the prompt go Right (Just (expandedArgs, i)) -> do - let expandedArgs' = IP.unifyArguments expandedArgs + let expandedArgs' = IP.unifyArgument <$> expandedArgs expandedArgsStr = unwords expandedArgs' when (expandedArgs' /= ws) $ do liftIO . putStrLn $ fullPrompt <> expandedArgsStr From d6a394f3e0698d2fd711ec375fd0c1d3eb6141ba Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 21 May 2024 00:54:16 -0600 Subject: [PATCH 018/631] Serialize `StructuredArgument`s on demand Previously, the `Text` format had been preserved from the original code. This extracts all to a separate function that is called as needed. All transcripts still pass. --- .../src/Unison/Codebase/Editor/HandleInput.hs | 34 +-- .../Editor/HandleInput/FindAndReplace.hs | 3 +- .../src/Unison/Codebase/Editor/Output.hs | 2 +- .../src/Unison/CommandLine/InputPattern.hs | 2 +- .../src/Unison/CommandLine/InputPatterns.hs | 248 +++++++++++------- .../src/Unison/CommandLine/OutputMessages.hs | 64 ++--- 6 files changed, 185 insertions(+), 168 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 4886caeb48..312c8c3437 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -153,7 +153,6 @@ import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Runtime.IOSource qualified as IOSource -import Unison.Server.Backend (ShallowListEntry (..)) import Unison.Server.Backend qualified as Backend import Unison.Server.CodebaseServer qualified as Server import Unison.Server.Doc.Markdown.Render qualified as Md @@ -298,8 +297,8 @@ loop e = do let (shortEntries, numberedEntries) = unzip $ expandedEntries <&> \(time, hash, reason) -> - let ((exp, txt), sa) = ((id &&& ("#" <>) . SCH.toText) . SCH.fromHash schLength &&& SA.Namespace) hash - in ((time, exp, reason), (txt, sa)) + let (exp, sa) = (SCH.fromHash schLength &&& SA.Namespace) hash + in ((time, exp, reason), sa) Cli.setNumberedArgs numberedEntries Cli.respond $ ShowReflog shortEntries where @@ -791,13 +790,13 @@ loop e = do (seg, _) <- Map.toList (Branch._edits b) ] Cli.respond $ ListOfPatches $ Set.fromList patches - Cli.setNumberedArgs $ fmap (Name.toText &&& SA.Name) patches + Cli.setNumberedArgs $ fmap SA.Name patches FindShallowI pathArg -> do Cli.Env {codebase} <- ask pathArgAbs <- Cli.resolvePath' pathArg entries <- liftIO (Backend.lsAtPath codebase Nothing pathArgAbs) - Cli.setNumberedArgs $ fmap (entryToHQText &&& SA.ShallowListEntry pathArg) entries + Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArg) entries pped <- Cli.currentPrettyPrintEnvDecl let suffixifiedPPE = PPED.suffixifiedPPE pped -- This used to be a delayed action which only forced the loading of the root @@ -807,21 +806,6 @@ loop e = do -- in an improvement, so perhaps it's not worth the effort. let buildPPE = pure suffixifiedPPE Cli.respond $ ListShallow buildPPE entries - where - entryToHQText :: ShallowListEntry v Ann -> Text - entryToHQText e = - fixup $ case e of - ShallowTypeEntry te -> Backend.typeEntryDisplayName te - ShallowTermEntry te -> Backend.termEntryDisplayName te - ShallowBranchEntry ns _ _ -> NameSegment.toEscapedText ns - ShallowPatchEntry ns -> NameSegment.toEscapedText ns - where - fixup s = - pathArgStr - <> if Text.null pathArgStr || Text.isSuffixOf "." pathArgStr - then s - else "." <> s - pathArgStr = Text.pack $ show pathArg FindI isVerbose fscope ws -> handleFindI isVerbose fscope ws input StructuredFindI _fscope ws -> handleStructuredFindI ws StructuredFindReplaceI ws -> handleStructuredFindReplaceI ws @@ -1501,7 +1485,7 @@ handleFindI isVerbose fscope ws input = do (mapMaybe (HQ.parseTextWith anythingBeforeHash . Text.pack) qs) pure $ uniqueBy SR.toReferent srs let respondResults results = do - Cli.setNumberedArgs $ fmap (HQ.toText . IP.searchResultToHQ searchRoot &&& SA.SearchResult searchRoot) results + Cli.setNumberedArgs $ fmap (SA.SearchResult searchRoot) results results' <- Cli.runTransaction (Backend.loadSearchResults codebase results) Cli.respond $ ListOfDefinitions fscope suffixifiedPPE isVerbose results' results <- getResults names @@ -1556,8 +1540,8 @@ handleDependencies hq = do let types = nubOrdOn snd . Name.sortByText (HQ.toText . fst) $ (join $ fst <$> results) let terms = nubOrdOn snd . Name.sortByText (HQ.toText . fst) $ (join $ snd <$> results) Cli.setNumberedArgs $ - map ((Reference.toText &&& SA.Ref) . snd) types - <> map ((Reference.toText &&& SA.Ref) . Referent.toReference . snd) terms + map (SA.Ref . snd) types + <> map (SA.Ref . Referent.toReference . snd) terms Cli.respond $ ListDependencies suffixifiedPPE lds (fst <$> types) (fst <$> terms) handleDependents :: HQ.HashQualified Name -> Cli () @@ -1594,7 +1578,7 @@ handleDependents hq = do let sort = nubOrdOn snd . Name.sortByText (HQ.toText . fst) let types = sort [(n, r) | (False, n, r) <- join results] let terms = sort [(n, r) | (True, n, r) <- join results] - Cli.setNumberedArgs . map ((Reference.toText &&& SA.Ref) . view _2) $ types <> terms + Cli.setNumberedArgs . map (SA.Ref . view _2) $ types <> terms Cli.respond (ListDependents ppe lds (fst <$> types) (fst <$> terms)) handleDiffNamespaceToPatch :: Text -> DiffNamespaceToPatchInput -> Cli () @@ -1775,7 +1759,7 @@ doShowTodoOutput patch scopePath = do then Cli.respond NoConflictsOrEdits else do Cli.setNumberedArgs - ((Reference.toText &&& SA.Ref) . view _2 <$> fst (TO.todoFrontierDependents todo)) + (SA.Ref . view _2 <$> fst (TO.todoFrontierDependents todo)) pped <- Cli.currentPrettyPrintEnvDecl Cli.respondNumbered $ TodoOutput pped todo diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs index 9ad17bbcc6..f96ae85b21 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs @@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.FindAndReplace ) where -import Control.Arrow ((&&&)) import Control.Lens hiding (at) import Control.Monad.Reader (ask) import Control.Monad.State @@ -89,7 +88,7 @@ handleStructuredFindI rule = do ok t = pure (t, False) results0 <- traverse ok results let results = Alphabetical.sortAlphabeticallyOn fst [(hq, r) | ((hq, r), True) <- results0] - let toNumArgs = (Reference.toText &&& SA.Ref) . Referent.toReference . view _2 + let toNumArgs = SA.Ref . Referent.toReference . view _2 Cli.setNumberedArgs $ map toNumArgs results Cli.respond (ListStructuredFind (fst <$> results)) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 751292ba92..88ad7f2043 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -90,7 +90,7 @@ type SourceName = Text -- __NB__: This only temporarily holds `Text`. Until all of the inputs are -- updated to handle `StructuredArgument`s, we need to ensure that the -- serialization remains unchanged. -type NumberedArgs = [(Text, StructuredArgument)] +type NumberedArgs = [StructuredArgument] type HashLength = Int diff --git a/unison-cli/src/Unison/CommandLine/InputPattern.hs b/unison-cli/src/Unison/CommandLine/InputPattern.hs index 15f58eb73b..4014bc1dc7 100644 --- a/unison-cli/src/Unison/CommandLine/InputPattern.hs +++ b/unison-cli/src/Unison/CommandLine/InputPattern.hs @@ -51,7 +51,7 @@ data Visibility = Hidden | Visible -- needs to be parsed or a numbered argument that doesn’t need to be parsed, as -- we’ve preserved its representation (although the numbered argument could -- still be of the wrong type, which should result in an error). -type Argument = Either String (Text, StructuredArgument) +type Argument = Either String StructuredArgument type Arguments = [Argument] diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index ebae14662a..247df1ce2c 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -41,7 +41,7 @@ import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.Codebase.Editor.UriParser (readRemoteNamespaceParser) import Unison.Codebase.Editor.UriParser qualified as UriParser -import Unison.Codebase.Path (Path) +import Unison.Codebase.Path (Path, Path') import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path import Unison.Codebase.PushBehavior qualified as PushBehavior @@ -63,16 +63,20 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment +import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (..), ProjectBranchName, ProjectBranchNameOrLatestRelease (..), ProjectBranchSpecifier (..), ProjectName, Semver) import Unison.Project.Util (ProjectContext (..), projectContextFromPath) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent +import Unison.Server.Backend (ShallowListEntry (..)) +import Unison.Server.Backend qualified as Backend import Unison.Server.SearchResult (SearchResult) import Unison.Server.SearchResult qualified as SR import Unison.ShortHash (ShortHash) -import Unison.Syntax.HashQualified qualified as HQ (parseText) -import Unison.Syntax.Name qualified as Name (parseTextEither) +import Unison.Syntax.HashQualified qualified as HQ (parseText, toText) +import Unison.Syntax.Name qualified as Name (parseTextEither, toText) +import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Util.ColorText qualified as CT import Unison.Util.Monoid (intercalateMap) import Unison.Util.Pretty qualified as P @@ -83,13 +87,60 @@ import Unison.Util.Pretty qualified as P schLength :: Int schLength = 10 --- | --- --- __TODO__: Temporary. This may stick around in a handful of cases, but it’ll --- have to actually serialize the `StructuredArgument` rather than --- relying on the parallel `Text`. +formatStructuredArgument :: StructuredArgument -> Text +formatStructuredArgument = \case + SA.AbsolutePath path -> into @Text $ show path + SA.Name name -> Name.toText name + SA.HashQualified hqName -> HQ.toText hqName + SA.Project projectName -> into @Text projectName + SA.ProjectBranch (ProjectAndBranch mproj branch) -> + maybe + (Text.cons '/' . into @Text) + (\project -> into @Text . ProjectAndBranch project) + mproj + branch + SA.Ref reference -> + -- also: ShortHash.toText . Reference.toShortHash + Reference.toText reference + SA.Namespace causalHash -> + -- also: ("#" <>) . Hash.toBase32HexText . unCausalHash + ("#" <>) . SCH.toText $ SCH.fromHash schLength causalHash + SA.NameWithBranchPrefix absBranchId name -> + prefixBranchId absBranchId name + SA.HashQualifiedWithBranchPrefix absBranchId hq'Name -> + HQ'.toTextWith (prefixBranchId absBranchId) hq'Name + SA.ShallowListEntry path entry -> entryToHQText path entry + SA.SearchResult searchRoot searchResult -> + HQ.toText $ searchResultToHQ searchRoot searchResult + where + -- E.g. + -- prefixBranchId "#abcdef" "base.List.map" -> "#abcdef:.base.List.map" + -- prefixBranchId ".base" "List.map" -> ".base.List.map" + prefixBranchId :: Input.AbsBranchId -> Name -> Text + prefixBranchId branchId name = case branchId of + Left sch -> "#" <> SCH.toText sch <> ":" <> Name.toText (Name.makeAbsolute name) + Right pathPrefix -> Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name) + + entryToHQText :: Path' -> ShallowListEntry v Ann -> Text + entryToHQText pathArg e = + fixup $ case e of + ShallowTypeEntry te -> Backend.typeEntryDisplayName te + ShallowTermEntry te -> Backend.termEntryDisplayName te + ShallowBranchEntry ns _ _ -> NameSegment.toEscapedText ns + ShallowPatchEntry ns -> NameSegment.toEscapedText ns + where + fixup s = + pathArgStr + <> if Text.null pathArgStr || Text.isSuffixOf "." pathArgStr + then s + else "." <> s + pathArgStr = Text.pack $ show pathArg + +-- | Converts an arbitrary argument to a `String`. This is for cases where the +-- command /should/ accept a structured argument of some type, but currently +-- wants a `String`. unifyArgument :: I.Argument -> String -unifyArgument = either id (Text.unpack . fst) +unifyArgument = either id (Text.unpack . formatStructuredArgument) showPatternHelp :: InputPattern -> P.Pretty CT.ColorText showPatternHelp i = @@ -130,11 +181,11 @@ expectedButActually expected actualValue actualType = <> actualType <> "." -wrongStructuredArgument :: Text -> (Text, StructuredArgument) -> Text -wrongStructuredArgument expected (actualStr, actual) = +wrongStructuredArgument :: Text -> StructuredArgument -> Text +wrongStructuredArgument expected actual = expectedButActually expected - actualStr + (formatStructuredArgument actual) case actual of SA.Ref _ -> "a reference" SA.Name _ -> "a name" @@ -179,9 +230,9 @@ handleProjectArg = $ Text.pack name ) ( \case - (_, SA.Project project) -> pure project + SA.Project project -> pure project -- __FIXME__: Do we want to treat a project branch as a project? - (_, SA.ProjectBranch (ProjectAndBranch (Just project) _)) -> pure project + SA.ProjectBranch (ProjectAndBranch (Just project) _) -> pure project otherArgType -> Left $ wrongStructuredArgument "a path" otherArgType ) @@ -193,8 +244,8 @@ handleLooseCodeOrProjectArg = . parseLooseCodeOrProject ) ( \case - (_, SA.AbsolutePath path) -> pure . This $ Path.absoluteToPath' path - (_, SA.ProjectBranch pb) -> pure $ That pb + SA.AbsolutePath path -> pure . This $ Path.absoluteToPath' path + SA.ProjectBranch pb -> pure $ That pb otherArgType -> Left $ wrongStructuredArgument "a path or project branch" otherArgType ) @@ -211,7 +262,7 @@ handleProjectAndBranchArg = $ Text.pack name ) ( \case - (_, SA.ProjectBranch pb) -> pure pb + SA.ProjectBranch pb -> pure pb otherArgType -> Left $ wrongStructuredArgument "a branch" otherArgType ) @@ -221,16 +272,16 @@ handleHashQualifiedNameArg = either parseHashQualifiedName ( \case - (_, SA.Name name) -> pure $ HQ.NameOnly name - (_, SA.NameWithBranchPrefix (Left _) name) -> pure $ HQ.NameOnly name - (_, SA.NameWithBranchPrefix (Right prefix) name) -> + SA.Name name -> pure $ HQ.NameOnly name + SA.NameWithBranchPrefix (Left _) name -> pure $ HQ.NameOnly name + SA.NameWithBranchPrefix (Right prefix) name -> pure . HQ.NameOnly . Name.makeAbsolute $ Path.prefixName prefix name - (_, SA.Ref ref) -> pure . HQ.HashOnly $ Reference.toShortHash ref - (_, SA.HashQualified hqname) -> pure hqname - (_, SA.HashQualifiedWithBranchPrefix (Left _) hqname) -> pure $ HQ'.toHQ hqname - (_, SA.HashQualifiedWithBranchPrefix (Right prefix) hqname) -> + SA.Ref ref -> pure . HQ.HashOnly $ Reference.toShortHash ref + SA.HashQualified hqname -> pure hqname + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toHQ hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . HQ'.toHQ $ Name.makeAbsolute . Path.prefixName prefix <$> hqname - (_, SA.SearchResult mpath result) -> pure $ searchResultToHQ mpath result + SA.SearchResult mpath result -> pure $ searchResultToHQ mpath result otherArgType -> Left . P.text $ wrongStructuredArgument "a hash-qualified name" otherArgType ) @@ -240,9 +291,9 @@ handlePathArg = either Path.parsePath \case - (_, SA.Name name) -> pure $ Path.fromName name - (_, SA.NameWithBranchPrefix (Left _) name) -> pure $ Path.fromName name - (_, SA.NameWithBranchPrefix (Right prefix) name) -> + SA.Name name -> pure $ Path.fromName name + SA.NameWithBranchPrefix (Left _) name -> pure $ Path.fromName name + SA.NameWithBranchPrefix (Right prefix) name -> pure . Path.fromName $ Path.prefixName prefix name otherArgType -> Left $ wrongStructuredArgument "a relative path" otherArgType @@ -252,10 +303,10 @@ handlePath'Arg = either Path.parsePath' ( \case - (_, SA.AbsolutePath path) -> pure $ Path.absoluteToPath' path - (_, SA.Name name) -> pure $ Path.fromName' name - (_, SA.NameWithBranchPrefix (Left _) name) -> pure $ Path.fromName' name - (_, SA.NameWithBranchPrefix (Right prefix) name) -> + SA.AbsolutePath path -> pure $ Path.absoluteToPath' path + SA.Name name -> pure $ Path.fromName' name + SA.NameWithBranchPrefix (Left _) name -> pure $ Path.fromName' name + SA.NameWithBranchPrefix (Right prefix) name -> pure . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name otherArgType -> Left $ wrongStructuredArgument "a namespace" otherArgType ) @@ -277,9 +328,9 @@ handleSplit'Arg = either Path.parseSplit' ( \case - (_, SA.Name name) -> pure $ Path.splitFromName' name - (_, SA.NameWithBranchPrefix (Left _) name) -> pure $ Path.splitFromName' name - (_, SA.NameWithBranchPrefix (Right prefix) name) -> + SA.Name name -> pure $ Path.splitFromName' name + SA.NameWithBranchPrefix (Left _) name -> pure $ Path.splitFromName' name + SA.NameWithBranchPrefix (Right prefix) name -> pure . Path.splitFromName' . Name.makeAbsolute $ Path.prefixName prefix name otherNumArg -> Left $ wrongStructuredArgument "a split name" otherNumArg ) @@ -292,7 +343,7 @@ handleProjectBranchNameArg = either (first (const "Wanted a branch name, but it wasn’t") . tryInto . Text.pack) ( \case - (_, SA.ProjectBranch (ProjectAndBranch _ branch)) -> pure branch + SA.ProjectBranch (ProjectAndBranch _ branch) -> pure branch otherNumArg -> Left $ wrongStructuredArgument "a branch name" otherNumArg ) @@ -301,14 +352,12 @@ handleBranchIdArg = either Input.parseBranchId ( \case - (_, SA.AbsolutePath path) -> pure . pure $ Path.absoluteToPath' path - (_, SA.Name name) -> pure . pure $ Path.fromName' name - (_, SA.NameWithBranchPrefix (Left _) name) -> - pure . pure $ Path.fromName' name - (_, SA.NameWithBranchPrefix (Right prefix) name) -> - pure . pure . Path.fromName' . Name.makeAbsolute $ - Path.prefixName prefix name - (_, SA.Namespace hash) -> pure . Left $ SCH.fromHash schLength hash + SA.AbsolutePath path -> pure . pure $ Path.absoluteToPath' path + SA.Name name -> pure . pure $ Path.fromName' name + SA.NameWithBranchPrefix mprefix name -> + pure . pure . Path.fromName' $ + either (const name) (Name.makeAbsolute . flip Path.prefixName name) mprefix + SA.Namespace hash -> pure . Left $ SCH.fromHash schLength hash otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg ) @@ -326,17 +375,16 @@ handleBranchIdOrProjectArg = . branchIdOrProject ) ( \case - (_, SA.Namespace hash) -> - pure . This . Left $ SCH.fromHash schLength hash - (_, SA.AbsolutePath path) -> + SA.Namespace hash -> pure . This . Left $ SCH.fromHash schLength hash + SA.AbsolutePath path -> pure . This . pure $ Path.absoluteToPath' path - (_, SA.Name name) -> pure . This . pure $ Path.fromName' name - (_, SA.NameWithBranchPrefix (Left _) name) -> + SA.Name name -> pure . This . pure $ Path.fromName' name + SA.NameWithBranchPrefix (Left _) name -> pure . This . pure $ Path.fromName' name - (_, SA.NameWithBranchPrefix (Right prefix) name) -> + SA.NameWithBranchPrefix (Right prefix) name -> pure . This . pure . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name - (_, SA.ProjectBranch pb) -> pure $ pure pb + SA.ProjectBranch pb -> pure $ pure pb otherArgType -> Left $ wrongStructuredArgument "a branch" otherArgType ) where @@ -364,16 +412,16 @@ handleBranchId2Arg = either Input.parseBranchId2 ( \case - (_, SA.Namespace hash) -> pure . Left $ SCH.fromHash schLength hash - (_, SA.AbsolutePath path) -> + SA.Namespace hash -> pure . Left $ SCH.fromHash schLength hash + SA.AbsolutePath path -> pure . pure . LoosePath $ Path.absoluteToPath' path - (_, SA.Name name) -> pure . pure . LoosePath $ Path.fromName' name - (_, SA.NameWithBranchPrefix (Left _) name) -> + SA.Name name -> pure . pure . LoosePath $ Path.fromName' name + SA.NameWithBranchPrefix (Left _) name -> pure . pure . LoosePath $ Path.fromName' name - (_, SA.NameWithBranchPrefix (Right prefix) name) -> + SA.NameWithBranchPrefix (Right prefix) name -> pure . pure . LoosePath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name - (_, SA.ProjectBranch (ProjectAndBranch mproject branch)) -> + SA.ProjectBranch (ProjectAndBranch mproject branch) -> pure . pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject otherNumArg -> @@ -386,14 +434,14 @@ handleBranchRelativePathArg = either parseBranchRelativePath ( \case - (_, SA.AbsolutePath path) -> pure . LoosePath $ Path.absoluteToPath' path - (_, SA.Name name) -> pure . LoosePath $ Path.fromName' name - (_, SA.NameWithBranchPrefix (Left _) name) -> + SA.AbsolutePath path -> pure . LoosePath $ Path.absoluteToPath' path + SA.Name name -> pure . LoosePath $ Path.fromName' name + SA.NameWithBranchPrefix (Left _) name -> pure . LoosePath $ Path.fromName' name - (_, SA.NameWithBranchPrefix (Right prefix) name) -> + SA.NameWithBranchPrefix (Right prefix) name -> pure . LoosePath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name - (_, SA.ProjectBranch (ProjectAndBranch mproject branch)) -> + SA.ProjectBranch (ProjectAndBranch mproject branch) -> pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject otherNumArg -> @@ -427,11 +475,11 @@ handleHashQualifiedSplit'Arg = either Path.parseHQSplit' ( \case - (_, SA.HashQualified name) -> hqNameToSplit' name - (_, SA.HashQualifiedWithBranchPrefix (Left _) hqname) -> pure $ hq'NameToSplit' hqname - (_, SA.HashQualifiedWithBranchPrefix (Right prefix) hqname) -> + SA.HashQualified name -> hqNameToSplit' name + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit' hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . hq'NameToSplit' $ Name.makeAbsolute . Path.prefixName prefix <$> hqname - (_, SA.SearchResult mpath result) -> hqNameToSplit' $ searchResultToHQ mpath result + SA.SearchResult mpath result -> hqNameToSplit' $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg ) @@ -440,11 +488,11 @@ handleHashQualifiedSplitArg = either Path.parseHQSplit ( \case - (_, SA.HashQualified name) -> hqNameToSplit name - (_, SA.HashQualifiedWithBranchPrefix (Left _) hqname) -> pure $ hq'NameToSplit hqname - (_, SA.HashQualifiedWithBranchPrefix (Right prefix) hqname) -> + SA.HashQualified name -> hqNameToSplit name + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . hq'NameToSplit $ Name.makeAbsolute . Path.prefixName prefix <$> hqname - (_, SA.SearchResult mpath result) -> hqNameToSplit $ searchResultToHQ mpath result + SA.SearchResult mpath result -> hqNameToSplit $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg ) @@ -453,7 +501,7 @@ handleShortCausalHashArg = either (first Text.pack . Input.parseShortCausalHash) ( \case - (_, SA.Namespace hash) -> pure $ SCH.fromHash schLength hash + SA.Namespace hash -> pure $ SCH.fromHash schLength hash otherNumArg -> Left $ wrongStructuredArgument "a causal hash" otherNumArg ) @@ -463,12 +511,12 @@ handleShortHashOrHQSplit'Arg = either Path.parseShortHashOrHQSplit' ( \case - (_, SA.Ref ref) -> pure $ Left $ Reference.toShortHash ref - (_, SA.HashQualified name) -> pure <$> hqNameToSplit' name - (_, SA.HashQualifiedWithBranchPrefix (Left _) hqname) -> pure . pure $ hq'NameToSplit' hqname - (_, SA.HashQualifiedWithBranchPrefix (Right prefix) hqname) -> + SA.Ref ref -> pure $ Left $ Reference.toShortHash ref + SA.HashQualified name -> pure <$> hqNameToSplit' name + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure . pure $ hq'NameToSplit' hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . pure $ hq'NameToSplit' (Name.makeAbsolute . Path.prefixName prefix <$> hqname) - (_, SA.SearchResult mpath result) -> + SA.SearchResult mpath result -> fmap pure . hqNameToSplit' $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a hash or name" otherNumArg ) @@ -486,16 +534,16 @@ handleNameArg = either (Name.parseTextEither . Text.pack) ( \case - (_, SA.Name name) -> pure name - (_, SA.NameWithBranchPrefix (Left _) name) -> pure name - (_, SA.NameWithBranchPrefix (Right prefix) name) -> + SA.Name name -> pure name + SA.NameWithBranchPrefix (Left _) name -> pure name + SA.NameWithBranchPrefix (Right prefix) name -> pure . Name.makeAbsolute $ Path.prefixName prefix name - (_, SA.HashQualified hqname) -> + SA.HashQualified hqname -> maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname - (_, SA.HashQualifiedWithBranchPrefix (Left _) hqname) -> pure $ HQ'.toName hqname - (_, SA.HashQualifiedWithBranchPrefix (Right prefix) hqname) -> + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . Name.makeAbsolute . Path.prefixName prefix $ HQ'.toName hqname - (_, SA.SearchResult mpath result) -> + SA.SearchResult mpath result -> maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result @@ -511,9 +559,9 @@ handlePullSourceArg = either (maybe (Left "not a pull source") pure . parsePullSource . Text.pack) ( \case - (_, SA.Project project) -> + SA.Project project -> pure . RemoteRepo.ReadShare'ProjectBranch $ This project - (_, SA.ProjectBranch (ProjectAndBranch project branch)) -> + SA.ProjectBranch (ProjectAndBranch project branch) -> pure . RemoteRepo.ReadShare'ProjectBranch . maybe That These project $ ProjectBranchNameOrLatestRelease'Name branch otherNumArg -> @@ -530,8 +578,8 @@ handlePushTargetArg = ) ( fmap RemoteRepo.WriteRemoteProjectBranch . \case - (_, SA.Project project) -> pure $ This project - (_, SA.ProjectBranch (ProjectAndBranch project branch)) -> + SA.Project project -> pure $ This project + SA.ProjectBranch (ProjectAndBranch project branch) -> pure $ maybe That These project branch otherNumArg -> Left $ wrongStructuredArgument "a source to push from" otherNumArg @@ -544,15 +592,15 @@ handlePushSourceArg = . parsePushSource ) ( \case - (_, SA.AbsolutePath path) -> pure . Input.PathySource $ Path.absoluteToPath' path - (_, SA.Name name) -> pure . Input.PathySource $ Path.fromName' name - (_, SA.NameWithBranchPrefix (Left _) name) -> + SA.AbsolutePath path -> pure . Input.PathySource $ Path.absoluteToPath' path + SA.Name name -> pure . Input.PathySource $ Path.fromName' name + SA.NameWithBranchPrefix (Left _) name -> pure . Input.PathySource $ Path.fromName' name - (_, SA.NameWithBranchPrefix (Right prefix) name) -> + SA.NameWithBranchPrefix (Right prefix) name -> pure . Input.PathySource . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name - (_, SA.Project project) -> pure . Input.ProjySource $ This project - (_, SA.ProjectBranch (ProjectAndBranch project branch)) -> + SA.Project project -> pure . Input.ProjySource $ This project + SA.ProjectBranch (ProjectAndBranch project branch) -> pure . Input.ProjySource . maybe That These project $ branch otherNumArg -> Left $ wrongStructuredArgument "a source to push from" otherNumArg @@ -566,8 +614,8 @@ handleProjectAndBranchNamesArg = . Text.pack ) ( fmap ProjectAndBranchNames'Unambiguous . \case - (_, SA.Project project) -> pure $ This project - (_, SA.ProjectBranch (ProjectAndBranch mproj branch)) -> + SA.Project project -> pure $ This project + SA.ProjectBranch (ProjectAndBranch mproj branch) -> pure $ maybe That These mproj branch otherNumArg -> Left $ wrongStructuredArgument "a project or branch" otherNumArg @@ -2950,8 +2998,9 @@ execute = ) $ \case main : args -> - Input.ExecuteI (Text.pack $ unifyArgument main) - <$> traverse (unsupportedStructuredArgument "a command-line argument") args + Input.ExecuteI + <$> handleHashQualifiedNameArg main + <*> traverse (unsupportedStructuredArgument "a command-line argument") args _ -> Left $ showPatternHelp execute saveExecuteResult :: InputPattern @@ -3041,8 +3090,9 @@ runScheme = ) $ \case main : args -> - Input.ExecuteSchemeI (Text.pack $ unifyArgument main) - <$> traverse (unsupportedStructuredArgument "a command-line argument") args + Input.ExecuteSchemeI + <$> handleHashQualifiedNameArg main + <*> traverse (unsupportedStructuredArgument "a command-line argument") args _ -> Left $ showPatternHelp runScheme compileScheme :: InputPattern diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index af5b1fa1c5..0d9fe8e7c7 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -5,7 +5,6 @@ module Unison.CommandLine.OutputMessages where -import Control.Arrow ((&&&)) import Control.Lens hiding (at) import Control.Monad.State import Control.Monad.State.Strict qualified as State @@ -130,7 +129,6 @@ import Unison.Server.Backend qualified as Backend import Unison.Server.SearchResult' qualified as SR' import Unison.Share.Sync qualified as Share import Unison.Share.Sync.Types (CodeserverTransportError (..)) -import Unison.ShortHash qualified as ShortHash import Unison.Sync.Types qualified as Share import Unison.Syntax.DeclPrinter qualified as DeclPrinter import Unison.Syntax.HashQualified qualified as HQ (toText, unsafeFromVar) @@ -351,7 +349,7 @@ notifyNumbered = \case ] branchHashes :: [CausalHash] branchHashes = (fst <$> reversedHistory) <> tailHashes - in (msg, (displayBranchHash &&& SA.Namespace) <$> branchHashes) + in (msg, SA.Namespace <$> branchHashes) where toSCH :: CausalHash -> ShortCausalHash toSCH h = SCH.fromHash schLength h @@ -410,7 +408,7 @@ notifyNumbered = \case ListEdits patch ppe -> showListEdits patch ppe ListProjects projects -> ( P.numberedList (map (prettyProjectName . view #name) projects), - map ((into @Text &&& SA.Project) . view #name) projects + map (SA.Project . view #name) projects ) ListBranches projectName branches -> ( P.columnNHeader @@ -427,11 +425,7 @@ notifyNumbered = \case : map (\branch -> ["", "", prettyRemoteBranchInfo branch]) remoteBranches ), map - ( ( (into @Text . ProjectAndBranch projectName) - &&& (SA.ProjectBranch . ProjectAndBranch (pure projectName)) - ) - . fst - ) + (SA.ProjectBranch . ProjectAndBranch (pure projectName) . fst) branches ) AmbiguousSwitch project (ProjectAndBranch currentProject branch) -> @@ -457,11 +451,9 @@ notifyNumbered = \case <> switch ["2"] <> " to pick one of these." ), - [ (Text.cons '/' . into @Text &&& SA.ProjectBranch . ProjectAndBranch Nothing) branch, - ( (into @Text . ProjectAndBranch project) - &&& (SA.ProjectBranch . ProjectAndBranch (pure project)) - ) - $ UnsafeProjectBranchName "main" + [ SA.ProjectBranch $ ProjectAndBranch Nothing branch, + SA.ProjectBranch . ProjectAndBranch (pure project) $ + UnsafeProjectBranchName "main" ] ) where @@ -490,8 +482,8 @@ notifyNumbered = \case <> reset (resetArgs ["2"]) <> " to pick one of these." ), - [ (Text.cons '/' . into @Text &&& SA.ProjectBranch . ProjectAndBranch Nothing) branch, - (into @Text . show &&& SA.AbsolutePath) absPath0 + [ SA.ProjectBranch $ ProjectAndBranch Nothing branch, + SA.AbsolutePath absPath0 ] ) where @@ -533,7 +525,7 @@ notifyNumbered = \case ) (1, (mempty, mempty)) & snd - & over (_2 . mapped) (Name.toText &&& SA.Name) + & over (_2 . mapped) SA.Name externalDepsTable :: Map LabeledDependency (Set Name) -> [(P.Pretty P.ColorText, P.Pretty P.ColorText)] externalDepsTable = ifoldMap $ \ld dependents -> [(prettyLD ld, prettyDependents dependents)] @@ -613,7 +605,7 @@ showListEdits patch ppe = let lhsTermName = PPE.termName ppe (Referent.Ref lhsRef) -- We use the shortHash of the lhs rather than its name for numbered args, -- since its name is likely to be "historical", and won't work if passed to a ucm command. - let lhsHash = (ShortHash.toText . Reference.toShortHash &&& SA.Ref) $ lhsRef + let lhsHash = SA.Ref lhsRef case termEdit of TermEdit.Deprecate -> do lift $ tell ([lhsHash], []) @@ -624,7 +616,7 @@ showListEdits patch ppe = TermEdit.Replace rhsRef _typing -> do n2 <- gets snd <* modify (second succ) let rhsTermName = PPE.termName ppe (Referent.Ref rhsRef) - lift $ tell ([lhsHash], [(HQ.toText &&& SA.HashQualified) rhsTermName]) + lift $ tell ([lhsHash], [SA.HashQualified rhsTermName]) pure ( showNum n1 <> (P.syntaxToColor . prettyHashQualified $ lhsTermName), "-> " <> showNum n2 <> (P.syntaxToColor . prettyHashQualified $ rhsTermName) @@ -638,7 +630,7 @@ showListEdits patch ppe = let lhsTypeName = PPE.typeName ppe lhsRef -- We use the shortHash of the lhs rather than its name for numbered args, -- since its name is likely to be "historical", and won't work if passed to a ucm command. - let lhsHash = (ShortHash.toText . Reference.toShortHash &&& SA.Ref) $ lhsRef + let lhsHash = SA.Ref lhsRef case typeEdit of TypeEdit.Deprecate -> do lift $ tell ([lhsHash], []) @@ -649,7 +641,7 @@ showListEdits patch ppe = TypeEdit.Replace rhsRef -> do n2 <- gets snd <* modify (second succ) let rhsTypeName = PPE.typeName ppe rhsRef - lift $ tell ([lhsHash], [(HQ.toText &&& SA.HashQualified) rhsTypeName]) + lift $ tell ([lhsHash], [SA.HashQualified rhsTypeName]) pure ( showNum n1 <> (P.syntaxToColor . prettyHashQualified $ lhsTypeName), "-> " <> showNum n2 <> (P.syntaxToColor . prettyHashQualified $ rhsTypeName) @@ -1663,7 +1655,7 @@ notifyUser dir = \case prettyNamespaceKey dest <> "is already up-to-date with" <> P.group (prettyNamespaceKey src <> ".") - DumpNumberedArgs args -> pure . P.numberedList $ fmap (P.text . fst) args + DumpNumberedArgs args -> pure . P.numberedList $ fmap (P.text . IP.formatStructuredArgument) args NoConflictsOrEdits -> pure (P.okCallout "No conflicts or edits in progress.") HelpMessage pat -> pure $ IP.showPatternHelp pat @@ -2729,7 +2721,7 @@ renderNameConflicts ppe conflictedNames = do P.lines <$> do for (Map.toList conflictedNames) $ \(name, hashes) -> do prettyConflicts <- for hashes \hash -> do - n <- addNumberedArg $ (HQ.toText &&& SA.HashQualified) hash + n <- addNumberedArg $ SA.HashQualified hash pure $ formatNum n <> (P.blue . P.syntaxToColor . prettyHashQualified $ hash) pure . P.wrap $ ( "The " @@ -2761,7 +2753,7 @@ renderEditConflicts ppe Patch {..} = do <> (fmap Right . Map.toList . R.toMultimap . R.filterManyDom $ _termEdits) numberedHQName :: HQ.HashQualified Name -> Numbered Pretty numberedHQName hqName = do - n <- addNumberedArg $ (HQ.toText &&& SA.HashQualified) hqName + n <- addNumberedArg $ SA.HashQualified hqName pure $ formatNum n <> styleHashQualified P.bold hqName formatTypeEdits :: (Reference, Set TypeEdit.TypeEdit) -> @@ -2800,9 +2792,9 @@ renderEditConflicts ppe Patch {..} = do Numbered Pretty formatConflict = either formatTypeEdits formatTermEdits -type Numbered = State.State (Int, Seq.Seq (Text, StructuredArgument)) +type Numbered = State.State (Int, Seq.Seq StructuredArgument) -addNumberedArg :: (Text, StructuredArgument) -> Numbered Int +addNumberedArg :: StructuredArgument -> Numbered Int addNumberedArg s = do (n, args) <- State.get State.put (n + 1, args Seq.|> s) @@ -2874,11 +2866,11 @@ todoOutput ppe todo = runNumbered do todoEdits :: Numbered Pretty todoEdits = do numberedTypes <- for (unscore <$> dirtyTypes) \(ref, displayObj) -> do - n <- addNumberedArg . (HQ.toText &&& SA.HashQualified) $ PPE.typeName ppeu ref + n <- addNumberedArg . SA.HashQualified $ PPE.typeName ppeu ref pure $ formatNum n <> prettyDeclPair ppeu (ref, displayObj) let filteredTerms = goodTerms (unscore <$> dirtyTerms) termNumbers <- for filteredTerms \(ref, _, _) -> do - n <- addNumberedArg . (HQ.toText &&& SA.HashQualified) $ PPE.termName ppeu ref + n <- addNumberedArg . SA.HashQualified $ PPE.termName ppeu ref pure $ formatNum n let formattedTerms = TypePrinter.prettySignaturesCT ppes filteredTerms numberedTerms = zipWith (<>) termNumbers formattedTerms @@ -3283,21 +3275,13 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} = -- DeclPrinter.prettyDeclHeader : HQ -> Either numPatch :: Input.AbsBranchId -> Name -> Numbered Pretty numPatch prefix name = - addNumberedArg' $ (prefixBranchId prefix &&& SA.NameWithBranchPrefix prefix) name + addNumberedArg' $ SA.NameWithBranchPrefix prefix name numHQ' :: Input.AbsBranchId -> HQ'.HashQualified Name -> Referent -> Numbered Pretty numHQ' prefix hq r = - addNumberedArg' . (HQ'.toTextWith (prefixBranchId prefix) &&& SA.HashQualifiedWithBranchPrefix prefix) $ HQ'.requalify hq r - - -- E.g. - -- prefixBranchId "#abcdef" "base.List.map" -> "#abcdef:.base.List.map" - -- prefixBranchId ".base" "List.map" -> ".base.List.map" - prefixBranchId :: Input.AbsBranchId -> Name -> Text - prefixBranchId branchId name = case branchId of - Left sch -> "#" <> SCH.toText sch <> ":" <> Name.toText (Name.makeAbsolute name) - Right pathPrefix -> Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name) + addNumberedArg' . SA.HashQualifiedWithBranchPrefix prefix $ HQ'.requalify hq r - addNumberedArg' :: (Text, StructuredArgument) -> Numbered Pretty + addNumberedArg' :: StructuredArgument -> Numbered Pretty addNumberedArg' s = case sn of ShowNumbers -> do n <- addNumberedArg s @@ -3552,7 +3536,7 @@ numberedArgsForEndangerments (PPED.unsuffixifiedPPE -> ppe) m = m & Map.elems & concatMap toList - & fmap ((HQ.toText &&& SA.HashQualified) . PPE.labeledRefName ppe) + & fmap (SA.HashQualified . PPE.labeledRefName ppe) -- | Format and render all dependents which are endangered by references going extinct. endangeredDependentsTable :: From ff785cb8a5e304fb6ce784ceb97ec886c96e0534 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 22 May 2024 23:46:31 -0600 Subject: [PATCH 019/631] Allow structured args in `find` commands --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 91bf1960f2..97c41767f5 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1355,7 +1355,7 @@ find' cmd fscope = I.Visible [("query", ZeroPlus, exactDefinitionArg)] findHelp - (fmap (Input.FindI False fscope) . traverse (unsupportedStructuredArgument "text")) + (pure . Input.FindI False fscope . fmap unifyArgument) findShallow :: InputPattern findShallow = From 510e9dc6bb944105189ad70bcfadfa8a34b027fa Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 23 May 2024 08:26:52 -0400 Subject: [PATCH 020/631] don't update in upgrade --- .../src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs | 5 ----- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 5 +---- unison-src/transcripts/upgrade-sad-path.md | 1 + unison-src/transcripts/upgrade-sad-path.output.md | 4 +++- 4 files changed, 5 insertions(+), 10 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs index 901dada1e4..76229b8bfd 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs @@ -12,7 +12,6 @@ import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Editor.HandleInput.DeleteBranch qualified as DeleteBranch import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge import Unison.Codebase.Editor.HandleInput.ProjectSwitch qualified as ProjectSwitch -import Unison.Codebase.Editor.HandleInput.Update2 qualified as Update import Unison.Codebase.Editor.Output qualified as Output import Unison.Merge.TwoWay (TwoWay (..)) import Unison.Prelude @@ -34,10 +33,6 @@ handleCommitUpgrade = do let parentProjectAndBranch = ProjectAndBranch upgradeProjectAndBranch.project parentBranch - -- Run `update` - - Update.handleUpdate2 - -- Switch to the parent ProjectSwitch.switchToProjectBranch (ProjectUtils.justTheIds parentProjectAndBranch) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 18e6e8768f..d5e3918aa3 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1188,8 +1188,6 @@ notifyUser dir = \case LoadingFile sourceName -> do fileName <- renderFileName $ Text.unpack sourceName pure $ P.wrap $ "Loading changes detected in " <> P.group (fileName <> ".") - -- TODO: Present conflicting TermEdits and TypeEdits - -- if we ever allow users to edit hashes directly. Typechecked sourceName ppe slurpResult uf -> do let fileStatusMsg = SlurpResult.pretty False ppe slurpResult let containsWatchExpressions = notNull $ UF.watchComponents uf @@ -1222,8 +1220,7 @@ notifyUser dir = \case <> IP.makeExample' IP.add <> " or " <> P.group (IP.makeExample' IP.update <> ",") - <> "here's how your codebase would" - <> "change:", + <> "here's how your codebase would change:", P.indentN 2 $ SlurpResult.pretty False ppe slurpResult ] ] diff --git a/unison-src/transcripts/upgrade-sad-path.md b/unison-src/transcripts/upgrade-sad-path.md index e0e87f2187..ccf51fd605 100644 --- a/unison-src/transcripts/upgrade-sad-path.md +++ b/unison-src/transcripts/upgrade-sad-path.md @@ -24,6 +24,7 @@ thingy = foo + +10 ``` ```ucm +proj/upgrade-old-to-new> update proj/upgrade-old-to-new> upgrade.commit proj/main> view thingy proj/main> ls lib diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md index 627a245966..e4ed5187b5 100644 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ b/unison-src/transcripts/upgrade-sad-path.output.md @@ -65,13 +65,15 @@ thingy = foo + +10 ``` ```ucm -proj/upgrade-old-to-new> upgrade.commit +proj/upgrade-old-to-new> update Okay, I'm searching the branch for code that needs to be updated... Done. +proj/upgrade-old-to-new> upgrade.commit + I fast-forward merged proj/upgrade-old-to-new into proj/main. proj/main> view thingy From 2b504190fcaaf99cb2ccc36b1e16f7f48ab39ea1 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 22 May 2024 10:08:05 -0700 Subject: [PATCH 021/631] Rewrite BranchRelativePaths machinery --- other-thing.md | 6 + other-thing.output.md | 23 ++++ parser-typechecker/src/Unison/Codebase.hs | 11 ++ .../src/Unison/Codebase/ProjectPath.hs | 10 ++ unison-cli/src/Unison/Cli/Monad.hs | 15 ++- unison-cli/src/Unison/Cli/Pretty.hs | 11 -- unison-cli/src/Unison/Cli/ProjectUtils.hs | 126 +++++------------- .../Codebase/Editor/HandleInput/Branch.hs | 73 ++++------ .../Codebase/Editor/HandleInput/MoveBranch.hs | 2 +- .../HandleInput/NamespaceDependencies.hs | 2 +- .../Editor/HandleInput/ProjectSwitch.hs | 16 +-- .../Codebase/Editor/HandleInput/Update2.hs | 2 +- .../src/Unison/Codebase/Editor/Input.hs | 19 ++- .../Unison/CommandLine/BranchRelativePath.hs | 105 +++++++-------- .../src/Unison/CommandLine/Completion.hs | 9 +- .../src/Unison/Server/CodebaseServer.hs | 28 ++-- 16 files changed, 200 insertions(+), 258 deletions(-) create mode 100644 other-thing.md create mode 100644 other-thing.output.md diff --git a/other-thing.md b/other-thing.md new file mode 100644 index 0000000000..81145901b3 --- /dev/null +++ b/other-thing.md @@ -0,0 +1,6 @@ +```ucm +.> clone @unison/cloud +@unison/cloud/main> reset #t30tkb0hj1 +@unison/cloud/main> branch bug +@unison/cloud/bug> delete.namespace lib.httpserver_4_1_0 +``` diff --git a/other-thing.output.md b/other-thing.output.md new file mode 100644 index 0000000000..49918f21f5 --- /dev/null +++ b/other-thing.output.md @@ -0,0 +1,23 @@ +```ucm +.> clone @unison/cloud + + Downloaded 92354 entities. + + Cloned @unison/cloud/main. + +@unison/cloud/main> reset #t30tkb0hj1 + + Done. + +@unison/cloud/main> branch bug + + Done. I've created the bug branch based off of main. + + Tip: Use `merge /bug /main` to merge your work back into the + main branch. + +@unison/cloud/bug> delete.namespace lib.httpserver_4_1_0 + + Done. + +``` diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 6e86831e01..db197aa5ed 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -114,6 +114,7 @@ module Unison.Codebase toCodeLookup, typeLookupForDependencies, unsafeGetComponentLength, + emptyCausalHash, ) where @@ -578,3 +579,13 @@ loadCurrentProjectPathCtx = do setCurrentProjectPath :: PP.ProjectPathIds -> Sqlite.Transaction () setCurrentProjectPath (PP.ProjectPath projectId projectBranchId path) = Q.setCurrentProjectPath projectId projectBranchId (Path.toList (Path.unabsolute path)) + +-- | Often we need to assign something to an empty causal, this ensures the empty causal +-- exists in the codebase and returns its hash. +emptyCausalHash :: Sqlite.Transaction (CausalHash, Db.CausalHashId) +emptyCausalHash = do + let emptyBranch = Branch.empty + SqliteCodebase.Operations.putBranch emptyBranch + let causalHash = Branch.headHash emptyBranch + causalHashId <- Queries.expectCausalHashIdByCausalHash causalHash + pure (causalHash, causalHashId) diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index 7fd5cfd669..4f6bbe30f2 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -3,6 +3,8 @@ module Unison.Codebase.ProjectPath ProjectPathIds, ProjectPathNames, ProjectPathCtx, + fromProjectAndBranch, + ctxFromProjectAndBranch, absPath_, path_, projectAndBranch_, @@ -18,6 +20,8 @@ import Control.Lens import Data.Bifoldable (Bifoldable (..)) import Data.Bitraversable (Bitraversable (..)) import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) +import U.Codebase.Sqlite.Project (Project (..)) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import Unison.Codebase.Path qualified as Path import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) @@ -35,6 +39,12 @@ type ProjectPathNames = ProjectPath ProjectName ProjectBranchName type ProjectPathCtx = ProjectPath (ProjectId, ProjectName) (ProjectBranchId, ProjectBranchName) +fromProjectAndBranch :: ProjectAndBranch proj branch -> Path.Absolute -> ProjectPath proj branch +fromProjectAndBranch (ProjectAndBranch proj branch) = ProjectPath proj branch + +ctxFromProjectAndBranch :: ProjectAndBranch Project ProjectBranch -> Path.Absolute -> ProjectPathCtx +ctxFromProjectAndBranch (ProjectAndBranch (Project {projectId, name = projectName}) (ProjectBranch {branchId, name = branchName})) = ProjectPath (projectId, projectName) (branchId, branchName) + project_ :: Lens' (ProjectPath p b) p project_ = lens go set where diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index 1db18cf12d..b6c137c3ce 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -34,6 +34,7 @@ module Unison.Cli.Monad -- * Changing the current directory cd, popd, + switchProject, -- * Communicating output to the user respond, @@ -67,6 +68,8 @@ import Data.Time.Clock.TAI (diffAbsoluteTime) import Data.Unique (Unique, newUnique) import System.CPUTime (getCPUTime) import Text.Printf (printf) +import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) +import U.Codebase.Sqlite.Queries qualified as Q import Unison.Auth.CredentialManager (CredentialManager) import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Codebase (Codebase) @@ -81,6 +84,7 @@ import Unison.Codebase.Runtime (Runtime) import Unison.Debug qualified as Debug import Unison.Parser.Ann (Ann) import Unison.Prelude +import Unison.Project (ProjectAndBranch (..)) import Unison.Server.CodebaseServer qualified as Server import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) @@ -379,7 +383,16 @@ getProjectPathIds = do cd :: Path.Absolute -> Cli () cd path = do pp <- getProjectPathIds - #projectPathStack %= NonEmpty.cons (pp & PP.absPath_ .~ path) + let newPP = pp & PP.absPath_ .~ path + setMostRecentProjectPath newPP + #projectPathStack %= NonEmpty.cons newPP + +switchProject :: ProjectAndBranch ProjectId ProjectBranchId -> Cli () +switchProject (ProjectAndBranch projectId branchId) = do + let newPP = PP.ProjectPath projectId branchId Path.absoluteEmpty + #projectPathStack %= NonEmpty.cons newPP + runTransaction $ Q.setMostRecentBranch projectId branchId + setMostRecentProjectPath newPP -- | Pop the latest path off the stack, if it's not the only path in the stack. -- diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index a149375543..c3a3ea88e2 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -5,7 +5,6 @@ module Unison.Cli.Pretty ( displayBranchHash, prettyAbsolute, - prettyAbsoluteStripProject, prettyBase32Hex#, prettyBase32Hex, prettyBranchId, @@ -73,7 +72,6 @@ import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Util.Base32Hex (Base32Hex) import U.Util.Base32Hex qualified as Base32Hex import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceOrTarget (..)) -import Unison.Cli.ProjectUtils (projectBranchPathPrism) import Unison.Cli.Share.Projects.Types qualified as Share import Unison.Codebase.Editor.DisplayObject (DisplayObject (BuiltinObject, MissingObject, UserObject)) import Unison.Codebase.Editor.Input qualified as Input @@ -410,15 +408,6 @@ prettyRemoteBranchInfo (host, remoteProject, remoteBranch) = <> " on " <> P.shown host -stripProjectBranchInfo :: Path.Absolute -> Maybe Path.Path -stripProjectBranchInfo = fmap snd . preview projectBranchPathPrism - -prettyAbsoluteStripProject :: Path.Absolute -> Pretty -prettyAbsoluteStripProject path = - P.blue case stripProjectBranchInfo path of - Just p -> P.shown p - Nothing -> P.shown path - prettyLabeledDependencies :: PPE.PrettyPrintEnv -> Set LabeledDependency -> Pretty prettyLabeledDependencies ppe lds = P.syntaxToColor (P.sep ", " (ld <$> toList lds)) diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index 9010be1c77..07a7e93a1f 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -1,21 +1,8 @@ -- | Project-related utilities. module Unison.Cli.ProjectUtils ( -- * Project/path helpers - getCurrentProject, - expectCurrentProject, - expectCurrentProjectIds, - getCurrentProjectIds, - getCurrentProjectBranch, - getProjectBranchForPath, - expectCurrentProjectBranch, expectProjectBranchByName, - projectPath, - projectBranchesPath, - projectBranchPath, - projectBranchSegment, - projectBranchPathPrism, resolveBranchRelativePath, - branchRelativePathToAbsolute, -- * Name hydration hydrateNames, @@ -43,6 +30,7 @@ module Unison.Cli.ProjectUtils where import Control.Lens +import Control.Monad.Trans.Maybe (mapMaybeT) import Data.List qualified as List import Data.Maybe (fromJust) import Data.Set qualified as Set @@ -61,48 +49,27 @@ import Unison.Codebase.Editor.Output (Output (LocalProjectBranchDoesntExist)) import Unison.Codebase.Editor.Output qualified as Output 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.Codebase.ProjectPath qualified as PP +import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..)) import Unison.Core.Project (ProjectBranchName (..)) import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectName) -import Unison.Project.Util import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite import Witch (unsafeFrom) -branchRelativePathToAbsolute :: BranchRelativePath -> Cli Path.Absolute -branchRelativePathToAbsolute brp = - resolveBranchRelativePath brp <&> \case - BranchRelativePath.ResolvedLoosePath p -> p - BranchRelativePath.ResolvedBranchRelative projectBranch mRel -> - let projectBranchIds = getIds projectBranch - handleRel = case mRel of - Nothing -> id - Just rel -> flip Path.resolve rel - in handleRel (projectBranchPath projectBranchIds) - where - getIds = \case - ProjectAndBranch project branch -> ProjectAndBranch (view #projectId project) (view #branchId branch) - -resolveBranchRelativePath :: BranchRelativePath -> Cli ResolvedBranchRelativePath -resolveBranchRelativePath = \case - BranchRelativePath.BranchRelative brp -> case brp of - This projectBranch -> do - projectBranch <- expectProjectAndBranchByTheseNames (toThese projectBranch) - pure (BranchRelativePath.ResolvedBranchRelative projectBranch Nothing) - That path -> do - (projectBranch, _) <- expectCurrentProjectBranch - pure (BranchRelativePath.ResolvedBranchRelative projectBranch (Just path)) - These projectBranch path -> do - projectBranch <- expectProjectAndBranchByTheseNames (toThese projectBranch) - pure (BranchRelativePath.ResolvedBranchRelative projectBranch (Just path)) - BranchRelativePath.LoosePath path -> - BranchRelativePath.ResolvedLoosePath <$> Cli.resolvePath' path - where - toThese = \case - Left branchName -> That branchName - Right (projectName, branchName) -> These projectName branchName +resolveBranchRelativePath :: BranchRelativePath -> Cli PP.ProjectPathCtx +resolveBranchRelativePath brp = do + case brp of + BranchPathInCurrentProject projBranchName path -> do + projectAndBranch <- expectProjectAndBranchByTheseNames (That projBranchName) + pure $ PP.ctxFromProjectAndBranch projectAndBranch path + QualifiedBranchPath projName projBranchName path -> do + projectAndBranch <- expectProjectAndBranchByTheseNames (These projName projBranchName) + pure $ PP.ctxFromProjectAndBranch projectAndBranch path + UnqualifiedPath newPath' -> do + ppCtx <- Cli.getProjectPathCtx + pure $ ppCtx & PP.absPath_ %~ \curPath -> Path.resolve curPath newPath' -- @findTemporaryBranchName projectId preferred@ finds some unused branch name in @projectId@ with a name -- like @preferred@. @@ -125,55 +92,22 @@ findTemporaryBranchName projectId preferred = do pure (fromJust (List.find (\name -> not (Set.member name allBranchNames)) allCandidates)) --- | Get the current project that a user is on. -getCurrentProject :: Cli (Maybe Sqlite.Project) -getCurrentProject = do - path <- Cli.getCurrentPath - case preview projectBranchPathPrism path of - Nothing -> pure Nothing - Just (ProjectAndBranch projectId _branchId, _restPath) -> - Cli.runTransaction do - project <- Queries.expectProject projectId - pure (Just project) - --- | Like 'getCurrentProject', but fails with a message if the user is not on a project branch. -expectCurrentProject :: Cli Sqlite.Project -expectCurrentProject = do - getCurrentProject & onNothingM (Cli.returnEarly Output.NotOnProjectBranch) - --- | Get the current project ids that a user is on. -getCurrentProjectIds :: Cli (Maybe (ProjectAndBranch ProjectId ProjectBranchId)) -getCurrentProjectIds = - fmap fst . preview projectBranchPathPrism <$> Cli.getCurrentPath - --- | Like 'getCurrentProjectIds', but fails with a message if the user is not on a project branch. -expectCurrentProjectIds :: Cli (ProjectAndBranch ProjectId ProjectBranchId) -expectCurrentProjectIds = - getCurrentProjectIds & onNothingM (Cli.returnEarly Output.NotOnProjectBranch) - -- | Get the current project+branch+branch path that a user is on. -getCurrentProjectBranch :: Cli (Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch, Path.Path)) -getCurrentProjectBranch = do - path <- Cli.getCurrentPath - getProjectBranchForPath path +getCurrentProjectBranch :: Cli (Maybe (PP.ProjectPath Sqlite.Project Sqlite.ProjectBranch)) +getCurrentProjectBranch = runMaybeT do + ppCtx <- lift Cli.getProjectPathCtx + mapMaybeT Cli.runTransaction $ do + proj <- MaybeT $ Queries.loadProject (ppCtx ^. PP.ctxAsIds_ . PP.project_) + branch <- MaybeT $ Queries.loadProjectBranch (proj ^. #projectId) (ppCtx ^. PP.ctxAsIds_ . PP.branch_) + pure $ PP.ProjectPath proj branch (ppCtx ^. PP.absPath_) expectProjectBranchByName :: Sqlite.Project -> ProjectBranchName -> Cli Sqlite.ProjectBranch expectProjectBranchByName project branchName = Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName) & onNothingM do Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch (project ^. #name) branchName)) -getProjectBranchForPath :: Path.Absolute -> Cli (Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch, Path.Path)) -getProjectBranchForPath path = do - case preview projectBranchPathPrism path of - Nothing -> pure Nothing - Just (ProjectAndBranch projectId branchId, restPath) -> - Cli.runTransaction do - project <- Queries.expectProject projectId - branch <- Queries.expectProjectBranch projectId branchId - pure (Just (ProjectAndBranch project branch, restPath)) - -- | Like 'getCurrentProjectBranch', but fails with a message if the user is not on a project branch. -expectCurrentProjectBranch :: Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch, Path.Path) +expectCurrentProjectBranch :: Cli (PP.ProjectPath Sqlite.Project Sqlite.ProjectBranch) expectCurrentProjectBranch = getCurrentProjectBranch & onNothingM (Cli.returnEarly Output.NotOnProjectBranch) @@ -187,8 +121,8 @@ hydrateNames :: These ProjectName ProjectBranchName -> Cli (ProjectAndBranch Pro hydrateNames = \case This projectName -> pure (ProjectAndBranch projectName (unsafeFrom @Text "main")) That branchName -> do - (ProjectAndBranch project _branch, _restPath) <- expectCurrentProjectBranch - pure (ProjectAndBranch (project ^. #name) branchName) + ppCtx <- Cli.getProjectPathCtx + pure (ProjectAndBranch (ppCtx ^. PP.ctxAsNames_ . PP.project_) branchName) These projectName branchName -> pure (ProjectAndBranch projectName branchName) -- Expect a local project+branch by ids. @@ -210,9 +144,9 @@ getProjectAndBranchByTheseNames :: getProjectAndBranchByTheseNames = \case This projectName -> getProjectAndBranchByTheseNames (These projectName (unsafeFrom @Text "main")) That branchName -> runMaybeT do - (ProjectAndBranch project _branch, _restPath) <- MaybeT getCurrentProjectBranch - branch <- MaybeT (Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName)) - pure (ProjectAndBranch project branch) + currentProjectBranch <- MaybeT getCurrentProjectBranch + branch <- MaybeT (Cli.runTransaction (Queries.loadProjectBranchByName (currentProjectBranch ^. PP.project_ . #projectId) branchName)) + pure (ProjectAndBranch (currentProjectBranch ^. PP.project_) branch) These projectName branchName -> do Cli.runTransaction do runMaybeT do @@ -230,7 +164,7 @@ expectProjectAndBranchByTheseNames :: expectProjectAndBranchByTheseNames = \case This projectName -> expectProjectAndBranchByTheseNames (These projectName (unsafeFrom @Text "main")) That branchName -> do - (ProjectAndBranch project _branch, _restPath) <- expectCurrentProjectBranch + PP.ProjectPath project _branch _restPath <- expectCurrentProjectBranch branch <- Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName) & onNothingM do Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch (project ^. #name) branchName)) @@ -347,7 +281,7 @@ expectRemoteProjectBranchByTheseNames includeSquashed = \case let remoteBranchName = unsafeFrom @Text "main" expectRemoteProjectBranchByName includeSquashed (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName) That branchName -> do - (ProjectAndBranch localProject localBranch, _restPath) <- expectCurrentProjectBranch + PP.ProjectPath localProject localBranch _restPath <- expectCurrentProjectBranch let localProjectId = localProject ^. #projectId let localBranchId = localBranch ^. #branchId Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 0137f0e3f4..3d1a0549e5 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -10,16 +10,18 @@ where import Control.Lens ((^.)) import Data.These (These (..)) import Data.UUID.V4 qualified as UUID +import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.DbId import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.MonadUtils qualified as Cli (getBranchFromProjectRootPath, getCurrentPath, updateAt) +import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch) -import Unison.Codebase.Branch qualified as Branch (empty) +import Unison.Codebase.Branch qualified as Branch (empty, headHash) import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path @@ -27,11 +29,6 @@ import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectBranchNameKind (..), ProjectName, classifyProjectBranchName) import Unison.Sqlite qualified as Sqlite -data CreateFrom - = CreateFrom'Branch (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) - | CreateFrom'LooseCode Path.Absolute - | CreateFrom'Nothingness - -- | Create a new project branch from an existing project branch or namespace. handleBranch :: Input.BranchSourceI -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleBranch sourceI projectAndBranchNames0 = do @@ -51,14 +48,21 @@ handleBranch sourceI projectAndBranchNames0 = do Cli.returnEarly (Output.CannotCreateReleaseBranchWithBranchCommand newBranchName ver) ProjectBranchNameKind'NothingSpecial -> pure () + srcProject <- + Cli.runTransactionWithRollback \rollback -> do + Queries.loadProjectByName projectName & onNothingM do + -- We can't make the *first* branch of a project with `branch`; the project has to already exist. + rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) + -- Compute what we should create the branch from. - createFrom <- + mayNewBranchCausalHash <- case sourceI of Input.BranchSourceI'CurrentContext -> - ProjectUtils.getCurrentProjectBranch >>= \case - Nothing -> CreateFrom'LooseCode <$> Cli.getCurrentPath - Just (currentBranch, _restPath) -> pure (CreateFrom'Branch currentBranch) - Input.BranchSourceI'Empty -> pure CreateFrom'Nothingness + Cli.getProjectRoot >>= \case + projectRoot -> do + pure Branch.headHash projectRoot + Input.BranchSourceI'Empty -> do + pure Nothing Input.BranchSourceI'LooseCodeOrProject (This sourcePath) -> do currentPath <- Cli.getCurrentPath pure (CreateFrom'LooseCode (Path.resolve currentPath sourcePath)) @@ -80,13 +84,7 @@ handleBranch sourceI projectAndBranchNames0 = do ProjectAndBranch Nothing b -> That b ProjectAndBranch (Just p) b -> These p b - project <- - Cli.runTransactionWithRollback \rollback -> do - Queries.loadProjectByName projectName & onNothingM do - -- We can't make the *first* branch of a project with `branch`; the project has to already exist. - rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) - - _ <- doCreateBranch createFrom project newBranchName ("branch " <> into @Text projectAndBranchNames) + _ <- doCreateBranch newBranchCausalHashId project newBranchName ("branch " <> into @Text projectAndBranchNames) Cli.respond $ Output.CreatedProjectBranch @@ -95,47 +93,27 @@ handleBranch sourceI projectAndBranchNames0 = do if sourceBranch ^. #project . #projectId == project ^. #projectId then Output.CreatedProjectBranchFrom'ParentBranch (sourceBranch ^. #branch . #name) else Output.CreatedProjectBranchFrom'OtherBranch sourceBranch - CreateFrom'LooseCode path -> Output.CreatedProjectBranchFrom'LooseCode path CreateFrom'Nothingness -> Output.CreatedProjectBranchFrom'Nothingness ) projectAndBranchNames -- | @doCreateBranch createFrom project branch description@: -- --- 1. Creates a new branch row for @branch@ in project @project@ (failing if @branch@ already exists in @project@) --- 2. Puts the branch contents from @createFrom@ in the root namespace., using @description@ for the reflog. --- 3. cds to the new branch in the root namespace. +-- 1. Creates a new branch row for @branch@ in project @project@ (failing if @branch@ already exists in @project@). +-- 3. Switches to the new branch. -- -- This bit of functionality is factored out from the main 'handleBranch' handler because it is also called by the -- @release.draft@ command, which essentially just creates a branch, but with some different output for the user. -- -- Returns the branch id of the newly-created branch. -doCreateBranch :: CreateFrom -> Sqlite.Project -> ProjectBranchName -> Text -> Cli ProjectBranchId -doCreateBranch createFrom project newBranchName description = do - sourceNamespaceObject <- - case createFrom of - CreateFrom'Branch (ProjectAndBranch _ sourceBranch) -> do - let sourceProjectId = sourceBranch ^. #projectId - let sourceBranchId = sourceBranch ^. #branchId - Cli.getBranchFromProjectRootPath (ProjectUtils.projectBranchPath (ProjectAndBranch sourceProjectId sourceBranchId)) - CreateFrom'LooseCode sourcePath -> Cli.getBranchAt sourcePath - CreateFrom'Nothingness -> pure Branch.empty - let projectId = project ^. #projectId - let parentBranchId = - case createFrom of - CreateFrom'Branch (ProjectAndBranch _ sourceBranch) - | (sourceBranch ^. #projectId) == projectId -> Just (sourceBranch ^. #branchId) - _ -> Nothing - doCreateBranch' sourceNamespaceObject parentBranchId project (pure newBranchName) description - -doCreateBranch' :: - Branch IO -> +doCreateBranch :: + CausalHashId -> Maybe ProjectBranchId -> Sqlite.Project -> Sqlite.Transaction ProjectBranchName -> Text -> Cli ProjectBranchId -doCreateBranch' sourceNamespaceObject parentBranchId project getNewBranchName description = do +doCreateBranch newBranchCausalId parentBranchId project getNewBranchName description = do let projectId = project ^. #projectId newBranchId <- Cli.runTransactionWithRollback \rollback -> do @@ -152,12 +130,11 @@ doCreateBranch' sourceNamespaceObject parentBranchId project getNewBranchName de branchId = newBranchId, name = newBranchName, parentBranchId = parentBranchId, - rootCausalHash = error "TODO: implement doCreateBranch" + causalHashId = newBranchCausalId } Queries.setMostRecentBranch projectId newBranchId pure newBranchId - let newBranchPath = ProjectUtils.projectBranchPath (ProjectAndBranch projectId newBranchId) - _ <- Cli.updateAt description newBranchPath (const sourceNamespaceObject) - Cli.cd newBranchPath + -- TODO: Switch to new branch + Cli.switch newBranchPath pure newBranchId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs index 21b41511b0..ad34073506 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs @@ -17,7 +17,7 @@ moveBranchFunc hasConfirmed src' dest' = do let isRootMove = (Path.isRoot srcAbs || Path.isRoot destAbs) when (isRootMove && not hasConfirmed) do Cli.returnEarly MoveRootBranchConfirmation - Cli.getMaybeBranchAt srcAbs >>= traverse \srcBranch -> do + Cli.getMaybeBranchFromProjectRootPath srcAbs >>= traverse \srcBranch -> do -- We want the move to appear as a single step in the root namespace, but we need to make -- surgical changes in both the root and the destination, so we make our modifications at the shared parent of -- those changes such that they appear as a single change in the root. diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs index 88b75a289b..f46245e9ef 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs @@ -38,7 +38,7 @@ handleNamespaceDependencies namespacePath' = do Cli.Env {codebase} <- ask path <- maybe Cli.getCurrentPath Cli.resolvePath' namespacePath' branch <- - Cli.getMaybeBranch0At path & onNothingM do + Cli.getMaybeBranch0FromProjectRootPath path & onNothingM do Cli.returnEarly (Output.BranchEmpty (Output.WhichBranchEmptyPath (Path.absoluteToPath' path))) externalDependencies <- Cli.runTransaction (namespaceDependencies codebase branch) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs index 87329e00d4..d1ec6cc978 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs @@ -60,10 +60,8 @@ switchToProjectAndBranchByTheseNames projectAndBranchNames0 = do Queries.loadMostRecentBranch (project ^. #projectId) >>= \case Nothing -> do let branchName = unsafeFrom @Text "main" - branch <- - Queries.loadProjectBranchByName (project ^. #projectId) branchName & onNothingM do + Queries.loadProjectBranchByName (project ^. #projectId) branchName & onNothingM do rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName)) - setMostRecentBranch branch Just branchId -> Queries.loadProjectBranch (project ^. #projectId) branchId >>= \case Nothing -> error "impossible" @@ -71,12 +69,6 @@ switchToProjectAndBranchByTheseNames projectAndBranchNames0 = do _ -> do projectAndBranchNames@(ProjectAndBranch projectName branchName) <- ProjectUtils.hydrateNames projectAndBranchNames0 Cli.runTransactionWithRollback \rollback -> do - branch <- - Queries.loadProjectBranchByNames projectName branchName & onNothingM do - rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) - setMostRecentBranch branch - Cli.cd (ProjectUtils.projectBranchPath (ProjectAndBranch (branch ^. #projectId) (branch ^. #branchId))) - where - setMostRecentBranch branch = do - Queries.setMostRecentBranch (branch ^. #projectId) (branch ^. #branchId) - pure branch + Queries.loadProjectBranchByNames projectName branchName & onNothingM do + rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) + Cli.switchProject (ProjectAndBranch (branch ^. #projectId) (branch ^. #branchId) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 72ed90dacd..de4e39c473 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -108,7 +108,7 @@ handleUpdate2 = do tuf <- Cli.expectLatestTypecheckedFile let termAndDeclNames = getTermAndDeclNames tuf currentPath <- Cli.getCurrentPath - currentBranch0 <- Cli.getBranch0At currentPath + currentBranch0 <- Cli.getCurrentBranch0 let namesIncludingLibdeps = Branch.toNames currentBranch0 let namesExcludingLibdeps = Branch.toNames (currentBranch0 & over Branch.children (Map.delete NameSegment.libSegment)) let ctorNames = forwardCtorNames namesExcludingLibdeps diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 8c18fd047b..4fc5a75239 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -13,7 +13,7 @@ module Unison.Codebase.Editor.Input PatchPath, BranchId, AbsBranchId, - LooseCodeOrProject, + UnresolvedProjectBranch, parseBranchId, parseBranchId2, parseShortCausalHash, @@ -64,11 +64,8 @@ data OptionalPatch = NoPatch | DefaultPatch | UsePatch PatchPath type BranchId = Either ShortCausalHash Path' --- | A lot of commands can take either a loose code path or a project branch in the same argument slot. Usually, those --- have distinct syntaxes, but sometimes it's ambiguous, in which case we'd parse a `These`. The command itself can --- decide what to do with the ambiguity. -type LooseCodeOrProject = - These Path' (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) +-- | An unambiguous project branch name, use the current project name if not provided. +type UnresolvedProjectBranch = ProjectAndBranch (Maybe ProjectName) ProjectBranchName type AbsBranchId = Either ShortCausalHash Path.Absolute @@ -108,8 +105,8 @@ data Input -- clone w/o merge, error if would clobber ForkLocalBranchI (Either ShortCausalHash BranchRelativePath) BranchRelativePath | -- merge first causal into destination - MergeLocalBranchI LooseCodeOrProject LooseCodeOrProject Branch.MergeMode - | PreviewMergeLocalBranchI LooseCodeOrProject LooseCodeOrProject + MergeLocalBranchI UnresolvedProjectBranch UnresolvedProjectBranch Branch.MergeMode + | PreviewMergeLocalBranchI UnresolvedProjectBranch UnresolvedProjectBranch | DiffNamespaceI BranchId BranchId -- old new | PullI !PullSourceTarget !PullMode | PushRemoteBranchI PushRemoteBranchInput @@ -119,7 +116,7 @@ data Input (Either ShortCausalHash Path') (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) ) - (Maybe LooseCodeOrProject) + (Maybe UnresolvedProjectBranch) | -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? -- Does it make sense to fork from not-the-root of a Github repo? -- used in Welcome module to give directions to user @@ -248,8 +245,8 @@ data BranchSourceI BranchSourceI'CurrentContext | -- | Create an empty branch BranchSourceI'Empty - | -- | Create a branch from this loose-code-or-project - BranchSourceI'LooseCodeOrProject LooseCodeOrProject + | -- | Create a branch from this other branch + BranchSourceI'LooseCodeOrProject UnresolvedProjectBranch deriving stock (Eq, Show) data DiffNamespaceToPatchInput = DiffNamespaceToPatchInput diff --git a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs index 6b63811bba..65942f5db9 100644 --- a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs +++ b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs @@ -2,21 +2,17 @@ module Unison.CommandLine.BranchRelativePath ( BranchRelativePath (..), parseBranchRelativePath, branchRelativePathParser, - ResolvedBranchRelativePath (..), parseIncrementalBranchRelativePath, IncrementalBranchRelativePath (..), ) where -import Control.Lens (view) import Data.Set qualified as Set import Data.Text qualified as Text import Data.These (These (..)) import Text.Builder qualified import Text.Megaparsec qualified as Megaparsec import Text.Megaparsec.Char qualified as Megaparsec -import U.Codebase.Sqlite.Project qualified as Sqlite -import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path import Unison.Prelude @@ -26,8 +22,11 @@ import Unison.Util.ColorText qualified as CT import Unison.Util.Pretty qualified as P data BranchRelativePath - = BranchRelative (These (Either ProjectBranchName (ProjectName, ProjectBranchName)) Path.Relative) - | LoosePath Path.Path' + = -- | A path rooted at some specified branch/project + BranchPathInCurrentProject ProjectBranchName Path.Absolute + | QualifiedBranchPath ProjectName ProjectBranchName Path.Absolute + | -- | A path which is relative to the user's current location. + UnqualifiedPath Path.Path' deriving stock (Eq, Show) -- | Strings without colons are parsed as loose code paths. A path with a colon may specify: @@ -53,56 +52,37 @@ parseBranchRelativePath str = Left e -> Left (P.string (Megaparsec.errorBundlePretty e)) Right x -> Right x +-- | +-- >>> from @BranchRelativePath @Text (BranchPathInCurrentProject "foo" (Path.absoluteEmpty "bar")) instance From BranchRelativePath Text where from = \case - BranchRelative brArg -> case brArg of - This eitherProj -> - Text.Builder.run - ( Text.Builder.text (eitherProjToText eitherProj) - <> Text.Builder.char ':' - ) - That path -> - Text.Builder.run - ( Text.Builder.char ':' - <> Text.Builder.text (Path.convert path) - ) - These eitherProj path -> - Text.Builder.run - ( Text.Builder.text (eitherProjToText eitherProj) - <> Text.Builder.char ':' - <> Text.Builder.text (Path.convert path) - ) - LoosePath path -> Path.toText' path - where - eitherProjToText = \case - Left branchName -> from @(These ProjectName ProjectBranchName) @Text (That branchName) - Right (projName, branchName) -> into @Text (These projName branchName) - -data ResolvedBranchRelativePath - = ResolvedBranchRelative (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) (Maybe Path.Relative) - | ResolvedLoosePath Path.Absolute - -instance From ResolvedBranchRelativePath BranchRelativePath where - from = \case - ResolvedBranchRelative (ProjectAndBranch proj branch) mRel -> case mRel of - Nothing -> BranchRelative (This (Right (view #name proj, view #name branch))) - Just rel -> BranchRelative (These (Right (view #name proj, view #name branch)) rel) - ResolvedLoosePath p -> LoosePath (Path.absoluteToPath' p) - -instance From ResolvedBranchRelativePath Text where - from = from . into @BranchRelativePath + BranchPathInCurrentProject branch path -> + Text.Builder.run $ + Text.Builder.char '/' + <> Text.Builder.text (into @Text branch) + <> Text.Builder.char ':' + <> Text.Builder.text (Path.absToText path) + QualifiedBranchPath proj branch path -> + Text.Builder.run $ + Text.Builder.text (into @Text proj) + <> Text.Builder.char '/' + <> Text.Builder.text (into @Text branch) + <> Text.Builder.char ':' + <> Text.Builder.text (Path.absToText path) + UnqualifiedPath path -> + Path.toText' path data IncrementalBranchRelativePath - = -- | no dots, slashes, or colons - ProjectOrRelative Text Path.Path' - | -- | dots, no slashes or colons - LooseCode Path.Path' + = -- | no dots, slashes, or colons, so could be a project name or a single path segment + ProjectOrPath' Text Path.Path' + | -- | dots, no slashes or colons, must be a relative or absolute path + OnlyPath' Path.Path' | -- | valid project, no slash IncompleteProject ProjectName | -- | valid project/branch, slash, no colon IncompleteBranch (Maybe ProjectName) (Maybe ProjectBranchName) | -- | valid project/branch, with colon - IncompletePath (Either (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName) (Maybe Path.Relative) + IncompletePath (Either (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName) (Maybe Path.Absolute) | PathRelativeToCurrentBranch Path.Relative deriving stock (Show) @@ -159,9 +139,9 @@ incrementalBranchRelativePathParser = pure (IncompleteProject projectName) in end <|> startingAtSlash (Just projectName) -- The string doesn't parse as a project name but does parse as a path - That (_, path) -> pure (LooseCode path) + That (_, path) -> pure (OnlyPath' path) -- The string parses both as a project name and a path - These _ (_, path) -> ProjectOrRelative <$> Megaparsec.takeRest <*> pure path + These _ (_, path) -> ProjectOrPath' <$> Megaparsec.takeRest <*> pure path startingAtBranch :: Maybe ProjectName -> Megaparsec.Parsec Void Text IncrementalBranchRelativePath startingAtBranch mproj = @@ -181,7 +161,7 @@ incrementalBranchRelativePathParser = Megaparsec.Parsec Void Text IncrementalBranchRelativePath startingAtColon projStuff = do _ <- Megaparsec.char ':' - p <- optionalEof relPath + p <- optionalEof absPath pure (IncompletePath projStuff p) pathRelativeToCurrentBranch :: Megaparsec.Parsec Void Text IncrementalBranchRelativePath @@ -191,18 +171,25 @@ incrementalBranchRelativePathParser = pure (PathRelativeToCurrentBranch p) optionalEof :: Megaparsec.Parsec Void Text a -> Megaparsec.Parsec Void Text (Maybe a) - optionalEof pa = Just <$> pa <|> Nothing <$ Megaparsec.eof + optionalEof pa = Just <$> pa <|> (Nothing <$ Megaparsec.eof) optionalBranch :: Megaparsec.Parsec Void Text (Maybe ProjectBranchName) optionalBranch = optionalEof branchNameParser branchNameParser = Project.projectBranchNameParser False + relPath :: Megaparsec.Parsec Void Text Path.Relative relPath = do offset <- Megaparsec.getOffset path' >>= \(Path.Path' inner) -> case inner of Left _ -> failureAt offset "Expected a relative path but found an absolute path" Right x -> pure x + absPath :: Megaparsec.Parsec Void Text Path.Absolute + absPath = do + offset <- Megaparsec.getOffset + path' >>= \(Path.Path' inner) -> case inner of + Left p -> pure p + Right _ -> failureAt offset "Expected an absolute path but found a relative path. Try adding a leading '.' to your path" path' = Megaparsec.try do offset <- Megaparsec.getOffset pathStr <- Megaparsec.takeRest @@ -235,16 +222,14 @@ incrementalBranchRelativePathParser = branchRelativePathParser :: Megaparsec.Parsec Void Text BranchRelativePath branchRelativePathParser = incrementalBranchRelativePathParser >>= \case - ProjectOrRelative _txt path -> pure (LoosePath path) - LooseCode path -> pure (LoosePath path) + ProjectOrPath' _txt path -> pure (UnqualifiedPath path) + OnlyPath' path -> pure (UnqualifiedPath path) IncompleteProject _proj -> fail "Branch relative paths require a branch. Expected `/` here." IncompleteBranch _mproj _mbranch -> fail "Branch relative paths require a colon. Expected `:` here." - PathRelativeToCurrentBranch p -> pure (BranchRelative (That p)) + PathRelativeToCurrentBranch p -> pure (UnqualifiedPath (Path.RelativePath' p)) IncompletePath projStuff mpath -> case projStuff of - Left (ProjectAndBranch projName branchName) -> case mpath of - Nothing -> pure (BranchRelative (This (Right (projName, branchName)))) - Just path -> pure (BranchRelative (These (Right (projName, branchName)) path)) - Right branch -> case mpath of - Nothing -> pure (BranchRelative (This (Left branch))) - Just path -> pure (BranchRelative (These (Left branch) path)) + Left (ProjectAndBranch projName branchName) -> + pure $ QualifiedBranchPath projName branchName (fromMaybe Path.absoluteEmpty mpath) + Right branch -> + pure $ BranchPathInCurrentProject branch (fromMaybe Path.absoluteEmpty mpath) diff --git a/unison-cli/src/Unison/CommandLine/Completion.hs b/unison-cli/src/Unison/CommandLine/Completion.hs index 5241e00979..a30fa71e57 100644 --- a/unison-cli/src/Unison/CommandLine/Completion.hs +++ b/unison-cli/src/Unison/CommandLine/Completion.hs @@ -20,9 +20,8 @@ module Unison.CommandLine.Completion ) where -import Control.Lens (ifoldMap) +import Control.Lens import Control.Lens qualified as Lens -import Control.Lens.Cons (unsnoc) import Data.Aeson qualified as Aeson import Data.List (isPrefixOf) import Data.List qualified as List @@ -146,7 +145,7 @@ completeWithinNamespace :: Sqlite.Transaction [System.Console.Haskeline.Completion.Completion] completeWithinNamespace compTypes query ppCtx = do shortHashLen <- Codebase.hashLength - b <- Codebase.getShallowBranchAtPath (Path.unabsolute absQueryPath) Nothing + b <- Codebase.getShallowBranchAtProjectPath (queryProjectPath ^. PP.ctxAsIds_) currentBranchSuggestions <- do nib <- namesInBranch shortHashLen b nib @@ -169,8 +168,8 @@ completeWithinNamespace compTypes query ppCtx = do queryPathPrefix :: Path.Path' querySuffix :: Text (queryPathPrefix, querySuffix) = parseLaxPath'Query (Text.pack query) - absQueryPath :: Path.Absolute - absQueryPath = Path.resolve ppCtx queryPathPrefix + queryProjectPath :: PP.ProjectPathCtx + queryProjectPath = ppCtx & PP.absPath_ %~ \curPath -> Path.resolve curPath queryPathPrefix getChildSuggestions :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [Completion] getChildSuggestions shortHashLen b | Text.null querySuffix = pure [] diff --git a/unison-share-api/src/Unison/Server/CodebaseServer.hs b/unison-share-api/src/Unison/Server/CodebaseServer.hs index 88c57c8183..6ad9c77e6b 100644 --- a/unison-share-api/src/Unison/Server/CodebaseServer.hs +++ b/unison-share-api/src/Unison/Server/CodebaseServer.hs @@ -85,6 +85,8 @@ import System.Environment (getExecutablePath) import System.FilePath (()) import System.FilePath qualified as FilePath import System.Random.MWC (createSystemRandom) +import U.Codebase.Branch qualified as V2 +import U.Codebase.Causal qualified as Causal import U.Codebase.HashTags (CausalHash) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase @@ -589,34 +591,38 @@ serveProjectsCodebaseServerAPI codebase rt projectName branchName = do where projectAndBranchName = ProjectAndBranch projectName branchName namespaceListingEndpoint _rootParam rel name = do - root <- resolveProjectRoot codebase projectAndBranchName + root <- resolveProjectRootHash codebase projectAndBranchName setCacheControl <$> NamespaceListing.serve codebase (Just . Right $ root) rel name namespaceDetailsEndpoint namespaceName _rootParam renderWidth = do - root <- resolveProjectRoot codebase projectAndBranchName + root <- resolveProjectRootHash codebase projectAndBranchName setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Just . Right $ root) renderWidth serveDefinitionsEndpoint _rootParam relativePath rawHqns renderWidth suff = do - root <- resolveProjectRoot codebase projectAndBranchName + root <- resolveProjectRootHash codebase projectAndBranchName setCacheControl <$> serveDefinitions rt codebase (Just . Right $ root) relativePath rawHqns renderWidth suff serveFuzzyFindEndpoint _rootParam relativePath limit renderWidth query = do - root <- resolveProjectRoot codebase projectAndBranchName + root <- resolveProjectRootHash codebase projectAndBranchName setCacheControl <$> serveFuzzyFind codebase (Just . Right $ root) relativePath limit renderWidth query serveTermSummaryEndpoint shortHash mayName _rootParam relativeTo renderWidth = do - root <- resolveProjectRoot codebase projectAndBranchName + root <- resolveProjectRootHash codebase projectAndBranchName setCacheControl <$> serveTermSummary codebase shortHash mayName (Just . Right $ root) relativeTo renderWidth serveTypeSummaryEndpoint shortHash mayName _rootParam relativeTo renderWidth = do - root <- resolveProjectRoot codebase projectAndBranchName + root <- resolveProjectRootHash codebase projectAndBranchName setCacheControl <$> serveTypeSummary codebase shortHash mayName (Just . Right $ root) relativeTo renderWidth -resolveProjectRoot :: (Codebase IO v a) -> (ProjectAndBranch ProjectName ProjectBranchName) -> Backend IO CausalHash +resolveProjectRoot :: (Codebase IO v a) -> (ProjectAndBranch ProjectName ProjectBranchName) -> Backend IO (V2.CausalBranch Sqlite.Transaction) resolveProjectRoot codebase projectAndBranchName@(ProjectAndBranch projectName branchName) = do - mayCH <- liftIO . Codebase.runTransaction codebase $ Codebase.causalHashForProjectBranchName @IO projectAndBranchName - case mayCH of + mayCB <- liftIO . Codebase.runTransaction codebase $ Codebase.getShallowProjectRootByNames projectAndBranchName + case mayCB of Nothing -> throwError (Backend.ProjectBranchNameNotFound projectName branchName) - Just ch -> pure ch + Just cb -> pure cb + +resolveProjectRootHash :: (Codebase IO v a) -> (ProjectAndBranch ProjectName ProjectBranchName) -> Backend IO CausalHash +resolveProjectRootHash codebase projectAndBranchName = do + resolveProjectRoot codebase projectAndBranchName <&> Causal.causalHash serveProjectDiffTermsEndpoint :: Codebase IO Symbol Ann -> Rt.Runtime Symbol -> ProjectName -> ProjectBranchName -> ProjectBranchName -> Name -> Name -> Backend IO TermDiffResponse serveProjectDiffTermsEndpoint codebase rt projectName oldBranchRef newBranchRef oldTerm newTerm = do @@ -639,7 +645,7 @@ serveProjectDiffTermsEndpoint codebase rt projectName oldBranchRef newBranchRef contextForProjectBranch :: (Codebase IO v a) -> ProjectName -> ProjectBranchName -> Backend IO (PrettyPrintEnvDecl, NameSearch Sqlite.Transaction) contextForProjectBranch codebase projectName branchName = do - projectRootHash <- resolveProjectRoot codebase (ProjectAndBranch projectName branchName) + projectRootHash <- resolveProjectRootHash codebase (ProjectAndBranch projectName branchName) projectRootBranch <- liftIO $ Codebase.expectBranchForHash codebase projectRootHash hashLength <- liftIO $ Codebase.runTransaction codebase $ Codebase.hashLength let names = Branch.toNames (Branch.head projectRootBranch) From 29fd307ad9751e05a416f23d3d8b1c9a99ebe22e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 23 May 2024 10:22:59 -0700 Subject: [PATCH 022/631] Checkpoint --- parser-typechecker/src/Unison/Codebase.hs | 17 ++- .../src/Unison/Codebase/ProjectPath.hs | 81 ++++++++------ unison-cli/src/Unison/Cli/MonadUtils.hs | 12 +-- unison-cli/src/Unison/Cli/ProjectUtils.hs | 82 +++++++------- .../src/Unison/Codebase/Editor/HandleInput.hs | 4 +- .../Codebase/Editor/HandleInput/Branch.hs | 93 ++++++---------- .../Codebase/Editor/HandleInput/Upgrade.hs | 9 +- .../src/Unison/Codebase/Editor/Input.hs | 6 +- unison-cli/src/Unison/CommandLine.hs | 4 +- .../src/Unison/CommandLine/Completion.hs | 16 +-- .../src/Unison/CommandLine/FZFResolvers.hs | 6 +- .../src/Unison/CommandLine/InputPattern.hs | 11 +- .../src/Unison/CommandLine/InputPatterns.hs | 100 ++++++------------ unison-cli/src/Unison/CommandLine/Main.hs | 2 +- .../Unison/Server/Local/Endpoints/Current.hs | 10 +- 15 files changed, 207 insertions(+), 246 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index db197aa5ed..b02dd27494 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -2,7 +2,7 @@ module Unison.Codebase ( Codebase, -- * UCM session state - loadCurrentProjectPathCtx, + loadCurrentProjectPath, setCurrentProjectPath, -- * Terms @@ -126,7 +126,6 @@ import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.DbId qualified as Db import U.Codebase.Sqlite.Operations qualified as Operations -import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries @@ -565,16 +564,16 @@ unsafeGetTermComponent codebase hash = Nothing -> error (reportBug "E769004" ("term component " ++ show hash ++ " not found")) Just terms -> terms -loadCurrentProjectPathCtx :: Sqlite.Transaction (Maybe PP.ProjectPathCtx) -loadCurrentProjectPathCtx = do - mProjectPath <- Q.loadCurrentProjectPath - case mProjectPath of +loadCurrentProjectPath :: Sqlite.Transaction (Maybe PP.ProjectPath) +loadCurrentProjectPath = do + mProjectInfo <- Q.loadCurrentProjectPath + case mProjectInfo of Nothing -> pure Nothing Just (projectId, projectBranchId, path) -> do - Project {name = projectName} <- Q.expectProject projectId - ProjectBranch {name = branchName} <- Q.expectProjectBranch projectId projectBranchId + proj <- Q.expectProject projectId + projBranch <- Q.expectProjectBranch projectId projectBranchId let absPath = Path.Absolute (Path.fromList path) - pure $ Just (PP.ProjectPath (projectId, projectName) (projectBranchId, branchName) absPath) + pure $ Just (PP.ProjectPath proj projBranch absPath) setCurrentProjectPath :: PP.ProjectPathIds -> Sqlite.Transaction () setCurrentProjectPath (PP.ProjectPath projectId projectBranchId path) = diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index 4f6bbe30f2..a11b7ccd23 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -1,16 +1,16 @@ module Unison.Codebase.ProjectPath - ( ProjectPath (..), + ( ProjectPathG (..), ProjectPathIds, ProjectPathNames, - ProjectPathCtx, + ProjectPath, fromProjectAndBranch, - ctxFromProjectAndBranch, absPath_, path_, projectAndBranch_, toText, - ctxAsIds_, - ctxAsNames_, + asIds_, + asNames_, + asProjectAndBranch_, project_, branch_, ) @@ -26,74 +26,85 @@ import Unison.Codebase.Path qualified as Path import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) -data ProjectPath proj branch = ProjectPath +data ProjectPathG proj branch = ProjectPath { projPathProject :: proj, projPathBranch :: branch, projPathPath :: Path.Absolute } deriving stock (Eq, Ord, Show) -type ProjectPathIds = ProjectPath ProjectId ProjectBranchId +type ProjectPathIds = ProjectPathG ProjectId ProjectBranchId -type ProjectPathNames = ProjectPath ProjectName ProjectBranchName +type ProjectPathNames = ProjectPathG ProjectName ProjectBranchName -type ProjectPathCtx = ProjectPath (ProjectId, ProjectName) (ProjectBranchId, ProjectBranchName) +type ProjectPath = ProjectPathG Project ProjectBranch -fromProjectAndBranch :: ProjectAndBranch proj branch -> Path.Absolute -> ProjectPath proj branch -fromProjectAndBranch (ProjectAndBranch proj branch) = ProjectPath proj branch +fromProjectAndBranch :: ProjectAndBranch Project ProjectBranch -> Path.Absolute -> ProjectPath +fromProjectAndBranch (ProjectAndBranch proj branch) path = ProjectPath proj branch path -ctxFromProjectAndBranch :: ProjectAndBranch Project ProjectBranch -> Path.Absolute -> ProjectPathCtx -ctxFromProjectAndBranch (ProjectAndBranch (Project {projectId, name = projectName}) (ProjectBranch {branchId, name = branchName})) = ProjectPath (projectId, projectName) (branchId, branchName) - -project_ :: Lens' (ProjectPath p b) p -project_ = lens go set +project_ :: Lens' (ProjectPathG p b) p +project_ = lens get set where - go (ProjectPath p _ _) = p + get (ProjectPath p _ _) = p set (ProjectPath _ b path) p = ProjectPath p b path -branch_ :: Lens' (ProjectPath p b) b -branch_ = lens go set +branch_ :: Lens' (ProjectPathG p b) b +branch_ = lens get set where - go (ProjectPath _ b _) = b + get (ProjectPath _ b _) = b set (ProjectPath p _ path) b = ProjectPath p b path -- | Project a project context into a project path of just IDs -ctxAsIds_ :: Lens' ProjectPathCtx ProjectPathIds -ctxAsIds_ = lens go set +asIds_ :: Lens' ProjectPath ProjectPathIds +asIds_ = lens get set where - go (ProjectPath (pid, _) (bid, _) p) = ProjectPath pid bid p - set (ProjectPath (_, pName) (_, bName) _) (ProjectPath pid bid p) = ProjectPath (pid, pName) (bid, bName) p + get (ProjectPath proj branch path) = ProjectPath (proj ^. #projectId) (branch ^. #branchId) path + set p (ProjectPath pId bId path) = + p + & project_ . #projectId .~ pId + & branch_ . #branchId .~ bId + & absPath_ .~ path -- | Project a project context into a project path of just names -ctxAsNames_ :: Lens' ProjectPathCtx ProjectPathNames -ctxAsNames_ = lens go set +asNames_ :: Lens' ProjectPath ProjectPathNames +asNames_ = lens get set + where + get (ProjectPath proj branch path) = ProjectPath (proj ^. #name) (branch ^. #name) path + set p (ProjectPath pName bName path) = + p + & project_ . #name .~ pName + & branch_ . #name .~ bName + & absPath_ .~ path + +asProjectAndBranch_ :: Lens' ProjectPath (ProjectAndBranch Project ProjectBranch) +asProjectAndBranch_ = lens get set where - go (ProjectPath (_, pName) (_, bName) path) = ProjectPath pName bName path - set (ProjectPath (pId, _) (bId, _) _) (ProjectPath pName bName path) = ProjectPath (pId, pName) (bId, bName) path + get (ProjectPath proj branch _) = ProjectAndBranch proj branch + set p (ProjectAndBranch proj branch) = p & project_ .~ proj & branch_ .~ branch -instance Bifunctor ProjectPath where +instance Bifunctor ProjectPathG where bimap f g (ProjectPath p b path) = ProjectPath (f p) (g b) path -instance Bifoldable ProjectPath where +instance Bifoldable ProjectPathG where bifoldMap f g (ProjectPath p b _) = f p <> g b -instance Bitraversable ProjectPath where +instance Bitraversable ProjectPathG where bitraverse f g (ProjectPath p b path) = ProjectPath <$> f p <*> g b <*> pure path -toText :: ProjectPath ProjectName ProjectBranchName -> Text +toText :: ProjectPathG ProjectName ProjectBranchName -> Text toText (ProjectPath projName branchName path) = into @Text projName <> "/" <> into @Text branchName <> ":" <> Path.absToText path -absPath_ :: Lens' (ProjectPath p b) Path.Absolute +absPath_ :: Lens' (ProjectPathG p b) Path.Absolute absPath_ = lens go set where go (ProjectPath _ _ p) = p set (ProjectPath n b _) p = ProjectPath n b p -path_ :: Lens' (ProjectPath p b) Path.Path +path_ :: Lens' (ProjectPathG p b) Path.Path path_ = absPath_ . Path.absPath_ -projectAndBranch_ :: Lens' (ProjectPath p b) (ProjectAndBranch p b) +projectAndBranch_ :: Lens' (ProjectPathG p b) (ProjectAndBranch p b) projectAndBranch_ = lens go set where go (ProjectPath proj branch _) = ProjectAndBranch proj branch diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 78308eae67..6eb5a755f6 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -8,7 +8,7 @@ module Unison.Cli.MonadUtils getCurrentPath, getCurrentProjectName, getCurrentProjectBranchName, - getProjectPathCtx, + getProjectPath, resolvePath, resolvePath', resolveSplit', @@ -146,8 +146,8 @@ getConfig key = do ------------------------------------------------------------------------------------------------------------------------ -- Getting paths, path resolution, etc. -getProjectPathCtx :: Cli PP.ProjectPathCtx -getProjectPathCtx = do +getProjectPath :: Cli PP.ProjectPath +getProjectPath = do (PP.ProjectPath projId branchId path) <- Cli.getProjectPathIds -- TODO: Reset to a valid project on error. (Project {name = projName}, ProjectBranch {name = branchName}) <- fmap (fromMaybe (error $ reportBug "E794202" ("Project branch not found in database for ids: " <> show (projId, branchId)))) . Cli.runTransaction . runMaybeT $ do @@ -159,15 +159,15 @@ getProjectPathCtx = do -- | Get the current path relative to the current project. getCurrentPath :: Cli Path.Absolute getCurrentPath = do - view PP.absPath_ <$> getProjectPathCtx + view PP.absPath_ <$> getProjectPath getCurrentProjectName :: Cli ProjectName getCurrentProjectName = do - view (PP.ctxAsNames_ . PP.project_) <$> getProjectPathCtx + view (PP.ctxAsNames_ . PP.project_) <$> getProjectPath getCurrentProjectBranchName :: Cli ProjectBranchName getCurrentProjectBranchName = do - view (PP.ctxAsNames_ . PP.branch_) <$> getProjectPathCtx + view (PP.ctxAsNames_ . PP.branch_) <$> getProjectPath -- | Resolve a @Path@ (interpreted as relative) to a @Path.Absolute@, per the current path. resolvePath :: Path -> Cli Path.Absolute diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index 07a7e93a1f..6ed7ff03e7 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -3,6 +3,8 @@ module Unison.Cli.ProjectUtils ( -- * Project/path helpers expectProjectBranchByName, resolveBranchRelativePath, + resolveProjectPath, + resolveProjectBranch, -- * Name hydration hydrateNames, @@ -11,7 +13,8 @@ module Unison.Cli.ProjectUtils expectProjectAndBranchByIds, getProjectAndBranchByTheseNames, expectProjectAndBranchByTheseNames, - expectLooseCodeOrProjectBranch, + getCurrentProject, + getCurrentProjectBranch, -- * Loading remote project info expectRemoteProjectById, @@ -30,13 +33,14 @@ module Unison.Cli.ProjectUtils where import Control.Lens -import Control.Monad.Trans.Maybe (mapMaybeT) import Data.List qualified as List import Data.Maybe (fromJust) import Data.Set qualified as Set import Data.These (These (..)) import U.Codebase.Sqlite.DbId +import U.Codebase.Sqlite.Project (Project) import U.Codebase.Sqlite.Project qualified as Sqlite +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch) import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) @@ -44,7 +48,6 @@ import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.Share.Projects (IncludeSquashedHead) import Unison.Cli.Share.Projects qualified as Share -import Unison.Codebase.Editor.Input (LooseCodeOrProject) import Unison.Codebase.Editor.Output (Output (LocalProjectBranchDoesntExist)) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path (Path') @@ -58,7 +61,7 @@ import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite import Witch (unsafeFrom) -resolveBranchRelativePath :: BranchRelativePath -> Cli PP.ProjectPathCtx +resolveBranchRelativePath :: BranchRelativePath -> Cli PP.ProjectPath resolveBranchRelativePath brp = do case brp of BranchPathInCurrentProject projBranchName path -> do @@ -68,7 +71,7 @@ resolveBranchRelativePath brp = do projectAndBranch <- expectProjectAndBranchByTheseNames (These projName projBranchName) pure $ PP.ctxFromProjectAndBranch projectAndBranch path UnqualifiedPath newPath' -> do - ppCtx <- Cli.getProjectPathCtx + ppCtx <- Cli.getProjectPath pure $ ppCtx & PP.absPath_ %~ \curPath -> Path.resolve curPath newPath' -- @findTemporaryBranchName projectId preferred@ finds some unused branch name in @projectId@ with a name @@ -93,24 +96,24 @@ findTemporaryBranchName projectId preferred = do pure (fromJust (List.find (\name -> not (Set.member name allBranchNames)) allCandidates)) -- | Get the current project+branch+branch path that a user is on. -getCurrentProjectBranch :: Cli (Maybe (PP.ProjectPath Sqlite.Project Sqlite.ProjectBranch)) -getCurrentProjectBranch = runMaybeT do - ppCtx <- lift Cli.getProjectPathCtx - mapMaybeT Cli.runTransaction $ do - proj <- MaybeT $ Queries.loadProject (ppCtx ^. PP.ctxAsIds_ . PP.project_) - branch <- MaybeT $ Queries.loadProjectBranch (proj ^. #projectId) (ppCtx ^. PP.ctxAsIds_ . PP.branch_) +getCurrentProjectBranch :: Cli (PP.ProjectPath Sqlite.Project Sqlite.ProjectBranch) +getCurrentProjectBranch = do + ppCtx <- Cli.getProjectPath + Cli.runTransaction $ do + proj <- Queries.expectProject (ppCtx ^. PP.ctxAsIds_ . PP.project_) + branch <- Queries.expectProjectBranch (proj ^. #projectId) (ppCtx ^. PP.ctxAsIds_ . PP.branch_) pure $ PP.ProjectPath proj branch (ppCtx ^. PP.absPath_) +getCurrentProject :: Cli Sqlite.Project +getCurrentProject = do + ppCtx <- Cli.getProjectPath + Cli.runTransaction (Queries.expectProject (ppCtx ^. PP.ctxAsIds_ . PP.project_)) + expectProjectBranchByName :: Sqlite.Project -> ProjectBranchName -> Cli Sqlite.ProjectBranch expectProjectBranchByName project branchName = Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName) & onNothingM do Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch (project ^. #name) branchName)) --- | Like 'getCurrentProjectBranch', but fails with a message if the user is not on a project branch. -expectCurrentProjectBranch :: Cli (PP.ProjectPath Sqlite.Project Sqlite.ProjectBranch) -expectCurrentProjectBranch = - getCurrentProjectBranch & onNothingM (Cli.returnEarly Output.NotOnProjectBranch) - -- We often accept a `These ProjectName ProjectBranchName` from the user, so they can leave off either a project or -- branch name, which we infer. This helper "hydrates" such a type to a `(ProjectName, BranchName)`, using the following -- defaults if a name is missing: @@ -121,7 +124,7 @@ hydrateNames :: These ProjectName ProjectBranchName -> Cli (ProjectAndBranch Pro hydrateNames = \case This projectName -> pure (ProjectAndBranch projectName (unsafeFrom @Text "main")) That branchName -> do - ppCtx <- Cli.getProjectPathCtx + ppCtx <- Cli.getProjectPath pure (ProjectAndBranch (ppCtx ^. PP.ctxAsNames_ . PP.project_) branchName) These projectName branchName -> pure (ProjectAndBranch projectName branchName) @@ -144,7 +147,7 @@ getProjectAndBranchByTheseNames :: getProjectAndBranchByTheseNames = \case This projectName -> getProjectAndBranchByTheseNames (These projectName (unsafeFrom @Text "main")) That branchName -> runMaybeT do - currentProjectBranch <- MaybeT getCurrentProjectBranch + currentProjectBranch <- lift getCurrentProjectBranch branch <- MaybeT (Cli.runTransaction (Queries.loadProjectBranchByName (currentProjectBranch ^. PP.project_ . #projectId) branchName)) pure (ProjectAndBranch (currentProjectBranch ^. PP.project_) branch) These projectName branchName -> do @@ -164,7 +167,7 @@ expectProjectAndBranchByTheseNames :: expectProjectAndBranchByTheseNames = \case This projectName -> expectProjectAndBranchByTheseNames (These projectName (unsafeFrom @Text "main")) That branchName -> do - PP.ProjectPath project _branch _restPath <- expectCurrentProjectBranch + PP.ProjectPath project _branch _restPath <- getCurrentProjectBranch branch <- Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName) & onNothingM do Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch (project ^. #name) branchName)) @@ -179,24 +182,29 @@ expectProjectAndBranchByTheseNames = \case maybeProjectAndBranch & onNothing do Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName)) --- | Expect/resolve a possibly-ambiguous "loose code or project", with the following rules: +-- | Expect/resolve a branch-relative path with the following rules: -- --- 1. If we have an unambiguous `/branch` or `project/branch`, look up in the database. --- 2. If we have an unambiguous `loose.code.path`, just return it. --- 3. If we have an ambiguous `foo`, *because we do not currently have an unambiguous syntax for relative paths*, --- we elect to treat it as a loose code path (because `/branch` can be selected with a leading forward slash). -expectLooseCodeOrProjectBranch :: - These Path' (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) -> - Cli (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) -expectLooseCodeOrProjectBranch = - _Right expectProjectAndBranchByTheseNames . f - where - f :: LooseCodeOrProject -> Either Path' (These ProjectName ProjectBranchName) -- (Maybe ProjectName, ProjectBranchName) - f = \case - This path -> Left path - That (ProjectAndBranch Nothing branch) -> Right (That branch) - That (ProjectAndBranch (Just project) branch) -> Right (These project branch) - These path _ -> Left path -- (3) above +-- 1. If the project is missing, use the current project. +-- 2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the current +-- project, defaulting to 'main' if branch is unspecified. +-- 3. If we just have a path, resolve it using the current project. +resolveProjectPath :: PP.ProjectPath -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Maybe Path' -> Cli PP.ProjectPath +resolveProjectPath ppCtx mayProjAndBranch mayPath' = do + projAndBranch <- resolveProjectBranch ppCtx mayProjAndBranch + absPath <- fromMaybe Path.absoluteEmpty <$> traverse Cli.resolvePath' mayPath' + pure $ PP.ctxFromProjectAndBranch projAndBranch absPath + +-- | Expect/resolve branch reference with the following rules: +-- +-- 1. If the project is missing, use the provided project. +-- 2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the provided +-- project, defaulting to 'main' if branch is unspecified. +resolveProjectBranch :: ProjectAndBranch Project ProjectBranch -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) +resolveProjectBranch ppCtx (ProjectAndBranch mayProjectName mayBranchName) = do + let branchName = fromMaybe (unsafeFrom @Text "main") mayBranchName + let projectName = fromMaybe (ppCtx ^. PP.ctxAsNames_ . PP.project_) mayProjectName + projectAndBranch <- expectProjectAndBranchByTheseNames (These projectName branchName) + pure projectAndBranch ------------------------------------------------------------------------------------------------------------------------ -- Remote project utils @@ -281,7 +289,7 @@ expectRemoteProjectBranchByTheseNames includeSquashed = \case let remoteBranchName = unsafeFrom @Text "main" expectRemoteProjectBranchByName includeSquashed (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName) That branchName -> do - PP.ProjectPath localProject localBranch _restPath <- expectCurrentProjectBranch + PP.ProjectPath localProject localBranch _restPath <- getCurrentProjectBranch let localProjectId = localProject ^. #projectId let localBranchId = localBranch ^. #branchId Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 30f8a48a37..8e9544fe82 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -1037,7 +1037,7 @@ loop e = do Cli.respond $ DumpUnisonFileHashes hqLength datas effects terms DebugTabCompletionI inputs -> do Cli.Env {authHTTPClient, codebase} <- ask - ppCtx <- Cli.getProjectPathCtx + ppCtx <- Cli.getProjectPath let completionFunc = Completion.haskelineTabComplete IP.patternMap codebase authHTTPClient ppCtx (_, completions) <- liftIO $ completionFunc (reverse (unwords inputs), "") Cli.respond (DisplayDebugCompletions completions) @@ -1048,7 +1048,7 @@ loop e = do Just (IP.InputPattern {args = argTypes}) -> do zip argTypes args & Monoid.foldMapM \case ((argName, _, IP.ArgumentType {fzfResolver = Just IP.FZFResolver {getOptions}}), "_") -> do - ppCtx <- Cli.getProjectPathCtx + ppCtx <- Cli.getProjectPath results <- liftIO $ getOptions codebase ppCtx currentBranch Cli.respond (DebugDisplayFuzzyOptions argName (Text.unpack <$> results)) ((_, _, IP.ArgumentType {fzfResolver = Nothing}), "_") -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 3d1a0549e5..8df791dec7 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -1,18 +1,16 @@ -- | @branch@ input handler module Unison.Codebase.Editor.HandleInput.Branch ( handleBranch, - CreateFrom (..), doCreateBranch, - doCreateBranch', ) where -import Control.Lens ((^.)) -import Data.These (These (..)) +import Control.Lens import Data.UUID.V4 qualified as UUID -import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.DbId import U.Codebase.Sqlite.Project qualified as Sqlite +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.ProjectBranch qualified as ProjectBranch import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) @@ -20,23 +18,18 @@ import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch (Branch) -import Unison.Codebase.Branch qualified as Branch (empty, headHash) +import Unison.Codebase.Branch qualified as Branch (headHash) import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectBranchNameKind (..), ProjectName, classifyProjectBranchName) import Unison.Sqlite qualified as Sqlite -- | Create a new project branch from an existing project branch or namespace. handleBranch :: Input.BranchSourceI -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () -handleBranch sourceI projectAndBranchNames0 = do - projectAndBranchNames@(ProjectAndBranch projectName newBranchName) <- - case projectAndBranchNames0 of - ProjectAndBranch Nothing branchName -> ProjectUtils.hydrateNames (That branchName) - ProjectAndBranch (Just projectName) branchName -> pure (ProjectAndBranch projectName branchName) - +handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newBranchName) = do -- You can only create release branches with `branch.clone` -- -- We do allow creating draft release branches with `branch`, but you'll get different output if you use @@ -48,52 +41,35 @@ handleBranch sourceI projectAndBranchNames0 = do Cli.returnEarly (Output.CannotCreateReleaseBranchWithBranchCommand newBranchName ver) ProjectBranchNameKind'NothingSpecial -> pure () - srcProject <- - Cli.runTransactionWithRollback \rollback -> do - Queries.loadProjectByName projectName & onNothingM do - -- We can't make the *first* branch of a project with `branch`; the project has to already exist. - rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) + currentProjectName <- Cli.getProjectPath <&> view (PP.ctxAsNames_ . PP.project_) + destProject <- do + Cli.runTransactionWithRollback + \rollback -> do + let projectName = (fromMaybe currentProjectName mayProjectName) + Queries.loadProjectByName projectName & onNothingM do + -- We can't make the *first* branch of a project with `branch`; the project has to already exist. + rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName newBranchName)) -- Compute what we should create the branch from. - mayNewBranchCausalHash <- + maySrcBranch <- case sourceI of - Input.BranchSourceI'CurrentContext -> - Cli.getProjectRoot >>= \case - projectRoot -> do - pure Branch.headHash projectRoot - Input.BranchSourceI'Empty -> do - pure Nothing - Input.BranchSourceI'LooseCodeOrProject (This sourcePath) -> do - currentPath <- Cli.getCurrentPath - pure (CreateFrom'LooseCode (Path.resolve currentPath sourcePath)) - Input.BranchSourceI'LooseCodeOrProject (That sourceBranch) -> - fmap CreateFrom'Branch do - ProjectUtils.expectProjectAndBranchByTheseNames - case sourceBranch of - ProjectAndBranch Nothing b -> That b - ProjectAndBranch (Just p) b -> These p b - -- For now, treat ambiguous parses as branch names, as this seems (far) more common than trying to create a - -- branch from a relative one-segment namespace. - -- - -- Future work: be smarter; for example, if there is such a relative namespace, but no such branch, maybe they - -- really meant create a branch from that namespace. - Input.BranchSourceI'LooseCodeOrProject (These _sourcePath sourceBranch) -> - fmap CreateFrom'Branch do - ProjectUtils.expectProjectAndBranchByTheseNames - case sourceBranch of - ProjectAndBranch Nothing b -> That b - ProjectAndBranch (Just p) b -> These p b + Input.BranchSourceI'CurrentContext -> Just <$> ProjectUtils.getCurrentProjectBranch + Input.BranchSourceI'Empty -> pure Nothing + Input.BranchSourceI'UnresolvedProjectBranch unresolvedProjectBranch -> do + ppCtx <- Cli.getProjectPath + ProjectAndBranch _proj branch <- ProjectUtils.resolveProjectBranch ppCtx (unresolvedProjectBranch & #branch %~ Just) + pure $ Just branch - _ <- doCreateBranch newBranchCausalHashId project newBranchName ("branch " <> into @Text projectAndBranchNames) + _ <- doCreateBranch maySrcBranch project newBranchName Cli.respond $ Output.CreatedProjectBranch - ( case createFrom of - CreateFrom'Branch sourceBranch -> + ( case maySrcBranch of + Just sourceBranch -> if sourceBranch ^. #project . #projectId == project ^. #projectId then Output.CreatedProjectBranchFrom'ParentBranch (sourceBranch ^. #branch . #name) else Output.CreatedProjectBranchFrom'OtherBranch sourceBranch - CreateFrom'Nothingness -> Output.CreatedProjectBranchFrom'Nothingness + Nothing -> Output.CreatedProjectBranchFrom'Nothingness ) projectAndBranchNames @@ -107,13 +83,12 @@ handleBranch sourceI projectAndBranchNames0 = do -- -- Returns the branch id of the newly-created branch. doCreateBranch :: - CausalHashId -> - Maybe ProjectBranchId -> + -- If no parent branch is provided, make an empty branch. + Maybe Sqlite.ProjectBranch -> Sqlite.Project -> Sqlite.Transaction ProjectBranchName -> - Text -> Cli ProjectBranchId -doCreateBranch newBranchCausalId parentBranchId project getNewBranchName description = do +doCreateBranch mayParentBranch project getNewBranchName = do let projectId = project ^. #projectId newBranchId <- Cli.runTransactionWithRollback \rollback -> do @@ -124,17 +99,19 @@ doCreateBranch newBranchCausalId parentBranchId project getNewBranchName descrip -- Here, we are forking to `foo/bar`, where project `foo` does exist, and it does not have a branch named -- `bar`, so the fork will succeed. newBranchId <- Sqlite.unsafeIO (ProjectBranchId <$> UUID.nextRandom) + newBranchCausalHashId <- + (ProjectBranch.causalHashId <$> mayParentBranch) `whenNothing` do + (_, causalHashId) <- Codebase.emptyCausalHash + pure causalHashId Queries.insertProjectBranch Sqlite.ProjectBranch { projectId, branchId = newBranchId, name = newBranchName, - parentBranchId = parentBranchId, - causalHashId = newBranchCausalId + parentBranchId = ProjectBranch.branchId <$> mayParentBranch, + causalHashId = newBranchCausalHashId } - Queries.setMostRecentBranch projectId newBranchId pure newBranchId - -- TODO: Switch to new branch - Cli.switch newBranchPath + Cli.switchProject (ProjectAndBranch projectId newBranchId) pure newBranchId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index aab5144e18..03da23b53f 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -65,13 +65,10 @@ handleUpgrade oldName newName = do Cli.Env {codebase, writeSource} <- ask - (projectAndBranch, _path) <- Cli.expectCurrentProjectBranch - let projectId = projectAndBranch ^. #project . #projectId - let projectPath = Cli.projectBranchPath (ProjectAndBranch projectId (projectAndBranch ^. #branch . #branchId)) - let oldPath = Path.resolve projectPath (Path.Relative (Path.fromList [NameSegment.libSegment, oldName])) - let newPath = Path.resolve projectPath (Path.Relative (Path.fromList [NameSegment.libSegment, newName])) + let oldPath = Path.Absolute (Path.fromList [NameSegment.libSegment, oldName]) + let newPath = Path.Absolute (Path.fromList [NameSegment.libSegment, newName]) - currentNamespace <- Cli.getBranch0At projectPath + currentNamespace <- Cli.getProjectRoot0 let currentNamespaceSansOld = Branch.deleteLibdep oldName currentNamespace let currentDeepTermsSansOld = Branch.deepTerms currentNamespaceSansOld let currentDeepTypesSansOld = Branch.deepTypes currentNamespaceSansOld diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index e74724c8c4..427d901fb4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -105,8 +105,8 @@ data Input -- clone w/o merge, error if would clobber ForkLocalBranchI (Either ShortCausalHash BranchRelativePath) BranchRelativePath | -- merge first causal into destination - MergeLocalBranchI UnresolvedProjectBranch UnresolvedProjectBranch Branch.MergeMode - | PreviewMergeLocalBranchI UnresolvedProjectBranch UnresolvedProjectBranch + MergeLocalBranchI UnresolvedProjectBranch (Maybe UnresolvedProjectBranch) Branch.MergeMode + | PreviewMergeLocalBranchI UnresolvedProjectBranch (Maybe UnresolvedProjectBranch) | DiffNamespaceI BranchId BranchId -- old new | PullI !PullSourceTarget !PullMode | PushRemoteBranchI PushRemoteBranchInput @@ -246,7 +246,7 @@ data BranchSourceI | -- | Create an empty branch BranchSourceI'Empty | -- | Create a branch from this other branch - BranchSourceI'LooseCodeOrProject UnresolvedProjectBranch + BranchSourceI'UnresolvedProjectBranch UnresolvedProjectBranch deriving stock (Eq, Show) data DiffNamespaceToPatchInput = DiffNamespaceToPatchInput diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 8291b7e9fb..cf922597e6 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -120,7 +120,7 @@ nothingTodo = emojiNote "😶" parseInput :: Codebase IO Symbol Ann -> -- | Current location - PP.ProjectPathCtx -> + PP.ProjectPath -> IO (Branch.Branch IO) -> -- | Numbered arguments [String] -> @@ -194,7 +194,7 @@ data FZFResolveFailure | NoFZFOptions Text {- argument description -} | FZFCancelled -fzfResolve :: Codebase IO Symbol Ann -> PP.ProjectPathCtx -> (IO (Branch0 IO)) -> InputPattern -> [String] -> IO (Either FZFResolveFailure [String]) +fzfResolve :: Codebase IO Symbol Ann -> PP.ProjectPath -> (IO (Branch0 IO)) -> InputPattern -> [String] -> IO (Either FZFResolveFailure [String]) fzfResolve codebase ppCtx getCurrentBranch pat args = runExceptT do -- We resolve args in two steps, first we check that all arguments that will require a fzf -- resolver have one, and only if so do we prompt the user to actually do a fuzzy search. diff --git a/unison-cli/src/Unison/CommandLine/Completion.hs b/unison-cli/src/Unison/CommandLine/Completion.hs index a30fa71e57..bd0cf9c0e0 100644 --- a/unison-cli/src/Unison/CommandLine/Completion.hs +++ b/unison-cli/src/Unison/CommandLine/Completion.hs @@ -73,7 +73,7 @@ haskelineTabComplete :: Map String IP.InputPattern -> Codebase m v a -> AuthenticatedHttpClient -> - PP.ProjectPathCtx -> + PP.ProjectPath -> Line.CompletionFunc m haskelineTabComplete patterns codebase authedHTTPClient ppCtx = Line.completeWordWithPrev Nothing " " $ \prev word -> -- User hasn't finished a command name, complete from command names @@ -141,7 +141,7 @@ completeWithinNamespace :: NESet CompletionType -> -- | The portion of this are that the user has already typed. String -> - PP.ProjectPathCtx -> + PP.ProjectPath -> Sqlite.Transaction [System.Console.Haskeline.Completion.Completion] completeWithinNamespace compTypes query ppCtx = do shortHashLen <- Codebase.hashLength @@ -168,7 +168,7 @@ completeWithinNamespace compTypes query ppCtx = do queryPathPrefix :: Path.Path' querySuffix :: Text (queryPathPrefix, querySuffix) = parseLaxPath'Query (Text.pack query) - queryProjectPath :: PP.ProjectPathCtx + queryProjectPath :: PP.ProjectPath queryProjectPath = ppCtx & PP.absPath_ %~ \curPath -> Path.resolve curPath queryPathPrefix getChildSuggestions :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [Completion] getChildSuggestions shortHashLen b @@ -274,35 +274,35 @@ parseLaxPath'Query txt = -- | Completes a namespace argument by prefix-matching against the query. prefixCompleteNamespace :: String -> - PP.ProjectPathCtx -> + PP.ProjectPath -> Sqlite.Transaction [Line.Completion] prefixCompleteNamespace = completeWithinNamespace (NESet.singleton NamespaceCompletion) -- | Completes a term or type argument by prefix-matching against the query. prefixCompleteTermOrType :: String -> - PP.ProjectPathCtx -> + PP.ProjectPath -> Sqlite.Transaction [Line.Completion] prefixCompleteTermOrType = completeWithinNamespace (NESet.fromList (TermCompletion NE.:| [TypeCompletion])) -- | Completes a term argument by prefix-matching against the query. prefixCompleteTerm :: String -> - PP.ProjectPathCtx -> + PP.ProjectPath -> Sqlite.Transaction [Line.Completion] prefixCompleteTerm = completeWithinNamespace (NESet.singleton TermCompletion) -- | Completes a term or type argument by prefix-matching against the query. prefixCompleteType :: String -> - PP.ProjectPathCtx -> + PP.ProjectPath -> Sqlite.Transaction [Line.Completion] prefixCompleteType = completeWithinNamespace (NESet.singleton TypeCompletion) -- | Completes a patch argument by prefix-matching against the query. prefixCompletePatch :: String -> - PP.ProjectPathCtx -> + PP.ProjectPath -> Sqlite.Transaction [Line.Completion] prefixCompletePatch = completeWithinNamespace (NESet.singleton PatchCompletion) diff --git a/unison-cli/src/Unison/CommandLine/FZFResolvers.hs b/unison-cli/src/Unison/CommandLine/FZFResolvers.hs index 79a3f9fcfc..2d3b8a8216 100644 --- a/unison-cli/src/Unison/CommandLine/FZFResolvers.hs +++ b/unison-cli/src/Unison/CommandLine/FZFResolvers.hs @@ -51,7 +51,7 @@ import Unison.Util.Monoid (foldMapM) import Unison.Util.Monoid qualified as Monoid import Unison.Util.Relation qualified as Relation -type OptionFetcher = Codebase IO Symbol Ann -> PP.ProjectPathCtx -> Branch0 IO -> IO [Text] +type OptionFetcher = Codebase IO Symbol Ann -> PP.ProjectPath -> Branch0 IO -> IO [Text] data FZFResolver = FZFResolver { getOptions :: OptionFetcher @@ -121,7 +121,7 @@ fuzzySelectFromList options = -- | Combine multiple option fetchers into one resolver. multiResolver :: [OptionFetcher] -> FZFResolver multiResolver resolvers = - let getOptions :: Codebase IO Symbol Ann -> PP.ProjectPathCtx -> Branch0 IO -> IO [Text] + let getOptions :: Codebase IO Symbol Ann -> PP.ProjectPath -> Branch0 IO -> IO [Text] getOptions codebase projCtx searchBranch0 = do List.nubOrd <$> foldMapM (\f -> f codebase projCtx searchBranch0) resolvers in (FZFResolver {getOptions}) @@ -177,7 +177,7 @@ projectBranchOptions codebase _projCtx _searchBranch0 = do -- E.g. '@unison/base/main' projectBranchOptionsWithinCurrentProject :: OptionFetcher projectBranchOptionsWithinCurrentProject codebase projCtx _searchBranch0 = do - Codebase.runTransaction codebase (Q.loadAllProjectBranchesBeginningWith (projCtx ^. PP.ctxAsIds_ . PP.project_) Nothing) + Codebase.runTransaction codebase (Q.loadAllProjectBranchesBeginningWith (projCtx ^. PP.asIds_ . PP.project_) Nothing) <&> fmap (into @Text . snd) -- | Exported from here just so the debug command and actual implementation can use the same diff --git a/unison-cli/src/Unison/CommandLine/InputPattern.hs b/unison-cli/src/Unison/CommandLine/InputPattern.hs index e5fa556859..fc9c0d2cc3 100644 --- a/unison-cli/src/Unison/CommandLine/InputPattern.hs +++ b/unison-cli/src/Unison/CommandLine/InputPattern.hs @@ -25,7 +25,6 @@ import System.Console.Haskeline qualified as Line import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Codebase (Codebase) import Unison.Codebase.Editor.Input (Input (..)) -import Unison.Codebase.Path as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.FZFResolvers (FZFResolver (..)) import Unison.Prelude @@ -68,7 +67,7 @@ data ArgumentType = ArgumentType String -> Codebase m v a -> AuthenticatedHttpClient -> - PP.ProjectPathCtx -> + PP.ProjectPath -> m [Line.Completion], -- | If an argument is marked as required, but not provided, the fuzzy finder will be triggered if -- available. @@ -147,14 +146,14 @@ unionSuggestions :: [ ( String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPath -> m [Line.Completion] ) ] -> ( String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPath -> m [Line.Completion] ) unionSuggestions suggesters inp codebase httpClient path = do @@ -169,14 +168,14 @@ suggestionFallbacks :: [ ( String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPath -> m [Line.Completion] ) ] -> ( String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPath -> m [Line.Completion] ) suggestionFallbacks suggesters inp codebase httpClient path = go suggesters diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index a3ce432405..45208c2547 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -147,7 +147,7 @@ module Unison.CommandLine.InputPatterns ) where -import Control.Lens (preview, review, (^.)) +import Control.Lens ((^.)) import Control.Lens.Cons qualified as Cons import Data.List (intercalate) import Data.List.Extra qualified as List @@ -168,7 +168,6 @@ import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Cli.Pretty (prettyProjectAndBranchName, prettyProjectName, prettyProjectNameSlash, prettySlashProjectBranchName, prettyURI) -import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch.Merge qualified as Branch @@ -182,7 +181,7 @@ import Unison.Codebase.Editor.UriParser (readRemoteNamespaceParser) import Unison.Codebase.Editor.UriParser qualified as UriParser import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path -import Unison.Codebase.ProjectPath (ProjectPathCtx) +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.PushBehavior qualified as PushBehavior import Unison.CommandLine @@ -1412,7 +1411,7 @@ reset = arg0 <- branchIdOrProject arg0 arg1 <- case restArgs of [] -> pure Nothing - arg1 : [] -> Just <$> parseLooseCodeOrProject arg1 + arg1 : [] -> Just <$> parseUnresolvedProjectBranch arg1 _ -> Nothing Just (Input.ResetI arg0 arg1) _ -> Nothing @@ -1839,8 +1838,8 @@ mergeOldSquashInputPattern = parse = maybeToEither (I.help mergeOldSquashInputPattern) . \case [src, dest] -> do - src <- parseLooseCodeOrProject src - dest <- parseLooseCodeOrProject dest + src <- parseUnresolvedProjectBranch src + dest <- parseUnresolvedProjectBranch dest Just $ Input.MergeLocalBranchI src dest Branch.SquashMerge _ -> Nothing } @@ -1873,23 +1872,17 @@ mergeOldInputPattern = ), ( makeExample mergeOldInputPattern ["/topic", "foo/main"], "merges the branch `topic` of the current project into the `main` branch of the project 'foo`" - ), - ( makeExample mergeOldInputPattern [".src"], - "merges `.src` namespace into the current namespace" - ), - ( makeExample mergeOldInputPattern [".src", ".dest"], - "merges `.src` namespace into the `dest` namespace" ) ] ) ( maybeToEither (I.help mergeOldInputPattern) . \case [src] -> do - src <- parseLooseCodeOrProject src - Just $ Input.MergeLocalBranchI src (This Path.relativeEmpty') Branch.RegularMerge + src <- parseUnresolvedProjectBranch src + Just $ Input.MergeLocalBranchI src Nothing Branch.RegularMerge [src, dest] -> do - src <- parseLooseCodeOrProject src - dest <- parseLooseCodeOrProject dest - Just $ Input.MergeLocalBranchI src dest Branch.RegularMerge + src <- parseUnresolvedProjectBranch src + dest <- parseUnresolvedProjectBranch dest + Just $ Input.MergeLocalBranchI src (Just dest) Branch.RegularMerge _ -> Nothing ) where @@ -1930,16 +1923,8 @@ mergeInputPattern = pure (Input.MergeI branch) } -parseLooseCodeOrProject :: String -> Maybe Input.LooseCodeOrProject -parseLooseCodeOrProject inputString = - case (asLooseCode, asBranch) of - (Right path, Left _) -> Just (This path) - (Left _, Right branch) -> Just (That branch) - (Right path, Right branch) -> Just (These path branch) - (Left _, Left _) -> Nothing - where - asLooseCode = Path.parsePath' inputString - asBranch = tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) (Text.pack inputString) +parseUnresolvedProjectBranch :: String -> Maybe Input.UnresolvedProjectBranch +parseUnresolvedProjectBranch inputString = eitherToMaybe $ tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) (Text.pack inputString) diffNamespace :: InputPattern diffNamespace = @@ -1993,12 +1978,12 @@ mergeOldPreviewInputPattern = ) ( maybeToEither (I.help mergeOldPreviewInputPattern) . \case [src] -> do - src <- parseLooseCodeOrProject src - pure $ Input.PreviewMergeLocalBranchI src (This Path.relativeEmpty') + src <- parseUnresolvedProjectBranch src + pure $ Input.PreviewMergeLocalBranchI src Nothing [src, dest] -> do - src <- parseLooseCodeOrProject src - dest <- parseLooseCodeOrProject dest - pure $ Input.PreviewMergeLocalBranchI src dest + src <- parseUnresolvedProjectBranch src + dest <- parseUnresolvedProjectBranch dest + pure $ Input.PreviewMergeLocalBranchI src (Just dest) _ -> Nothing ) where @@ -3007,18 +2992,17 @@ branchInputPattern = help = P.wrapColumn2 [ ("`branch foo`", "forks the current project branch to a new branch `foo`"), - ("`branch /bar foo`", "forks the branch `bar` of the current project to a new branch `foo`"), - ("`branch .bar foo`", "forks the path `.bar` of the current project to a new branch `foo`") + ("`branch /bar foo`", "forks the branch `bar` of the current project to a new branch `foo`") ], parse = maybeToEither (showPatternHelp branchInputPattern) . \case [source0, name] -> do - source <- parseLooseCodeOrProject source0 + source <- parseUnresolvedProjectBranch source0 projectAndBranch <- Text.pack name & tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) & eitherToMaybe - Just (Input.BranchI (Input.BranchSourceI'LooseCodeOrProject source) projectAndBranch) + Just (Input.BranchI (Input.BranchSourceI'UnresolvedProjectBranch source) projectAndBranch) [name] -> do projectAndBranch <- Text.pack name @@ -3365,7 +3349,7 @@ namespaceOrProjectBranchArg config = ArgumentType { typeName = "namespace or branch", suggestions = - let namespaceSuggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteNamespace q p) + let namespaceSuggestions = \q cb _http ppCtx -> Codebase.runTransaction cb (prefixCompleteNamespace q ppCtx) in unionSuggestions [ projectAndOrBranchSuggestions config, namespaceSuggestions @@ -3478,7 +3462,7 @@ projectAndOrBranchSuggestions :: String -> Codebase m v a -> AuthenticatedHttpClient -> - ProjectPathCtx -> + ProjectPath -> m [Line.Completion] projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do case Text.uncons input of @@ -3616,15 +3600,14 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do then projectCompletions else branchCompletions ++ projectCompletions - handleBranchesComplete :: MonadIO m => Text -> Codebase m v a -> Path.Absolute -> m [Completion] - handleBranchesComplete branchName codebase path = do + -- Complete the text into a branch name within the provided project + handleBranchesComplete :: MonadIO m => Text -> Codebase m v a -> PP.ProjectPath -> m [Completion] + handleBranchesComplete branchName codebase ppCtx = do + let projId = ppCtx ^. PP.ctxAsIds_ . PP.project_ branches <- - case preview ProjectUtils.projectBranchPathPrism path of - Nothing -> pure [] - Just (ProjectAndBranch currentProjectId _, _) -> - Codebase.runTransaction codebase do - fmap (filterBranches config path) do - Queries.loadAllProjectBranchesBeginningWith currentProjectId (Just branchName) + Codebase.runTransaction codebase do + fmap (filterBranches config path) do + Queries.loadAllProjectBranchesBeginningWith projId (Just branchName) pure (map currentProjectBranchToCompletion branches) filterProjects :: [Sqlite.Project] -> [Sqlite.Project] @@ -3661,7 +3644,7 @@ handleBranchesComplete :: ProjectBranchSuggestionsConfig -> Text -> Codebase m v a -> - PP.ProjectPathCtx -> + PP.ProjectPath -> m [Completion] handleBranchesComplete config branchName codebase ppCtx = do branches <- @@ -3670,7 +3653,7 @@ handleBranchesComplete config branchName codebase ppCtx = do Queries.loadAllProjectBranchesBeginningWith (ppCtx ^. PP.ctxAsIds_ . PP.project_) (Just branchName) pure (map currentProjectBranchToCompletion branches) -filterBranches :: ProjectBranchSuggestionsConfig -> PP.ProjectPathCtx -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)] +filterBranches :: ProjectBranchSuggestionsConfig -> PP.ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)] filterBranches config ppCtx branches = case (branchInclusion config) of AllBranches -> branches @@ -3692,17 +3675,17 @@ branchRelativePathSuggestions :: String -> Codebase m v a -> AuthenticatedHttpClient -> - PP.ProjectPathCtx -> + PP.ProjectPath -> m [Line.Completion] branchRelativePathSuggestions config inputStr codebase _httpClient ppCtx = do case parseIncrementalBranchRelativePath inputStr of Left _ -> pure [] Right ibrp -> case ibrp of - BranchRelativePath.ProjectOrRelative _txt _path -> do + BranchRelativePath.ProjectOrPath' _txt _path -> do namespaceSuggestions <- Codebase.runTransaction codebase (prefixCompleteNamespace inputStr currentPath) projectSuggestions <- projectNameSuggestions WithSlash inputStr codebase pure (namespaceSuggestions ++ projectSuggestions) - BranchRelativePath.LooseCode _path -> + BranchRelativePath.OnlyPath' _path -> Codebase.runTransaction codebase (prefixCompleteNamespace inputStr currentPath) BranchRelativePath.IncompleteProject _proj -> projectNameSuggestions WithSlash inputStr codebase @@ -3723,22 +3706,9 @@ branchRelativePathSuggestions config inputStr codebase _httpClient ppCtx = do map prefixPathSep <$> prefixCompleteNamespace (Path.convert relPath) mempty BranchRelativePath.IncompletePath projStuff mpath -> do Codebase.runTransaction codebase do - mprojectBranch <- runMaybeT do - case projStuff of - Left names@(ProjectAndBranch projectName branchName) -> do - (,Left names) <$> MaybeT (Queries.loadProjectBranchByNames projectName branchName) - Right branchName -> do - projectBranch <- MaybeT (Queries.loadProjectBranchByName currentProjectId branchName) - pure (projectBranch, Right (projectBranch ^. #name)) - case mprojectBranch of - Nothing -> pure [] - Just (projectBranch, prefix) -> do - let branchPath = review ProjectUtils.projectBranchPathPrism (projectAndBranch, mempty) - projectAndBranch = ProjectAndBranch (projectBranch ^. #projectId) (projectBranch ^. #branchId) - map (addBranchPrefix prefix) <$> prefixCompleteNamespace (maybe "" Path.convert mpath) branchPath + map (addBranchPrefix projStuff) <$> prefixCompleteNamespace (maybe "" Path.convert mpath) ppCtx where currentPath = ppCtx ^. PP.absPath_ - currentProjectId = ppCtx ^. PP.ctxAsIds_ . PP.project_ projectBranchToCompletionWithSep :: ProjectName -> (ProjectBranchId, ProjectBranchName) -> Completion projectBranchToCompletionWithSep projectName (_, branchName) = diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 26ca644d01..0d43f1cd92 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -64,7 +64,7 @@ import UnliftIO.STM getUserInput :: Codebase IO Symbol Ann -> AuthenticatedHttpClient -> - PP.ProjectPathCtx -> + PP.ProjectPath -> IO (Branch IO) -> [String] -> IO Input diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs index caf71afbe2..10acc76c96 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs @@ -36,7 +36,7 @@ instance ToSample Current where Current (Just $ UnsafeProjectName "@unison/base") (Just $ UnsafeProjectBranchName "main") - (Path.Absolute $ Path.unsafeParseText ".__projects._53393e4b_1f61_467c_a488_b6068c727daa.branches._f0aec0e3_249f_4004_b836_572fea3981c1") + (Path.Absolute $ Path.unsafeParseText ".my.namespace") ) ] @@ -53,11 +53,11 @@ serveCurrent = lift . getCurrentProjectBranch getCurrentProjectBranch :: MonadIO m => Codebase m v a -> m Current getCurrentProjectBranch codebase = do - ppCtx <- - Codebase.runTransaction codebase Codebase.loadCurrentProjectPathCtx <&> \case + pp <- + Codebase.runTransaction codebase Codebase.loadCurrentProjectPath <&> \case Nothing -> -- TODO: Come up with a better solution for this error "No current project path context" - Just ppCtx -> ppCtx - let (PP.ProjectPath projName branchName path) = ppCtx ^. PP.ctxAsNames_ + Just pp -> pp + let (PP.ProjectPath projName branchName path) = pp ^. PP.asNames_ pure $ Current (Just projName) (Just branchName) path From 2c98ad1b1ed79a4c9c7bea3ee5d1fc698b43677f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 23 May 2024 15:31:38 -0700 Subject: [PATCH 023/631] Checkpoint --- parser-typechecker/src/Unison/Codebase.hs | 25 +++--- .../src/Unison/Codebase/ProjectPath.hs | 32 +++----- unison-cli/src/Unison/Cli/MonadUtils.hs | 18 ++--- unison-cli/src/Unison/Cli/ProjectUtils.hs | 53 +++++-------- .../Codebase/Editor/HandleInput/Branch.hs | 21 +++-- .../Unison/Codebase/Editor/HandleInput/UI.hs | 36 +++------ .../src/Unison/CommandLine/Completion.hs | 4 +- .../src/Unison/CommandLine/FZFResolvers.hs | 2 +- .../src/Unison/CommandLine/InputPatterns.hs | 78 +++++++++---------- unison-cli/src/Unison/CommandLine/Main.hs | 2 +- .../src/Unison/CommandLine/OutputMessages.hs | 7 +- .../src/Unison/Server/CodebaseServer.hs | 8 +- 12 files changed, 114 insertions(+), 172 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index b02dd27494..629988421f 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -50,7 +50,7 @@ module Unison.Codebase getShallowCausalAtPath, getBranchAtPath, Operations.expectCausalBranchByCausalHash, - getShallowCausalFromRoot, + getShallowCausalAtPathFromRootHash, getShallowRootBranch, getShallowRootCausal, getShallowProjectRootBranch, @@ -184,15 +184,13 @@ runTransactionWithRollback :: runTransactionWithRollback Codebase {withConnection} action = withConnection \conn -> Sqlite.runTransactionWithRollback conn action -getShallowCausalFromRoot :: - -- Optional root branch, if Nothing use the codebase's root branch. - Maybe CausalHash -> +getShallowCausalAtPathFromRootHash :: + -- Causal to start at, if Nothing use the codebase's root branch. + CausalHash -> Path.Path -> Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) -getShallowCausalFromRoot mayRootHash p = do - rootCausal <- case mayRootHash of - Nothing -> getShallowRootCausal - Just ch -> Operations.expectCausalBranchByCausalHash ch +getShallowCausalAtPathFromRootHash rootCausalHash p = do + rootCausal <- Operations.expectCausalBranchByCausalHash rootCausalHash getShallowCausalAtPath p (Just rootCausal) -- | Get the shallow representation of the root branches without loading the children or @@ -240,19 +238,18 @@ getShallowBranchAtPath path branch = do childBranch <- V2Causal.value childCausal getShallowBranchAtPath p childBranch -getShallowProjectRootBranch :: Db.ProjectId -> Db.ProjectBranchId -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) -getShallowProjectRootBranch projectId projectBranchId = do - ProjectBranch {causalHashId} <- Q.expectProjectBranch projectId projectBranchId +getShallowProjectRootBranch :: ProjectBranch -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) +getShallowProjectRootBranch ProjectBranch {causalHashId} = do causalHash <- Q.expectCausalHash causalHashId Operations.expectCausalBranchByCausalHash causalHash >>= V2Causal.value -- | Recursively descend into causals following the given path, -- Use the root causal if none is provided. getShallowBranchAtProjectPath :: - PP.ProjectPathIds -> + PP.ProjectPath -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) -getShallowBranchAtProjectPath (PP.ProjectPath projectId projectBranchId path) = do - projectRootBranch <- getShallowProjectRootBranch projectId projectBranchId +getShallowBranchAtProjectPath (PP.ProjectPath _project projectBranch path) = do + projectRootBranch <- getShallowProjectRootBranch projectBranch getShallowBranchAtPath (Path.unabsolute path) projectRootBranch getShallowProjectRootByNames :: ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe (V2Branch.CausalBranch Sqlite.Transaction)) diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index a11b7ccd23..dc6497fd14 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -11,8 +11,6 @@ module Unison.Codebase.ProjectPath asIds_, asNames_, asProjectAndBranch_, - project_, - branch_, ) where @@ -27,11 +25,11 @@ import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) data ProjectPathG proj branch = ProjectPath - { projPathProject :: proj, - projPathBranch :: branch, - projPathPath :: Path.Absolute + { project :: proj, + branch :: branch, + absPath :: Path.Absolute } - deriving stock (Eq, Ord, Show) + deriving stock (Eq, Ord, Show, Generic) type ProjectPathIds = ProjectPathG ProjectId ProjectBranchId @@ -42,18 +40,6 @@ type ProjectPath = ProjectPathG Project ProjectBranch fromProjectAndBranch :: ProjectAndBranch Project ProjectBranch -> Path.Absolute -> ProjectPath fromProjectAndBranch (ProjectAndBranch proj branch) path = ProjectPath proj branch path -project_ :: Lens' (ProjectPathG p b) p -project_ = lens get set - where - get (ProjectPath p _ _) = p - set (ProjectPath _ b path) p = ProjectPath p b path - -branch_ :: Lens' (ProjectPathG p b) b -branch_ = lens get set - where - get (ProjectPath _ b _) = b - set (ProjectPath p _ path) b = ProjectPath p b path - -- | Project a project context into a project path of just IDs asIds_ :: Lens' ProjectPath ProjectPathIds asIds_ = lens get set @@ -61,8 +47,8 @@ asIds_ = lens get set get (ProjectPath proj branch path) = ProjectPath (proj ^. #projectId) (branch ^. #branchId) path set p (ProjectPath pId bId path) = p - & project_ . #projectId .~ pId - & branch_ . #branchId .~ bId + & #project . #projectId .~ pId + & #branch . #branchId .~ bId & absPath_ .~ path -- | Project a project context into a project path of just names @@ -72,15 +58,15 @@ asNames_ = lens get set get (ProjectPath proj branch path) = ProjectPath (proj ^. #name) (branch ^. #name) path set p (ProjectPath pName bName path) = p - & project_ . #name .~ pName - & branch_ . #name .~ bName + & #project . #name .~ pName + & #branch . #name .~ bName & absPath_ .~ path asProjectAndBranch_ :: Lens' ProjectPath (ProjectAndBranch Project ProjectBranch) asProjectAndBranch_ = lens get set where get (ProjectPath proj branch _) = ProjectAndBranch proj branch - set p (ProjectAndBranch proj branch) = p & project_ .~ proj & branch_ .~ branch + set p (ProjectAndBranch proj branch) = p & #project .~ proj & #branch .~ branch instance Bifunctor ProjectPathG where bimap f g (ProjectPath p b path) = ProjectPath (f p) (g b) path diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 6eb5a755f6..29661ee6ac 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -8,7 +8,7 @@ module Unison.Cli.MonadUtils getCurrentPath, getCurrentProjectName, getCurrentProjectBranchName, - getProjectPath, + getCurrentProjectPath, resolvePath, resolvePath', resolveSplit', @@ -95,8 +95,6 @@ import U.Codebase.Branch qualified as V2 (Branch) import U.Codebase.Branch qualified as V2Branch import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash (..)) -import U.Codebase.Sqlite.Project (Project (..)) -import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -146,28 +144,28 @@ getConfig key = do ------------------------------------------------------------------------------------------------------------------------ -- Getting paths, path resolution, etc. -getProjectPath :: Cli PP.ProjectPath -getProjectPath = do +getCurrentProjectPath :: Cli PP.ProjectPath +getCurrentProjectPath = do (PP.ProjectPath projId branchId path) <- Cli.getProjectPathIds -- TODO: Reset to a valid project on error. - (Project {name = projName}, ProjectBranch {name = branchName}) <- fmap (fromMaybe (error $ reportBug "E794202" ("Project branch not found in database for ids: " <> show (projId, branchId)))) . Cli.runTransaction . runMaybeT $ do + (proj, branch) <- fmap (fromMaybe (error $ reportBug "E794202" ("Project branch not found in database for ids: " <> show (projId, branchId)))) . Cli.runTransaction . runMaybeT $ do project <- MaybeT $ Q.loadProject projId branch <- MaybeT $ Q.loadProjectBranch projId branchId pure (project, branch) - pure (PP.ProjectPath (projId, projName) (branchId, branchName) path) + pure (PP.ProjectPath proj branch path) -- | Get the current path relative to the current project. getCurrentPath :: Cli Path.Absolute getCurrentPath = do - view PP.absPath_ <$> getProjectPath + view PP.absPath_ <$> getCurrentProjectPath getCurrentProjectName :: Cli ProjectName getCurrentProjectName = do - view (PP.ctxAsNames_ . PP.project_) <$> getProjectPath + view (PP.asNames_ . #project) <$> getCurrentProjectPath getCurrentProjectBranchName :: Cli ProjectBranchName getCurrentProjectBranchName = do - view (PP.ctxAsNames_ . PP.branch_) <$> getProjectPath + view (PP.asNames_ . #branch) <$> getCurrentProjectPath -- | Resolve a @Path@ (interpreted as relative) to a @Path.Absolute@, per the current path. resolvePath :: Path -> Cli Path.Absolute diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index 6ed7ff03e7..8d9b66c15a 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -13,8 +13,6 @@ module Unison.Cli.ProjectUtils expectProjectAndBranchByIds, getProjectAndBranchByTheseNames, expectProjectAndBranchByTheseNames, - getCurrentProject, - getCurrentProjectBranch, -- * Loading remote project info expectRemoteProjectById, @@ -40,7 +38,6 @@ import Data.These (These (..)) import U.Codebase.Sqlite.DbId import U.Codebase.Sqlite.Project (Project) import U.Codebase.Sqlite.Project qualified as Sqlite -import U.Codebase.Sqlite.ProjectBranch (ProjectBranch) import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) @@ -66,13 +63,13 @@ resolveBranchRelativePath brp = do case brp of BranchPathInCurrentProject projBranchName path -> do projectAndBranch <- expectProjectAndBranchByTheseNames (That projBranchName) - pure $ PP.ctxFromProjectAndBranch projectAndBranch path + pure $ PP.fromProjectAndBranch projectAndBranch path QualifiedBranchPath projName projBranchName path -> do projectAndBranch <- expectProjectAndBranchByTheseNames (These projName projBranchName) - pure $ PP.ctxFromProjectAndBranch projectAndBranch path + pure $ PP.fromProjectAndBranch projectAndBranch path UnqualifiedPath newPath' -> do - ppCtx <- Cli.getProjectPath - pure $ ppCtx & PP.absPath_ %~ \curPath -> Path.resolve curPath newPath' + pp <- Cli.getCurrentProjectPath + pure $ pp & PP.absPath_ %~ \curPath -> Path.resolve curPath newPath' -- @findTemporaryBranchName projectId preferred@ finds some unused branch name in @projectId@ with a name -- like @preferred@. @@ -95,20 +92,6 @@ findTemporaryBranchName projectId preferred = do pure (fromJust (List.find (\name -> not (Set.member name allBranchNames)) allCandidates)) --- | Get the current project+branch+branch path that a user is on. -getCurrentProjectBranch :: Cli (PP.ProjectPath Sqlite.Project Sqlite.ProjectBranch) -getCurrentProjectBranch = do - ppCtx <- Cli.getProjectPath - Cli.runTransaction $ do - proj <- Queries.expectProject (ppCtx ^. PP.ctxAsIds_ . PP.project_) - branch <- Queries.expectProjectBranch (proj ^. #projectId) (ppCtx ^. PP.ctxAsIds_ . PP.branch_) - pure $ PP.ProjectPath proj branch (ppCtx ^. PP.absPath_) - -getCurrentProject :: Cli Sqlite.Project -getCurrentProject = do - ppCtx <- Cli.getProjectPath - Cli.runTransaction (Queries.expectProject (ppCtx ^. PP.ctxAsIds_ . PP.project_)) - expectProjectBranchByName :: Sqlite.Project -> ProjectBranchName -> Cli Sqlite.ProjectBranch expectProjectBranchByName project branchName = Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName) & onNothingM do @@ -124,8 +107,8 @@ hydrateNames :: These ProjectName ProjectBranchName -> Cli (ProjectAndBranch Pro hydrateNames = \case This projectName -> pure (ProjectAndBranch projectName (unsafeFrom @Text "main")) That branchName -> do - ppCtx <- Cli.getProjectPath - pure (ProjectAndBranch (ppCtx ^. PP.ctxAsNames_ . PP.project_) branchName) + pp <- Cli.getCurrentProjectPath + pure (ProjectAndBranch (pp ^. PP.asNames_ . #project) branchName) These projectName branchName -> pure (ProjectAndBranch projectName branchName) -- Expect a local project+branch by ids. @@ -147,9 +130,9 @@ getProjectAndBranchByTheseNames :: getProjectAndBranchByTheseNames = \case This projectName -> getProjectAndBranchByTheseNames (These projectName (unsafeFrom @Text "main")) That branchName -> runMaybeT do - currentProjectBranch <- lift getCurrentProjectBranch - branch <- MaybeT (Cli.runTransaction (Queries.loadProjectBranchByName (currentProjectBranch ^. PP.project_ . #projectId) branchName)) - pure (ProjectAndBranch (currentProjectBranch ^. PP.project_) branch) + (PP.ProjectPath proj _branch _path) <- lift Cli.getCurrentProjectPath + branch <- MaybeT (Cli.runTransaction (Queries.loadProjectBranchByName (proj ^. #projectId) branchName)) + pure (ProjectAndBranch proj branch) These projectName branchName -> do Cli.runTransaction do runMaybeT do @@ -167,7 +150,7 @@ expectProjectAndBranchByTheseNames :: expectProjectAndBranchByTheseNames = \case This projectName -> expectProjectAndBranchByTheseNames (These projectName (unsafeFrom @Text "main")) That branchName -> do - PP.ProjectPath project _branch _restPath <- getCurrentProjectBranch + PP.ProjectPath project _branch _restPath <- Cli.getCurrentProjectPath branch <- Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName) & onNothingM do Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch (project ^. #name) branchName)) @@ -188,21 +171,21 @@ expectProjectAndBranchByTheseNames = \case -- 2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the current -- project, defaulting to 'main' if branch is unspecified. -- 3. If we just have a path, resolve it using the current project. -resolveProjectPath :: PP.ProjectPath -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Maybe Path' -> Cli PP.ProjectPath -resolveProjectPath ppCtx mayProjAndBranch mayPath' = do - projAndBranch <- resolveProjectBranch ppCtx mayProjAndBranch +resolveProjectPath :: Project -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Maybe Path' -> Cli PP.ProjectPath +resolveProjectPath defaultProj mayProjAndBranch mayPath' = do + projAndBranch <- resolveProjectBranch defaultProj mayProjAndBranch absPath <- fromMaybe Path.absoluteEmpty <$> traverse Cli.resolvePath' mayPath' - pure $ PP.ctxFromProjectAndBranch projAndBranch absPath + pure $ PP.fromProjectAndBranch projAndBranch absPath -- | Expect/resolve branch reference with the following rules: -- -- 1. If the project is missing, use the provided project. -- 2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the provided -- project, defaulting to 'main' if branch is unspecified. -resolveProjectBranch :: ProjectAndBranch Project ProjectBranch -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -resolveProjectBranch ppCtx (ProjectAndBranch mayProjectName mayBranchName) = do +resolveProjectBranch :: Project -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) +resolveProjectBranch defaultProj (ProjectAndBranch mayProjectName mayBranchName) = do let branchName = fromMaybe (unsafeFrom @Text "main") mayBranchName - let projectName = fromMaybe (ppCtx ^. PP.ctxAsNames_ . PP.project_) mayProjectName + let projectName = fromMaybe (defaultProj ^. #name) mayProjectName projectAndBranch <- expectProjectAndBranchByTheseNames (These projectName branchName) pure projectAndBranch @@ -289,7 +272,7 @@ expectRemoteProjectBranchByTheseNames includeSquashed = \case let remoteBranchName = unsafeFrom @Text "main" expectRemoteProjectBranchByName includeSquashed (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName) That branchName -> do - PP.ProjectPath localProject localBranch _restPath <- getCurrentProjectBranch + PP.ProjectPath localProject localBranch _restPath <- Cli.getCurrentProjectPath let localProjectId = localProject ^. #projectId let localBranchId = localBranch ^. #branchId Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 8df791dec7..1393ce8ff7 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -18,10 +18,8 @@ import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch qualified as Branch (headHash) import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectBranchNameKind (..), ProjectName, classifyProjectBranchName) @@ -41,7 +39,7 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB Cli.returnEarly (Output.CannotCreateReleaseBranchWithBranchCommand newBranchName ver) ProjectBranchNameKind'NothingSpecial -> pure () - currentProjectName <- Cli.getProjectPath <&> view (PP.ctxAsNames_ . PP.project_) + currentProjectName <- Cli.getCurrentProjectPath <&> view (PP.asNames_ . #project) destProject <- do Cli.runTransactionWithRollback \rollback -> do @@ -51,22 +49,21 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName newBranchName)) -- Compute what we should create the branch from. - maySrcBranch <- + maySrcProjectAndBranch <- case sourceI of - Input.BranchSourceI'CurrentContext -> Just <$> ProjectUtils.getCurrentProjectBranch + Input.BranchSourceI'CurrentContext -> Just . view PP.projectAndBranch_ <$> Cli.getCurrentProjectPath Input.BranchSourceI'Empty -> pure Nothing Input.BranchSourceI'UnresolvedProjectBranch unresolvedProjectBranch -> do - ppCtx <- Cli.getProjectPath - ProjectAndBranch _proj branch <- ProjectUtils.resolveProjectBranch ppCtx (unresolvedProjectBranch & #branch %~ Just) - pure $ Just branch + pp <- Cli.getCurrentProjectPath + Just <$> ProjectUtils.resolveProjectBranch (pp ^. #project) (unresolvedProjectBranch & #branch %~ Just) - _ <- doCreateBranch maySrcBranch project newBranchName + _ <- doCreateBranch (view #branch <$> maySrcProjectAndBranch) destProject newBranchName Cli.respond $ Output.CreatedProjectBranch - ( case maySrcBranch of + ( case maySrcProjectAndBranch of Just sourceBranch -> - if sourceBranch ^. #project . #projectId == project ^. #projectId + if sourceBranch ^. #project . #projectId == destProject ^. #projectId then Output.CreatedProjectBranchFrom'ParentBranch (sourceBranch ^. #branch . #name) else Output.CreatedProjectBranchFrom'OtherBranch sourceBranch Nothing -> Output.CreatedProjectBranchFrom'Nothingness @@ -86,7 +83,7 @@ doCreateBranch :: -- If no parent branch is provided, make an empty branch. Maybe Sqlite.ProjectBranch -> Sqlite.Project -> - Sqlite.Transaction ProjectBranchName -> + ProjectBranchName -> Cli ProjectBranchId doCreateBranch mayParentBranch project getNewBranchName = do let projectId = project ^. #projectId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/UI.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/UI.hs index 85ce5922f5..9a6c5dcb3f 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/UI.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/UI.hs @@ -21,6 +21,7 @@ import Unison.Cli.ProjectUtils qualified as Project import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions import Unison.ConstructorType qualified as ConstructorType import Unison.HashQualified qualified as HQ @@ -28,8 +29,7 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Parser.Ann (Ann (..)) import Unison.Prelude -import Unison.Project (ProjectAndBranch) -import Unison.Project.Util (projectBranchPath) +import Unison.Project (ProjectAndBranch (ProjectAndBranch)) import Unison.Referent qualified as Referent import Unison.Server.CodebaseServer qualified as Server import Unison.Sqlite qualified as Sqlite @@ -39,37 +39,25 @@ import Web.Browser (openBrowser) openUI :: Path.Path' -> Cli () openUI path' = do Cli.Env {serverBaseUrl} <- ask - currentPath <- Cli.getCurrentPath - let absPath = Path.resolve currentPath path' + defnPath <- Cli.resolvePath' path' + pp <- Cli.getCurrentProjectPath whenJust serverBaseUrl \url -> do - Project.getProjectBranchForPath absPath >>= \case - Nothing -> openUIForLooseCode url path' - Just (projectBranch, pathWithinBranch) -> openUIForProject url projectBranch pathWithinBranch + openUIForProject url pp defnPath -openUIForProject :: Server.BaseUrl -> ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> Path.Path -> Cli () -openUIForProject url projectAndBranch pathFromProjectRoot = do - currentPath <- Cli.getCurrentPath - perspective <- - Project.getProjectBranchForPath currentPath <&> \case - Nothing -> - -- The current path is outside the project the argument was in. Use the project root - -- as the perspective. - Path.empty - Just (_projectBranch, pathWithinBranch) -> pathWithinBranch +openUIForProject :: Server.BaseUrl -> PP.ProjectPath -> Path.Absolute -> Cli () +openUIForProject url (PP.ProjectPath project projectBranch perspective) defnPath = do mayDefinitionRef <- getDefinitionRef perspective - let projectBranchNames = bimap Project.name ProjectBranch.name projectAndBranch + let projectBranchNames = bimap Project.name ProjectBranch.name (ProjectAndBranch project projectBranch) _success <- liftIO . openBrowser . Text.unpack $ Server.urlFor (Server.ProjectBranchUI projectBranchNames perspective mayDefinitionRef) url pure () where - pathToBranchFromCodebaseRoot :: Path.Absolute - pathToBranchFromCodebaseRoot = projectBranchPath (bimap Project.projectId ProjectBranch.branchId projectAndBranch) -- If the provided ui path matches a definition, find it. - getDefinitionRef :: Path.Path -> Cli (Maybe (Server.DefinitionReference)) + getDefinitionRef :: Path.Absolute -> Cli (Maybe (Server.DefinitionReference)) getDefinitionRef perspective = runMaybeT $ do Cli.Env {codebase} <- lift ask - let absPathToDefinition = Path.unabsolute $ Path.resolve pathToBranchFromCodebaseRoot (Path.Relative pathFromProjectRoot) - (pathToDefinitionNamespace, _nameSeg) <- hoistMaybe $ Lens.unsnoc absPathToDefinition - namespaceBranch <- lift $ Cli.runTransaction (Codebase.getShallowBranchAtPath pathToDefinitionNamespace Nothing) + (pathToDefinitionNamespace, _nameSeg) <- hoistMaybe $ Lens.unsnoc defnPath + let defnNamespaceProjectPath = pp & PP.absPath_ .~ pathToDefinitionNamespace + namespaceBranch <- lift . Cli.runTransaction $ Codebase.getShallowBranchAtProjectPath defnNamespaceProjectPath fqn <- hoistMaybe $ do pathFromPerspective <- List.stripPrefix (Path.toList perspective) (Path.toList pathFromProjectRoot) Path.toName . Path.fromList $ pathFromPerspective diff --git a/unison-cli/src/Unison/CommandLine/Completion.hs b/unison-cli/src/Unison/CommandLine/Completion.hs index bd0cf9c0e0..7249aea28c 100644 --- a/unison-cli/src/Unison/CommandLine/Completion.hs +++ b/unison-cli/src/Unison/CommandLine/Completion.hs @@ -101,7 +101,7 @@ noCompletions :: String -> Codebase m v a -> AuthenticatedHttpClient -> - Path.Absolute -> + PP.ProjectPath -> m [System.Console.Haskeline.Completion.Completion] noCompletions _ _ _ _ = pure [] @@ -145,7 +145,7 @@ completeWithinNamespace :: Sqlite.Transaction [System.Console.Haskeline.Completion.Completion] completeWithinNamespace compTypes query ppCtx = do shortHashLen <- Codebase.hashLength - b <- Codebase.getShallowBranchAtProjectPath (queryProjectPath ^. PP.ctxAsIds_) + b <- Codebase.getShallowBranchAtProjectPath (queryProjectPath ^. PP.asIds_) currentBranchSuggestions <- do nib <- namesInBranch shortHashLen b nib diff --git a/unison-cli/src/Unison/CommandLine/FZFResolvers.hs b/unison-cli/src/Unison/CommandLine/FZFResolvers.hs index 2d3b8a8216..704fdc2b33 100644 --- a/unison-cli/src/Unison/CommandLine/FZFResolvers.hs +++ b/unison-cli/src/Unison/CommandLine/FZFResolvers.hs @@ -177,7 +177,7 @@ projectBranchOptions codebase _projCtx _searchBranch0 = do -- E.g. '@unison/base/main' projectBranchOptionsWithinCurrentProject :: OptionFetcher projectBranchOptionsWithinCurrentProject codebase projCtx _searchBranch0 = do - Codebase.runTransaction codebase (Q.loadAllProjectBranchesBeginningWith (projCtx ^. PP.asIds_ . PP.project_) Nothing) + Codebase.runTransaction codebase (Q.loadAllProjectBranchesBeginningWith (projCtx ^. PP.asIds_ . #project) Nothing) <&> fmap (into @Text . snd) -- | Exported from here just so the debug command and actual implementation can use the same diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 45208c2547..93f8f58e18 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -147,7 +147,7 @@ module Unison.CommandLine.InputPatterns ) where -import Control.Lens ((^.)) +import Control.Lens ((.~), (^.)) import Control.Lens.Cons qualified as Cons import Data.List (intercalate) import Data.List.Extra qualified as List @@ -1840,7 +1840,7 @@ mergeOldSquashInputPattern = [src, dest] -> do src <- parseUnresolvedProjectBranch src dest <- parseUnresolvedProjectBranch dest - Just $ Input.MergeLocalBranchI src dest Branch.SquashMerge + Just $ Input.MergeLocalBranchI src (Just dest) Branch.SquashMerge _ -> Nothing } where @@ -3349,7 +3349,7 @@ namespaceOrProjectBranchArg config = ArgumentType { typeName = "namespace or branch", suggestions = - let namespaceSuggestions = \q cb _http ppCtx -> Codebase.runTransaction cb (prefixCompleteNamespace q ppCtx) + let namespaceSuggestions = \q cb _http pp -> Codebase.runTransaction cb (prefixCompleteNamespace q pp) in unionSuggestions [ projectAndOrBranchSuggestions config, namespaceSuggestions @@ -3375,8 +3375,8 @@ dependencyArg :: ArgumentType dependencyArg = ArgumentType { typeName = "project dependency", - suggestions = \q cb _http p -> Codebase.runTransaction cb do - prefixCompleteNamespace q (p Path.:> NameSegment.libSegment), + suggestions = \q cb _http pp -> Codebase.runTransaction cb do + prefixCompleteNamespace q (pp & PP.path_ .~ Path.singleton NameSegment.libSegment), fzfResolver = Just Resolvers.projectDependencyResolver } @@ -3464,12 +3464,12 @@ projectAndOrBranchSuggestions :: AuthenticatedHttpClient -> ProjectPath -> m [Line.Completion] -projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do +projectAndOrBranchSuggestions config inputStr codebase _httpClient pp = do case Text.uncons input of -- Things like "/foo" would be parsed as unambiguous branches in the logic below, except we also want to -- handle "/" and "/@" inputs, which aren't valid branch names, but are valid branch prefixes. So, -- if the input begins with a forward slash, just rip it off and treat the rest as the branch prefix. - Just ('/', input1) -> handleBranchesComplete input1 codebase path + Just ('/', input1) -> handleBranchesComplete input1 codebase pp _ -> case tryInto @ProjectAndBranchNames input of -- This case handles inputs like "", "@", and possibly other things that don't look like a valid project @@ -3490,12 +3490,12 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do Nothing -> pure [] Just project -> do let projectId = project ^. #projectId - fmap (filterBranches config path) do + fmap (filterBranches config pp) do Queries.loadAllProjectBranchesBeginningWith projectId Nothing pure (map (projectBranchToCompletion projectName) branches) -- This branch is probably dead due to intercepting inputs that begin with "/" above Right (ProjectAndBranchNames'Unambiguous (That branchName)) -> - handleBranchesComplete (into @Text branchName) codebase path + handleBranchesComplete (into @Text branchName) codebase pp Right (ProjectAndBranchNames'Unambiguous (These projectName branchName)) -> do branches <- Codebase.runTransaction codebase do @@ -3503,12 +3503,11 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do Nothing -> pure [] Just project -> do let projectId = project ^. #projectId - fmap (filterBranches config path) do + fmap (filterBranches config pp) do Queries.loadAllProjectBranchesBeginningWith projectId (Just $ into @Text branchName) pure (map (projectBranchToCompletion projectName) branches) where input = Text.strip . Text.pack $ inputStr - currentProjectId = ppCtx ^. (PP.ctxAsIds_ . PP.project_) handleAmbiguousComplete :: MonadIO m => @@ -3519,14 +3518,10 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do (branches, projects) <- Codebase.runTransaction codebase do branches <- - case mayCurrentProjectId of - Nothing -> pure [] - Just currentProjectId -> - fmap (filterBranches config path) do - Queries.loadAllProjectBranchesBeginningWith currentProjectId (Just input) - projects <- case (projectInclusion config, mayCurrentProjectId) of - (OnlyWithinCurrentProject, Just currentProjectId) -> Queries.loadProject currentProjectId <&> maybeToList - (OnlyWithinCurrentProject, Nothing) -> pure [] + fmap (filterBranches config pp) do + Queries.loadAllProjectBranchesBeginningWith currentProjectId (Just input) + projects <- case projectInclusion config of + OnlyWithinCurrentProject -> Queries.loadProject currentProjectId <&> maybeToList _ -> Queries.loadAllProjectsBeginningWith (Just input) <&> filterProjects pure (branches, projects) let branchCompletions = map currentProjectBranchToCompletion branches @@ -3602,25 +3597,26 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient ppCtx = do -- Complete the text into a branch name within the provided project handleBranchesComplete :: MonadIO m => Text -> Codebase m v a -> PP.ProjectPath -> m [Completion] - handleBranchesComplete branchName codebase ppCtx = do - let projId = ppCtx ^. PP.ctxAsIds_ . PP.project_ + handleBranchesComplete branchName codebase pp = do + let projId = pp ^. PP.asIds_ . #project branches <- Codebase.runTransaction codebase do - fmap (filterBranches config path) do + fmap (filterBranches config pp) do Queries.loadAllProjectBranchesBeginningWith projId (Just branchName) pure (map currentProjectBranchToCompletion branches) filterProjects :: [Sqlite.Project] -> [Sqlite.Project] filterProjects projects = - case (mayCurrentProjectId, projectInclusion config) of - (_, AllProjects) -> projects - (Nothing, _) -> projects - (Just currentProjId, OnlyOutsideCurrentProject) -> projects & filter (\Sqlite.Project {projectId} -> projectId /= currentProjId) - (Just currentBranchId, OnlyWithinCurrentProject) -> + case (projectInclusion config) of + AllProjects -> projects + OnlyOutsideCurrentProject -> projects & filter (\Sqlite.Project {projectId} -> projectId /= currentProjectId) + OnlyWithinCurrentProject -> projects - & List.find (\Sqlite.Project {projectId} -> projectId == currentBranchId) + & List.find (\Sqlite.Project {projectId} -> projectId == currentProjectId) & maybeToList + PP.ProjectPath currentProjectId _currentBranchId _currentPath = pp ^. PP.asIds_ + projectToCompletion :: Sqlite.Project -> Completion projectToCompletion project = Completion @@ -3646,20 +3642,20 @@ handleBranchesComplete :: Codebase m v a -> PP.ProjectPath -> m [Completion] -handleBranchesComplete config branchName codebase ppCtx = do +handleBranchesComplete config branchName codebase pp = do branches <- Codebase.runTransaction codebase do - fmap (filterBranches config ppCtx) do - Queries.loadAllProjectBranchesBeginningWith (ppCtx ^. PP.ctxAsIds_ . PP.project_) (Just branchName) + fmap (filterBranches config pp) do + Queries.loadAllProjectBranchesBeginningWith (pp ^. PP.asIds_ . #project) (Just branchName) pure (map currentProjectBranchToCompletion branches) filterBranches :: ProjectBranchSuggestionsConfig -> PP.ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)] -filterBranches config ppCtx branches = +filterBranches config pp branches = case (branchInclusion config) of AllBranches -> branches ExcludeCurrentBranch -> branches & filter (\(branchId, _) -> branchId /= currentBranchId) where - currentBranchId = ppCtx ^. PP.ctxAsIds_ . PP.branch_ + currentBranchId = pp ^. PP.asIds_ . #branch currentProjectBranchToCompletion :: (ProjectBranchId, ProjectBranchName) -> Completion currentProjectBranchToCompletion (_, branchName) = @@ -3677,20 +3673,20 @@ branchRelativePathSuggestions :: AuthenticatedHttpClient -> PP.ProjectPath -> m [Line.Completion] -branchRelativePathSuggestions config inputStr codebase _httpClient ppCtx = do +branchRelativePathSuggestions config inputStr codebase _httpClient pp = do case parseIncrementalBranchRelativePath inputStr of Left _ -> pure [] Right ibrp -> case ibrp of BranchRelativePath.ProjectOrPath' _txt _path -> do - namespaceSuggestions <- Codebase.runTransaction codebase (prefixCompleteNamespace inputStr currentPath) + namespaceSuggestions <- Codebase.runTransaction codebase (prefixCompleteNamespace inputStr pp) projectSuggestions <- projectNameSuggestions WithSlash inputStr codebase pure (namespaceSuggestions ++ projectSuggestions) BranchRelativePath.OnlyPath' _path -> - Codebase.runTransaction codebase (prefixCompleteNamespace inputStr currentPath) + Codebase.runTransaction codebase (prefixCompleteNamespace inputStr pp) BranchRelativePath.IncompleteProject _proj -> projectNameSuggestions WithSlash inputStr codebase BranchRelativePath.IncompleteBranch mproj mbranch -> case mproj of - Nothing -> map suffixPathSep <$> handleBranchesComplete config (maybe "" into mbranch) codebase ppCtx + Nothing -> map suffixPathSep <$> handleBranchesComplete config (maybe "" into mbranch) codebase pp Just projectName -> do branches <- Codebase.runTransaction codebase do @@ -3698,18 +3694,16 @@ branchRelativePathSuggestions config inputStr codebase _httpClient ppCtx = do Nothing -> pure [] Just project -> do let projectId = project ^. #projectId - fmap (filterBranches config ppCtx) do + fmap (filterBranches config pp) do Queries.loadAllProjectBranchesBeginningWith projectId (into @Text <$> mbranch) pure (map (projectBranchToCompletionWithSep projectName) branches) BranchRelativePath.PathRelativeToCurrentBranch relPath -> Codebase.runTransaction codebase do -- TODO: Verify this works as intendid - map prefixPathSep <$> prefixCompleteNamespace (Path.convert relPath) mempty + map prefixPathSep <$> prefixCompleteNamespace (Path.convert relPath) pp BranchRelativePath.IncompletePath projStuff mpath -> do Codebase.runTransaction codebase do - map (addBranchPrefix projStuff) <$> prefixCompleteNamespace (maybe "" Path.convert mpath) ppCtx + map (addBranchPrefix projStuff) <$> prefixCompleteNamespace (maybe "" Path.convert mpath) pp where - currentPath = ppCtx ^. PP.absPath_ - projectBranchToCompletionWithSep :: ProjectName -> (ProjectBranchId, ProjectBranchName) -> Completion projectBranchToCompletionWithSep projectName (_, branchName) = Completion diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 0d43f1cd92..78873f0d65 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -83,7 +83,7 @@ getUserInput codebase authHTTPClient ppCtx currentProjectRoot numberedArgs = Just a -> pure a go :: Line.InputT IO Input go = do - let (PP.ProjectPath projectName projectBranchName path) = ppCtx ^. PP.ctxAsNames_ + let (PP.ProjectPath projectName projectBranchName path) = ppCtx ^. PP.asNames_ let promptString = P.sep ":" diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index b3d0e49907..08777b6c98 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -45,7 +45,6 @@ import Unison.Auth.Types qualified as Auth import Unison.Builtin.Decls qualified as DD import Unison.Cli.MergeTypes (MergeSourceAndTarget (..)) import Unison.Cli.Pretty -import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Cli.ServantClientUtils qualified as ServantClientUtils import Unison.Codebase.Editor.DisplayObject (DisplayObject (..)) import Unison.Codebase.Editor.Input qualified as Input @@ -455,7 +454,7 @@ notifyNumbered = \case ) where switch = IP.makeExample IP.projectSwitch - AmbiguousReset sourceOfAmbiguity (ProjectAndBranch pn0 bn0, path) (ProjectAndBranch currentProject branch) -> + AmbiguousReset sourceOfAmbiguity (ProjectAndBranch _pn0 _bn0, path) (ProjectAndBranch currentProject branch) -> ( P.wrap ( openingLine <> prettyProjectAndBranchName (ProjectAndBranch currentProject branch) @@ -495,7 +494,7 @@ notifyNumbered = \case E.AmbiguousReset'Target -> \xs -> "" : xs reset = IP.makeExample IP.reset relPath0 = prettyPath path - absPath0 = review ProjectUtils.projectBranchPathPrism (ProjectAndBranch (pn0 ^. #projectId) (bn0 ^. #branchId), path) + absPath0 = Path.Absolute path ListNamespaceDependencies _ppe _path Empty -> ("This namespace has no external dependencies.", mempty) ListNamespaceDependencies ppe path' externalDependencies -> ( P.column2Header (P.hiBlack "External dependency") ("Dependents in " <> prettyAbsolute path') $ @@ -910,7 +909,7 @@ notifyUser dir = \case prettyProjectAndBranchName projectAndBranch <> "is empty. There is nothing to push." CreatedNewBranch path -> pure $ - "☝️ The namespace " <> prettyAbsoluteStripProject path <> " is empty." + "☝️ The namespace " <> prettyAbsolute path <> " is empty." -- RenameOutput rootPath oldName newName r -> do -- nameChange "rename" "renamed" oldName newName r -- AliasOutput rootPath existingName newName r -> do diff --git a/unison-share-api/src/Unison/Server/CodebaseServer.hs b/unison-share-api/src/Unison/Server/CodebaseServer.hs index 6ad9c77e6b..f634360db1 100644 --- a/unison-share-api/src/Unison/Server/CodebaseServer.hs +++ b/unison-share-api/src/Unison/Server/CodebaseServer.hs @@ -239,7 +239,7 @@ data DefinitionReference data Service = LooseCodeUI Path.Absolute (Maybe DefinitionReference) | -- (Project branch names, perspective within project, definition reference) - ProjectBranchUI (ProjectAndBranch ProjectName ProjectBranchName) Path.Path (Maybe DefinitionReference) + ProjectBranchUI (ProjectAndBranch ProjectName ProjectBranchName) Path.Absolute (Maybe DefinitionReference) | Api deriving stock (Show) @@ -299,13 +299,13 @@ urlFor :: Service -> BaseUrl -> Text urlFor service baseUrl = case service of LooseCodeUI perspective def -> - tShow baseUrl <> "/" <> toUrlPath ([DontEscape "ui", DontEscape "non-project-code"] <> path (Path.unabsolute perspective) def) + tShow baseUrl <> "/" <> toUrlPath ([DontEscape "ui", DontEscape "non-project-code"] <> path perspective def) ProjectBranchUI (ProjectAndBranch projectName branchName) perspective def -> tShow baseUrl <> "/" <> toUrlPath ([DontEscape "ui", DontEscape "projects", DontEscape $ into @Text projectName, DontEscape $ into @Text branchName] <> path perspective def) Api -> tShow baseUrl <> "/" <> toUrlPath [DontEscape "api"] where - path :: Path.Path -> Maybe DefinitionReference -> [URISegment] - path ns def = + path :: Path.Absolute -> Maybe DefinitionReference -> [URISegment] + path (Path.Absolute ns) def = let nsPath = namespacePath ns in case definitionPath def of Just defPath -> case nsPath of From b9c62164f868b7e9f0e04e5032d0256c5727fabe Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 24 May 2024 15:50:17 -0600 Subject: [PATCH 024/631] Restrict `NameSegment` operations With `OverloadedStrings` enabled globally and an `IsString` instance, the `newtype` was rendered useless. This extracts the `NameSegment` constructor/eliminator to a `.Internal` module, has `Unison.NameSegment` only re-export the type, and moves the `*Segment` members to `Unison.Syntax.NameSegment`. This forces cascading changes, including eliminating a bunch of magic literals scattered throughout the code. --- .../src/Unison/Hashing/V2/Convert2.hs | 2 +- .../U/Codebase/Sqlite/Operations.hs | 17 ++-- .../U/Codebase/Sqlite/Queries.hs | 8 +- codebase2/core/Unison/NameSegment.hs | 52 ++---------- codebase2/core/Unison/NameSegment/Internal.hs | 21 +++++ codebase2/core/unison-core.cabal | 3 +- .../src/Unison/Codebase/Editor/RemoteRepo.hs | 4 +- .../Codebase/SqliteCodebase/Operations.hs | 2 +- .../src/Unison/Hashing/V2/Convert.hs | 11 +-- .../src/Unison/PrettyPrintEnvDecl/Sqlite.hs | 2 +- parser-typechecker/src/Unison/PrintError.hs | 3 +- parser-typechecker/src/Unison/Project/Util.hs | 10 +-- .../src/Unison/Syntax/DeclPrinter.hs | 24 +++--- .../src/Unison/Syntax/FileParser.hs | 3 +- .../src/Unison/Syntax/TermParser.hs | 11 ++- .../tests/Unison/Core/Test/Name.hs | 31 ++++---- .../tests/Unison/Test/Codebase/Branch.hs | 9 ++- .../tests/Unison/Test/Codebase/Path.hs | 14 ++-- unison-cli/src/Unison/Cli/DownloadUtils.hs | 2 +- unison-cli/src/Unison/Cli/Monad.hs | 3 +- unison-cli/src/Unison/Cli/MonadUtils.hs | 2 +- unison-cli/src/Unison/Cli/Pretty.hs | 4 +- .../src/Unison/Cli/UniqueTypeGuidLookup.hs | 4 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 19 +++-- .../Codebase/Editor/HandleInput/InstallLib.hs | 6 +- .../Codebase/Editor/HandleInput/Merge2.hs | 13 +-- .../Editor/HandleInput/ProjectCreate.hs | 4 +- .../Codebase/Editor/HandleInput/Pull.hs | 2 +- .../Codebase/Editor/HandleInput/Push.hs | 3 +- .../Codebase/Editor/HandleInput/Update2.hs | 8 +- .../src/Unison/Codebase/Editor/UriParser.hs | 20 +++-- .../src/Unison/CommandLine/Completion.hs | 2 +- .../src/Unison/CommandLine/OutputMessages.hs | 9 +-- unison-cli/src/Unison/LSP/Completion.hs | 10 +-- unison-cli/tests/Unison/Test/UriParser.hs | 34 +++++--- unison-core/src/Unison/Name.hs | 4 +- unison-share-api/src/Unison/Server/Backend.hs | 28 +++---- unison-share-api/src/Unison/Server/Local.hs | 17 ++-- .../Local/Endpoints/DefinitionSummary.hs | 2 +- .../Local/Endpoints/NamespaceDetails.hs | 3 +- .../src/Unison/Server/NameSearch/Sqlite.hs | 2 +- unison-share-api/src/Unison/Server/Orphans.hs | 2 +- unison-syntax/src/Unison/Syntax/Lexer.hs | 6 +- .../src/Unison/Syntax/NameSegment.hs | 79 ++++++++++++++++++- 44 files changed, 296 insertions(+), 219 deletions(-) create mode 100644 codebase2/core/Unison/NameSegment/Internal.hs diff --git a/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs b/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs index d33dde8515..53b4b72473 100644 --- a/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs +++ b/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs @@ -36,7 +36,7 @@ import U.Codebase.Type qualified as V2.Type import U.Core.ABT qualified as ABT import Unison.Hash (Hash) import Unison.Hashing.V2 qualified as H2 -import Unison.NameSegment (NameSegment (..)) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Prelude import Unison.Symbol qualified as Unison import Unison.Util.Map qualified as Map diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index 556bb5327f..b402620333 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -201,6 +201,7 @@ import U.Util.Serialization qualified as S import Unison.Hash qualified as H import Unison.Hash32 qualified as Hash32 import Unison.NameSegment (NameSegment) +import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.ShortHash (ShortCausalHash (..), ShortNamespaceHash (..)) import Unison.Sqlite @@ -243,13 +244,13 @@ loadRootCausalHash = -- | Load the causal hash at the given path from the provided root, if Nothing, use the -- codebase root. -loadCausalHashAtPath :: Maybe CausalHash -> Q.TextPathSegments -> Transaction (Maybe CausalHash) +loadCausalHashAtPath :: Maybe CausalHash -> [NameSegment] -> Transaction (Maybe CausalHash) loadCausalHashAtPath mayRootCausalHash = - let go :: Db.CausalHashId -> [Text] -> MaybeT Transaction CausalHash + let go :: Db.CausalHashId -> [NameSegment] -> MaybeT Transaction CausalHash go hashId = \case [] -> lift (Q.expectCausalHash hashId) t : ts -> do - tid <- MaybeT (Q.loadTextId t) + tid <- MaybeT (Q.loadTextId $ NameSegment.toUnescapedText t) S.Branch {children} <- MaybeT (loadDbBranchByCausalHashId hashId) (_, hashId') <- MaybeT (pure (Map.lookup tid children)) go hashId' ts @@ -261,13 +262,13 @@ loadCausalHashAtPath mayRootCausalHash = -- | Expect the causal hash at the given path from the provided root, if Nothing, use the -- codebase root. -expectCausalHashAtPath :: Maybe CausalHash -> Q.TextPathSegments -> Transaction CausalHash +expectCausalHashAtPath :: Maybe CausalHash -> [NameSegment] -> Transaction CausalHash expectCausalHashAtPath mayRootCausalHash = - let go :: Db.CausalHashId -> [Text] -> Transaction CausalHash + let go :: Db.CausalHashId -> [NameSegment] -> Transaction CausalHash go hashId = \case [] -> Q.expectCausalHash hashId t : ts -> do - tid <- Q.expectTextId t + tid <- Q.expectTextId $ NameSegment.toUnescapedText t S.Branch {children} <- expectDbBranchByCausalHashId hashId let (_, hashId') = children Map.! tid go hashId' ts @@ -279,14 +280,14 @@ expectCausalHashAtPath mayRootCausalHash = loadCausalBranchAtPath :: Maybe CausalHash -> - Q.TextPathSegments -> + [NameSegment] -> Transaction (Maybe (C.Branch.CausalBranch Transaction)) loadCausalBranchAtPath maybeRootCausalHash path = loadCausalHashAtPath maybeRootCausalHash path >>= \case Nothing -> pure Nothing Just causalHash -> Just <$> expectCausalBranchByCausalHash causalHash -loadBranchAtPath :: Maybe CausalHash -> Q.TextPathSegments -> Transaction (Maybe (C.Branch.Branch Transaction)) +loadBranchAtPath :: Maybe CausalHash -> [NameSegment] -> Transaction (Maybe (C.Branch.Branch Transaction)) loadBranchAtPath maybeRootCausalHash path = loadCausalBranchAtPath maybeRootCausalHash path >>= \case Nothing -> pure Nothing diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index ab263ef9d5..880d3cdf04 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -394,8 +394,8 @@ import Unison.Hash qualified as Hash import Unison.Hash32 (Hash32) import Unison.Hash32 qualified as Hash32 import Unison.Hash32.Orphans.Sqlite () -import Unison.NameSegment (NameSegment (NameSegment)) -import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment.Internal (NameSegment (NameSegment)) +import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.Sqlite import Unison.Util.Alternative qualified as Alternative @@ -4264,7 +4264,7 @@ expectMostRecentNamespace = Right namespace -> Right (map NameSegment namespace) -- | Set the most recent namespace the user has visited. -setMostRecentNamespace :: [Text] -> Transaction () +setMostRecentNamespace :: [NameSegment] -> Transaction () setMostRecentNamespace namespace = execute [sql| @@ -4274,7 +4274,7 @@ setMostRecentNamespace namespace = where json :: Text json = - Text.Lazy.toStrict (Aeson.encodeToLazyText namespace) + Text.Lazy.toStrict (Aeson.encodeToLazyText $ NameSegment.toUnescapedText <$> namespace) -- | Get the causal hash result from squashing the provided branch hash if we've squashed it -- at some point in the past. diff --git a/codebase2/core/Unison/NameSegment.hs b/codebase2/core/Unison/NameSegment.hs index cc7c76c115..bca7db4149 100644 --- a/codebase2/core/Unison/NameSegment.hs +++ b/codebase2/core/Unison/NameSegment.hs @@ -1,57 +1,15 @@ module Unison.NameSegment - ( NameSegment (..), - toUnescapedText, - isPrefixOf, + ( NameSegment, -- * Sentinel name segments - defaultPatchSegment, - docSegment, libSegment, ) where -import Data.Text qualified as Text -import Unison.Prelude -import Unison.Util.Alphabetical (Alphabetical) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) --- Represents the parts of a name between the `.`s -newtype NameSegment - = NameSegment Text - deriving stock (Eq, Ord, Generic) - deriving newtype (Alphabetical) - -instance IsString NameSegment where - fromString = - NameSegment . Text.pack - -instance Show NameSegment where - show = - Text.unpack . toUnescapedText - --- | Convert a name segment to unescaped text. --- --- You might use this when storing a name segment as text in a database, where the literal name segment bytes are all --- that matter. However, you wouldn't use this to display the name segment to a user - that depends on concrete syntax. --- See Unison.Syntax.NameSegment (or indeed, some actual yet-built interface that abstracts concrete syntax) for that --- kind of function. +-- | -- --- > toUnescapedText (unsafeFromText ".~") = ".~" -toUnescapedText :: NameSegment -> Text -toUnescapedText = - coerce - -isPrefixOf :: NameSegment -> NameSegment -> Bool -isPrefixOf = - coerce Text.isPrefixOf - -defaultPatchSegment :: NameSegment -defaultPatchSegment = - "patch" - -docSegment :: NameSegment -docSegment = - "doc" - +-- __TODO__: This should live in "Unison.Syntax.NameSegment", but it’s currently used in unison-core. libSegment :: NameSegment -libSegment = - "lib" +libSegment = NameSegment "lib" diff --git a/codebase2/core/Unison/NameSegment/Internal.hs b/codebase2/core/Unison/NameSegment/Internal.hs new file mode 100644 index 0000000000..5c3825d04d --- /dev/null +++ b/codebase2/core/Unison/NameSegment/Internal.hs @@ -0,0 +1,21 @@ +-- | This module exposes the underlying representation of `NameSegment`, and +-- thus should only be imported by parsers & printers. +module Unison.NameSegment.Internal (NameSegment (..)) where + +import Unison.Prelude +import Unison.Util.Alphabetical (Alphabetical) + +-- Represents the parts of a name between the `.`s +newtype NameSegment = NameSegment + { -- | Convert a name segment to unescaped text. + -- + -- You might use this when storing a name segment as text in a database, where the literal name segment bytes are all + -- that matter. However, you wouldn't use this to display the name segment to a user - that depends on concrete syntax. + -- See Unison.Syntax.NameSegment (or indeed, some actual yet-built interface that abstracts concrete syntax) for that + -- kind of function. + -- + -- > toUnescapedText (unsafeFromText ".~") = ".~" + toUnescapedText :: Text + } + deriving stock (Eq, Generic, Ord, Show) + deriving newtype (Alphabetical) diff --git a/codebase2/core/unison-core.cabal b/codebase2/core/unison-core.cabal index e70173b304..9cea44a2ab 100644 --- a/codebase2/core/unison-core.cabal +++ b/codebase2/core/unison-core.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -22,6 +22,7 @@ library U.Core.ABT.Var Unison.Core.Project Unison.NameSegment + Unison.NameSegment.Internal Unison.ShortHash Unison.Util.Alphabetical hs-source-dirs: diff --git a/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs b/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs index 544b3d5e45..61f9ea0c43 100644 --- a/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs +++ b/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs @@ -8,10 +8,10 @@ import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH -import Unison.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Share.Types +import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Util.Monoid qualified as Monoid data ReadRepo @@ -132,7 +132,7 @@ data ReadShareLooseCode = ReadShareLooseCode isPublic :: ReadShareLooseCode -> Bool isPublic ReadShareLooseCode {path} = case path of - ((NameSegment.toUnescapedText -> "public") Path.:< _) -> True + (segment Path.:< _) -> segment == NameSegment.publicLooseCodeSegment _ -> False data WriteRemoteNamespace a diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index 48a183864d..eee0dcec4f 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -47,7 +47,7 @@ import Unison.Hash (Hash) import Unison.Hashing.V2.Convert qualified as Hashing import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment (..)) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Names (Names (Names)) import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) diff --git a/parser-typechecker/src/Unison/Hashing/V2/Convert.hs b/parser-typechecker/src/Unison/Hashing/V2/Convert.hs index 7958f3bec2..43e6a31c0f 100644 --- a/parser-typechecker/src/Unison/Hashing/V2/Convert.hs +++ b/parser-typechecker/src/Unison/Hashing/V2/Convert.hs @@ -40,7 +40,8 @@ import Unison.DataDeclaration qualified as Memory.DD import Unison.Hash (Hash, HashFor (HashFor)) import Unison.Hashing.V2 qualified as Hashing import Unison.Kind qualified as Memory.Kind -import Unison.NameSegment qualified as Memory.NameSegment +import Unison.NameSegment qualified as Memory (NameSegment) +import Unison.NameSegment.Internal qualified as Memory.NameSegment import Unison.Names.ResolutionResult (ResolutionResult) import Unison.Pattern qualified as Memory.Pattern import Unison.Reference qualified as Memory.Reference @@ -373,7 +374,7 @@ m2hBranch0 b = where -- is there a more readable way to structure these that's also linear? doTerms :: - Memory.Branch.Star Memory.Referent.Referent Memory.NameSegment.NameSegment -> + Memory.Branch.Star Memory.Referent.Referent Memory.NameSegment -> Map Hashing.NameSegment (Map Hashing.Referent Hashing.MdValues) doTerms s = Map.fromList @@ -388,7 +389,7 @@ m2hBranch0 b = ] doTypes :: - Memory.Branch.Star Memory.Reference.Reference Memory.NameSegment.NameSegment -> + Memory.Branch.Star Memory.Reference.Reference Memory.NameSegment -> Map Hashing.NameSegment (Map Hashing.Reference Hashing.MdValues) doTypes s = Map.fromList @@ -409,10 +410,10 @@ m2hBranch0 b = doPatches = Map.bimap m2hNameSegment (unPatchHash . fst) doChildren :: - Map Memory.NameSegment.NameSegment (Memory.Branch.Branch m) -> + Map Memory.NameSegment (Memory.Branch.Branch m) -> Map Hashing.NameSegment Hash doChildren = Map.bimap m2hNameSegment (unCausalHash . Memory.Branch.headHash) -m2hNameSegment :: Memory.NameSegment.NameSegment -> Hashing.NameSegment +m2hNameSegment :: Memory.NameSegment -> Hashing.NameSegment m2hNameSegment = Hashing.NameSegment . Memory.NameSegment.toUnescapedText diff --git a/parser-typechecker/src/Unison/PrettyPrintEnvDecl/Sqlite.hs b/parser-typechecker/src/Unison/PrettyPrintEnvDecl/Sqlite.hs index 633be7a5ed..96f91c844b 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnvDecl/Sqlite.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnvDecl/Sqlite.hs @@ -13,7 +13,7 @@ import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment (..)) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Names qualified as Names import Unison.Prelude import Unison.PrettyPrintEnv.Names qualified as PPE diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index b96b60a153..cf16bd51fe 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -40,6 +40,7 @@ import Unison.Kind qualified as Kind import Unison.KindInference.Error.Pretty (prettyKindError) import Unison.Name (Name) import Unison.Name qualified as Name +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names import Unison.Parser.Ann (Ann (..)) @@ -1701,7 +1702,7 @@ renderParseErrors s = \case else unknownTypesMsg <> "\n\n" <> dupDataAndAbilitiesMsg in (msgs, allRanges) go (Parser.DidntExpectExpression _tok (Just t@(L.payload -> L.SymbolyId (HQ'.NameOnly name)))) - | name == Name.fromSegment "::" = + | name == Name.fromSegment (NameSegment "::") = let msg = mconcat [ "This looks like the start of an expression here but I was expecting a binding.", diff --git a/parser-typechecker/src/Unison/Project/Util.hs b/parser-typechecker/src/Unison/Project/Util.hs index d75f2250a0..2848a07564 100644 --- a/parser-typechecker/src/Unison/Project/Util.hs +++ b/parser-typechecker/src/Unison/Project/Util.hs @@ -19,8 +19,8 @@ import Data.UUID (UUID) import Data.UUID qualified as UUID import U.Codebase.Sqlite.DbId (ProjectBranchId (..), ProjectId (..)) import Unison.Codebase.Path qualified as Path -import Unison.NameSegment (NameSegment (..)) -import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment.Internal (NameSegment (NameSegment)) +import Unison.NameSegment.Internal qualified as NameSegment import Unison.Project (ProjectAndBranch (..)) -- | Get the path that a project is stored at. Users aren't supposed to go here. @@ -152,9 +152,7 @@ pattern BranchesNameSegment <- BranchesNameSegment = branchesNameSegment projectsNameSegment :: NameSegment -projectsNameSegment = - "__projects" +projectsNameSegment = NameSegment "__projects" branchesNameSegment :: NameSegment -branchesNameSegment = - "branches" +branchesNameSegment = NameSegment "branches" diff --git a/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs b/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs index d4c9f92e45..ae5ed64cae 100644 --- a/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs @@ -10,6 +10,7 @@ where import Control.Monad.Writer (Writer, runWriter, tell) import Data.List.NonEmpty (pattern (:|)) import Data.Map qualified as Map +import Data.Set qualified as Set import Data.Text qualified as Text import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) import Unison.ConstructorType qualified as CT @@ -29,6 +30,7 @@ import Unison.Referent qualified as Referent import Unison.Syntax.HashQualified qualified as HQ (toText) import Unison.Syntax.Name qualified as Name import Unison.Syntax.NamePrinter (prettyName, styleHashQualified'') +import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.TypePrinter (runPretty) import Unison.Syntax.TypePrinter qualified as TypePrinter import Unison.Syntax.Var qualified as Var (namespaced) @@ -38,7 +40,6 @@ import Unison.Util.Pretty qualified as P import Unison.Util.SyntaxText qualified as S import Unison.Var (Var) import Unison.Var qualified as Var (freshenId, name, named) -import qualified Data.Set as Set type SyntaxText = S.SyntaxText' Reference @@ -131,14 +132,19 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd = . P.hang' (prettyPattern unsuffixifiedPPE CT.Data name (ConstructorReference r n)) " " $ P.spaced (runPretty suffixifiedPPE (traverse (TypePrinter.prettyRaw Map.empty 10) (init ts))) Just fs -> do - tell $ Set.fromList $ - [ case accessor of - Nothing -> declName `Name.joinDot` fieldName - Just accessor -> declName `Name.joinDot` fieldName `Name.joinDot` accessor - | HQ.NameOnly declName <- [name], - fieldName <- fs, - accessor <- [Nothing, Just (Name.fromSegment "set"), Just (Name.fromSegment "modify")] - ] + tell $ + Set.fromList $ + [ case accessor of + Nothing -> declName `Name.joinDot` fieldName + Just accessor -> declName `Name.joinDot` fieldName `Name.joinDot` accessor + | HQ.NameOnly declName <- [name], + fieldName <- fs, + accessor <- + [ Nothing, + Just (Name.fromSegment NameSegment.setSegment), + Just (Name.fromSegment NameSegment.modifySegment) + ] + ] pure . P.group $ fmt S.DelimiterChar "{ " <> P.sep diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 6f3b159baf..48d9e258a6 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -26,6 +26,7 @@ import Unison.Reference (TypeReferenceId) import Unison.Syntax.DeclParser (declarations) import Unison.Syntax.Lexer qualified as L import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar) +import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser import Unison.Syntax.TermParser qualified as TermParser import Unison.Syntax.Var qualified as Var (namespaced) @@ -243,7 +244,7 @@ watched = P.try do kind <- (fmap . fmap . fmap) (Text.unpack . Name.toText) (optional importWordyId) guid <- uniqueName 10 op <- optional (L.payload <$> P.lookAhead importSymbolyId) - guard (op == Just (Name.fromSegment ">")) + guard (op == Just (Name.fromSegment NameSegment.watchSegment)) tok <- anyToken guard $ maybe True (`L.touches` tok) kind pure (maybe UF.RegularWatch L.payload kind, guid, maybe mempty ann kind <> ann tok) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 95b858bbfa..bf0e59a2b7 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -45,7 +45,7 @@ import Unison.Reference (Reference) import Unison.Referent (Referent) import Unison.Syntax.Lexer qualified as L import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) -import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText) +import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser hiding (seq) import Unison.Syntax.Parser qualified as Parser (seq, uniqueName) import Unison.Syntax.TypeParser qualified as TypeParser @@ -992,9 +992,12 @@ bang = P.label "bang" do seqOp :: (Ord v) => P v m Pattern.SeqOp seqOp = - Pattern.Snoc <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment ":+"))) - <|> Pattern.Cons <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment "+:"))) - <|> Pattern.Concat <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment "++"))) + Pattern.Snoc + <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.snocSegment))) + <|> Pattern.Cons + <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment))) + <|> Pattern.Concat + <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment))) term4 :: (Monad m, Var v) => TermP v m term4 = f <$> some termLeaf diff --git a/parser-typechecker/tests/Unison/Core/Test/Name.hs b/parser-typechecker/tests/Unison/Core/Test/Name.hs index 86ed2cc691..de10924772 100644 --- a/parser-typechecker/tests/Unison/Core/Test/Name.hs +++ b/parser-typechecker/tests/Unison/Core/Test/Name.hs @@ -5,6 +5,7 @@ import Data.List.NonEmpty qualified as List.NonEmpty import Data.Set qualified as Set import EasyTest import Unison.Name as Name +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Syntax.Name qualified as Name (unsafeParseText) import Unison.Util.Relation qualified as R @@ -36,10 +37,10 @@ testEndsWithReverseSegments = [ scope "a.b.c ends with []" (expectEqual True (endsWithReverseSegments (Name.unsafeParseText "a.b.c") [])), scope "a.b.c ends with [c, b]" - (expectEqual True (endsWithReverseSegments (Name.unsafeParseText "a.b.c") ["c", "b"])), + (expectEqual True (endsWithReverseSegments (Name.unsafeParseText "a.b.c") [NameSegment "c", NameSegment "b"])), scope "a.b.c doesn't end with [d]" - (expectEqual False (endsWithReverseSegments (Name.unsafeParseText "a.b.c") ["d"])) + (expectEqual False (endsWithReverseSegments (Name.unsafeParseText "a.b.c") [NameSegment "d"])) ] testEndsWithSegments :: [Test ()] @@ -47,31 +48,31 @@ testEndsWithSegments = [ scope "a.b.c ends with []" (expectEqual True (endsWithSegments (Name.unsafeParseText "a.b.c") [])), scope "a.b.c ends with [b, c]" - (expectEqual True (endsWithSegments (Name.unsafeParseText "a.b.c") ["b", "c"])), + (expectEqual True (endsWithSegments (Name.unsafeParseText "a.b.c") [NameSegment "b", NameSegment "c"])), scope "a.b.c doesn't end with [d]" - (expectEqual False (endsWithSegments (Name.unsafeParseText "a.b.c") ["d"])) + (expectEqual False (endsWithSegments (Name.unsafeParseText "a.b.c") [NameSegment "d"])) ] testSegments :: [Test ()] testSegments = [ do n <- int' 1 10 - segs <- List.NonEmpty.fromList <$> listOf n (pick [".", "foo"]) + segs <- List.NonEmpty.fromList <$> listOf n (pick [NameSegment ".", NameSegment "foo"]) expectEqual (segments (fromSegments segs)) segs ] testSplitName :: [Test ()] testSplitName = [ scope "x" (expectEqual (splits (Name.unsafeParseText "x")) [([], Name.unsafeParseText "x")]), - scope "A.x" (expectEqual (splits (Name.unsafeParseText "A.x")) [([], Name.unsafeParseText "A.x"), (["A"], Name.unsafeParseText "x")]), + scope "A.x" (expectEqual (splits (Name.unsafeParseText "A.x")) [([], Name.unsafeParseText "A.x"), ([NameSegment "A"], Name.unsafeParseText "x")]), scope "A.B.x" ( expectEqual (splits (Name.unsafeParseText "A.B.x")) [ ([], Name.unsafeParseText "A.B.x"), - (["A"], Name.unsafeParseText "B.x"), - (["A", "B"], Name.unsafeParseText "x") + ([NameSegment "A"], Name.unsafeParseText "B.x"), + ([NameSegment "A", NameSegment "B"], Name.unsafeParseText "x") ] ) ] @@ -98,8 +99,8 @@ testSuffixSearch = (n ".`.`", 6) ] n = Name.unsafeParseText - expectEqual' ("." :| []) (Name.reverseSegments (n ".`.`")) - expectEqual' ("." :| []) (Name.reverseSegments (n ".`.`")) + expectEqual' (NameSegment "." :| []) (Name.reverseSegments (n ".`.`")) + expectEqual' (NameSegment "." :| []) (Name.reverseSegments (n ".`.`")) expectEqual' (Set.fromList [1, 2]) (Name.searchBySuffix (n "map") rel) expectEqual' (n "List.map") (Name.suffixifyByHash (n "base.List.map") rel) @@ -120,22 +121,22 @@ testUnsafeFromString :: [Test ()] testUnsafeFromString = [ scope "." do expectEqual' (isAbsolute (Name.unsafeParseText "`.`")) False - expectEqual' (segments (Name.unsafeParseText "`.`")) ("." :| []) + expectEqual' (segments (Name.unsafeParseText "`.`")) (NameSegment "." :| []) ok, scope ".`.`" do expectEqual' (isAbsolute (Name.unsafeParseText ".`.`")) True - expectEqual' (segments (Name.unsafeParseText ".`.`")) ("." :| []) + expectEqual' (segments (Name.unsafeParseText ".`.`")) (NameSegment "." :| []) ok, scope "foo.bar" do expectEqual' (isAbsolute (Name.unsafeParseText "foo.bar")) False - expectEqual' (segments (Name.unsafeParseText "foo.bar")) ("foo" :| ["bar"]) + expectEqual' (segments (Name.unsafeParseText "foo.bar")) (NameSegment "foo" :| [NameSegment "bar"]) ok, scope ".foo.bar" do expectEqual' (isAbsolute (Name.unsafeParseText ".foo.bar")) True - expectEqual' (segments (Name.unsafeParseText ".foo.bar")) ("foo" :| ["bar"]) + expectEqual' (segments (Name.unsafeParseText ".foo.bar")) (NameSegment "foo" :| [NameSegment "bar"]) ok, scope "foo.`.`" do expectEqual' (isAbsolute (Name.unsafeParseText "foo.`.`")) False - expectEqual' (segments (Name.unsafeParseText "foo.`.`")) ("foo" :| ["."]) + expectEqual' (segments (Name.unsafeParseText "foo.`.`")) (NameSegment "foo" :| [NameSegment "."]) ok ] diff --git a/parser-typechecker/tests/Unison/Test/Codebase/Branch.hs b/parser-typechecker/tests/Unison/Test/Codebase/Branch.hs index d9f7c3b1fa..6c5c1a2eab 100644 --- a/parser-typechecker/tests/Unison/Test/Codebase/Branch.hs +++ b/parser-typechecker/tests/Unison/Test/Codebase/Branch.hs @@ -13,6 +13,7 @@ import Unison.Codebase.Branch (Branch (Branch), Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Causal qualified as Causal import Unison.Codebase.Metadata qualified as Metadata +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Util.Relation qualified as Relation @@ -34,7 +35,7 @@ branch0Tests = Branch.branch0 mempty ( mempty - & Star2.insertD1 (dummy, "b") + & Star2.insertD1 (dummy, NameSegment "b") & Metadata.insert (dummy, dummy) ) Map.empty @@ -45,10 +46,10 @@ branch0Tests = Branch.branch0 mempty ( mempty - & Star2.insertD1 (dummy, "b") + & Star2.insertD1 (dummy, NameSegment "b") & Metadata.insert (dummy, dummy) ) - (Map.singleton "a" (Branch (Causal.one b0))) + (Map.singleton (NameSegment "a") (Branch (Causal.one b0))) Map.empty let -- b.a.b @@ -57,7 +58,7 @@ branch0Tests = Branch.branch0 mempty mempty - (Map.singleton "b" (Branch (Causal.one b1))) + (Map.singleton (NameSegment "b") (Branch (Causal.one b1))) Map.empty expect (Set.valid (Relation.ran (Branch.deepTypes b2))) diff --git a/parser-typechecker/tests/Unison/Test/Codebase/Path.hs b/parser-typechecker/tests/Unison/Test/Codebase/Path.hs index f3b19f71ad..96fb0aca65 100644 --- a/parser-typechecker/tests/Unison/Test/Codebase/Path.hs +++ b/parser-typechecker/tests/Unison/Test/Codebase/Path.hs @@ -7,7 +7,7 @@ import EasyTest import Unison.Codebase.Path (Path (..), Path' (..), Relative (..)) import Unison.Codebase.Path.Parse (parseHQSplit', parseShortHashOrHQSplit') import Unison.HashQualified' qualified as HQ' -import Unison.NameSegment (NameSegment) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Prelude import Unison.ShortHash qualified as SH @@ -19,12 +19,12 @@ test = in scope s . expect $ parseShortHashOrHQSplit' s == (Right . Right) - (relative ["foo"], HQ'.HashQualified "bar" (fromJust (SH.fromText "#34"))), + (relative ["foo"], HQ'.HashQualified (NameSegment "bar") (fromJust (SH.fromText "#34"))), let s = "foo.bar.+" in scope s . expect $ parseShortHashOrHQSplit' s == (Right . Right) - (relative ["foo", "bar"], HQ'.NameOnly "+"), + (relative ["foo", "bar"], HQ'.NameOnly (NameSegment "+")), let s = "#123" in scope s . expect $ parseShortHashOrHQSplit' s @@ -33,13 +33,13 @@ test = scope "parseHQ'Split'" . tests $ [ let s = "foo.bar#34" in scope s . expect $ - parseHQSplit' s == Right (relative ["foo"], HQ'.HashQualified "bar" (fromJust (SH.fromText "#34"))), + parseHQSplit' s == Right (relative ["foo"], HQ'.HashQualified (NameSegment "bar") (fromJust (SH.fromText "#34"))), let s = "foo.bar.+" in scope s . expect $ - parseHQSplit' s == Right (relative ["foo", "bar"], HQ'.NameOnly "+"), + parseHQSplit' s == Right (relative ["foo", "bar"], HQ'.NameOnly (NameSegment "+")), let s = "#123" in scope s . expect $ isLeft $ parseHQSplit' s ] ] -relative :: Seq NameSegment -> Path' -relative = Path' . Right . Relative . Path +relative :: Seq Text -> Path' +relative = Path' . Right . Relative . Path . fmap NameSegment diff --git a/unison-cli/src/Unison/Cli/DownloadUtils.hs b/unison-cli/src/Unison/Cli/DownloadUtils.hs index 284b1ffb00..41e633d040 100644 --- a/unison-cli/src/Unison/Cli/DownloadUtils.hs +++ b/unison-cli/src/Unison/Cli/DownloadUtils.hs @@ -30,7 +30,7 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.Type (GitError) import Unison.Codebase.Type qualified as Codebase (viewRemoteBranch') import Unison.Core.Project (ProjectAndBranch (..)) -import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment.Internal qualified as NameSegment import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Share.API.Hash qualified as Share diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index 0ef993cc27..73783e1a0f 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -79,7 +79,6 @@ import Unison.Codebase.Editor.UCMVersion (UCMVersion) import Unison.Codebase.Path qualified as Path import Unison.Codebase.Runtime (Runtime) import Unison.Debug qualified as Debug -import Unison.NameSegment qualified as NameSegment import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Server.CodebaseServer qualified as Server @@ -409,7 +408,7 @@ popd = do setMostRecentNamespace :: Path.Absolute -> Cli () setMostRecentNamespace = - runTransaction . Queries.setMostRecentNamespace . map NameSegment.toUnescapedText . Path.toList . Path.unabsolute + runTransaction . Queries.setMostRecentNamespace . Path.toList . Path.unabsolute respond :: Output -> Cli () respond output = do diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index ddccf48a2d..4b52cccaec 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -111,7 +111,6 @@ import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' import Unison.Name qualified as Name -import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Parser.Ann (Ann (..)) import Unison.Prelude @@ -120,6 +119,7 @@ import Unison.Referent (Referent) import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name (toText) +import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Term qualified as Term import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile) import Unison.UnisonFile qualified as UF diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index 0bd17235b2..3e2607c3d6 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -99,8 +99,8 @@ import Unison.HashQualified' qualified as HQ' import Unison.LabeledDependency as LD import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment (..)) -import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment (NameSegment) +import Unison.NameSegment.Internal qualified as NameSegment import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE diff --git a/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs b/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs index 337dafac1a..21aa566256 100644 --- a/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs +++ b/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs @@ -14,7 +14,6 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.UniqueTypeGuidLookup qualified as Codebase import Unison.Name (Name) import Unison.NameSegment (NameSegment) -import Unison.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Sqlite qualified as Sqlite @@ -37,7 +36,6 @@ loadUniqueTypeGuid currentPath name0 = do -- This ought to probably lean somewhat on a cache (so long as the caller is aware of the cache, and discrads it at -- an appropriate time, such as after the current unison file finishes parsing). let loadBranchAtPath :: [NameSegment] -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction)) - loadBranchAtPath segments = - Operations.loadBranchAtPath Nothing (map NameSegment.toUnescapedText segments) + loadBranchAtPath = Operations.loadBranchAtPath Nothing Codebase.loadUniqueTypeGuid loadBranchAtPath (Foldable.toList @Seq branchPath) name diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 74ee4ceaa6..17a5ba8434 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -132,8 +132,7 @@ import Unison.LabeledDependency qualified as LD import Unison.LabeledDependency qualified as LabeledDependency import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment (..)) -import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment (NameSegment) import Unison.Names (Names (Names)) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names @@ -170,7 +169,7 @@ import Unison.Syntax.HashQualified qualified as HQ (parseTextWith, toText) import Unison.Syntax.Lexer qualified as L import Unison.Syntax.Lexer qualified as Lexer import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) -import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText) +import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Term qualified as Term @@ -697,8 +696,8 @@ loop e = do -- add the new definitions to the codebase and to the namespace Cli.runTransaction (traverse_ (uncurry3 (Codebase.putTerm codebase)) [guid, author, copyrightHolder]) authorPath <- Cli.resolveSplit' authorPath' - copyrightHolderPath <- Cli.resolveSplit' (base |> "copyrightHolders" |> authorNameSegment) - guidPath <- Cli.resolveSplit' (authorPath' |> "guid") + copyrightHolderPath <- Cli.resolveSplit' (base |> NameSegment.copyrightHoldersSegment |> authorNameSegment) + guidPath <- Cli.resolveSplit' (authorPath' |> NameSegment.guidSegment) Cli.stepManyAt description [ BranchUtil.makeAddTermName (Path.convert authorPath) (d authorRef), @@ -718,8 +717,8 @@ loop e = do where d :: Reference.Id -> Referent d = Referent.Ref . Reference.DerivedId - base :: Path.Split' = (Path.relativeEmpty', "metadata") - authorPath' = base |> "authors" |> authorNameSegment + base :: Path.Split' = (Path.relativeEmpty', NameSegment.metadataSegment) + authorPath' = base |> NameSegment.authorsSegment |> authorNameSegment MoveTermI src' dest' -> doMoveTerm src' dest' =<< inputDescription input MoveTypeI src' dest' -> doMoveType src' dest' =<< inputDescription input MoveAllI src' dest' -> do @@ -988,7 +987,7 @@ loop e = do currentPath <- Cli.getCurrentPath let destPath = case opath of Just path -> Path.resolve currentPath (Path.Relative path) - Nothing -> currentPath `snoc` "builtin" + Nothing -> currentPath `snoc` NameSegment.builtinSegment _ <- Cli.updateAtM description destPath \destb -> liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb) Cli.respond Success @@ -1015,7 +1014,7 @@ loop e = do currentPath <- Cli.getCurrentPath let destPath = case opath of Just path -> Path.resolve currentPath (Path.Relative path) - Nothing -> currentPath `snoc` "builtin" + Nothing -> currentPath `snoc` NameSegment.builtinSegment _ <- Cli.updateAtM description destPath \destb -> liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb) Cli.respond Success @@ -2120,7 +2119,7 @@ docsI src = do in Name.convert hq' dotDoc :: HQ.HashQualified Name - dotDoc = hq <&> \n -> Name.joinDot n (Name.fromSegment "doc") + dotDoc = hq <&> \n -> Name.joinDot n (Name.fromSegment NameSegment.docSegment) findInScratchfileByName :: Cli () findInScratchfileByName = do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs index 31ddeb5c15..ae9113c449 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs @@ -24,7 +24,7 @@ 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.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.Project ( ProjectAndBranch (..), @@ -35,7 +35,7 @@ import Unison.Project classifyProjectBranchName, projectNameToUserProjectSlugs, ) -import Unison.Syntax.NameSegment qualified as NameSegment (unsafeParseText) +import Unison.Syntax.NameSegment qualified as NameSegment (libSegment, unsafeParseText) handleInstallLib :: ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease) -> Cli () handleInstallLib (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName) = do @@ -96,7 +96,7 @@ handleInstallLib (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName) Cli.respond (Output.InstalledLibdep libdepProjectAndBranchNames libdepNameSegment) -fresh :: Ord a => (Int -> a -> a) -> Set a -> a -> a +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 ..])) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 2d8d288e99..a9a7fe1750 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -85,8 +85,8 @@ import Unison.Merge.Unconflicts qualified as Unconflicts import Unison.Merge.Updated (Updated (..)) import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment (..)) -import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment.Internal (NameSegment (NameSegment)) +import Unison.NameSegment.Internal qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Prelude @@ -104,6 +104,7 @@ import Unison.Sqlite qualified as Sqlite import Unison.Syntax.DeclPrinter (AccessorName) import Unison.Syntax.DeclPrinter qualified as DeclPrinter import Unison.Syntax.Name qualified as Name +import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.TermPrinter qualified as TermPrinter import Unison.Term (Term) import Unison.Type (Type) @@ -446,7 +447,7 @@ renderTermBinding ppe (HQ.NameOnly -> name) term typ = else TermPrinter.prettyBinding ppe name term renderTypeBinding :: - Var v => + (Var v) => PrettyPrintEnvDecl -> Name -> TypeReferenceId -> @@ -601,7 +602,7 @@ defnsAndLibdepsToBranch0 codebase defns libdeps = branch2 = Branch.transform0 (Codebase.runTransaction codebase) branch1 in branch2 where - go :: Ord v => Map Name v -> Nametree (Map NameSegment v) + go :: (Ord v) => Map Name v -> Nametree (Map NameSegment v) go = unflattenNametree . BiMultimap.fromRange @@ -676,7 +677,7 @@ identifyDependents defns conflicts unconflicts = do -- into the namespace / parsing context for the conflicted merge, because it has an unnamed reference on -- foo#alice. It rather ought to be in the scratchfile alongside the conflicted foo#alice and foo#bob, so -- that when that conflict is resolved, it will propagate to bar. - let f :: Foldable t => t Reference.Id -> Set Reference + let f :: (Foldable t) => t Reference.Id -> Set Reference f = List.foldl' (\acc ref -> Set.insert (Reference.DerivedId ref) acc) Set.empty . Foldable.toList in bifoldMap f f <$> conflicts @@ -797,7 +798,7 @@ loadNamespaceInfo abort db branch = do -- | Load all "namespace definitions" of a branch, which are all terms and type declarations *except* those defined -- in the "lib" namespace. loadNamespaceInfo0 :: - Monad m => + (Monad m) => (V2.Referent -> m Referent) -> V2.Branch m -> m (Nametree (DefnsF2 (Map NameSegment) Set Referent TypeReference)) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs index 99a90be6f8..a1b493f952 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs @@ -23,12 +23,12 @@ 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.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Share.API.Hash qualified as Share.API import Unison.Sqlite qualified as Sqlite import Unison.Sync.Common qualified as Sync.Common +import Unison.Syntax.NameSegment qualified as NameSegment import Witch (unsafeFrom) -- | Create a new project. @@ -136,7 +136,7 @@ projectCreate tryDownloadingBase maybeProjectName = do projectBranchLibBaseObject = over Branch.children - (Map.insert "base" baseLatestReleaseBranchObject) + (Map.insert NameSegment.baseSegment baseLatestReleaseBranchObject) Branch.empty0 projectBranchLibObject = Branch.cons projectBranchLibBaseObject Branch.empty in over diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index b67a03cf90..7cebf20743 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -40,9 +40,9 @@ 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.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchNameOrLatestRelease (..), ProjectName) +import Unison.Syntax.NameSegment qualified as NameSegment import Witch (unsafeFrom) handlePull :: PullSourceTarget -> PullMode -> Verbosity.Verbosity -> Cli () diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs index 455f558b70..99e1fce08b 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs @@ -56,7 +56,6 @@ import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName)) import Unison.Hash qualified as Hash import Unison.Hash32 (Hash32) import Unison.Hash32 qualified as Hash32 -import Unison.NameSegment (NameSegment (..)) import Unison.Prelude import Unison.Project ( ProjectAndBranch (..), @@ -730,7 +729,7 @@ loadCausalHashToPush path = Nothing -> Nothing Just (CausalHash hash) -> Just (Hash32.fromHash hash) where - segments = coerce @[NameSegment] @[Text] (Path.toList (Path.unabsolute path)) + segments = Path.toList (Path.unabsolute path) -- Were we to try to advance `remoteBranchHead` to `localBranchHead`, would it *not* be a fast-forward? wouldNotBeFastForward :: Hash32 -> Hash32 -> Sqlite.Transaction Bool diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 72ed90dacd..63ed7be542 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -62,8 +62,7 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Name.Forward (ForwardName (..)) import Unison.Name.Forward qualified as ForwardName -import Unison.NameSegment (NameSegment (..)) -import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Names (Names (Names)) import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) @@ -82,6 +81,7 @@ import Unison.Result qualified as Result import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name +import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Type (Type) @@ -377,12 +377,12 @@ makeUnisonFile abort codebase doFindCtorNames defns = do overwriteConstructorNames name ed.toDataDecl <&> \ed' -> uf & #effectDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') Right dd -> overwriteConstructorNames name dd <&> \dd' -> uf & #dataDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') -- Constructor names are bogus when pulled from the database, so we set them to what they should be here overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann) diff --git a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs index 03c5745df5..954d5d85e7 100644 --- a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs +++ b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs @@ -31,7 +31,7 @@ import Unison.Codebase.Editor.RemoteRepo import Unison.Codebase.Path (Path (..)) import Unison.Codebase.Path qualified as Path import Unison.Codebase.ShortCausalHash (ShortCausalHash (..)) -import Unison.NameSegment (NameSegment (..)) +import Unison.NameSegment (NameSegment) import Unison.Prelude import Unison.Project (ProjectBranchName, ProjectBranchSpecifier (..), ProjectName, projectAndBranchNamesParser) import Unison.Syntax.Lexer qualified @@ -62,9 +62,12 @@ type P = P.Parsec Void Text.Text readRemoteNamespaceParser :: ProjectBranchSpecifier branch -> P (ReadRemoteNamespace (These ProjectName branch)) readRemoteNamespaceParser specifier = P.label "generic repo" $ - ReadRemoteNamespaceGit <$> readGitRemoteNamespace - <|> ReadShare'ProjectBranch <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier - <|> ReadShare'LooseCode <$> readShareLooseCode + ReadRemoteNamespaceGit + <$> readGitRemoteNamespace + <|> ReadShare'ProjectBranch + <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier + <|> ReadShare'LooseCode + <$> readShareLooseCode projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths :: ProjectBranchSpecifier branch -> @@ -92,9 +95,12 @@ writeRemoteNamespace = writeRemoteNamespaceWith :: P a -> P (WriteRemoteNamespace a) writeRemoteNamespaceWith projectBranchParser = - WriteRemoteNamespaceGit <$> writeGitRemoteNamespace - <|> WriteRemoteProjectBranch <$> projectBranchParser - <|> WriteRemoteNamespaceShare <$> writeShareRemoteNamespace + WriteRemoteNamespaceGit + <$> writeGitRemoteNamespace + <|> WriteRemoteProjectBranch + <$> projectBranchParser + <|> WriteRemoteNamespaceShare + <$> writeShareRemoteNamespace -- >>> P.parseMaybe writeShareRemoteNamespace "unisonweb.base._releases.M4" -- Just (WriteShareRemoteNamespace {server = ShareRepo, repo = "unisonweb", path = base._releases.M4}) diff --git a/unison-cli/src/Unison/CommandLine/Completion.hs b/unison-cli/src/Unison/CommandLine/Completion.hs index a72ac3c923..28822ea6f8 100644 --- a/unison-cli/src/Unison/CommandLine/Completion.hs +++ b/unison-cli/src/Unison/CommandLine/Completion.hs @@ -52,7 +52,7 @@ import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.CommandLine.InputPattern qualified as IP import Unison.HashQualified' qualified as HQ' import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment (..)) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Prelude import Unison.Server.Local.Endpoints.NamespaceListing (NamespaceListing (NamespaceListing)) import Unison.Server.Local.Endpoints.NamespaceListing qualified as Server diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index b96d169f17..eda5422601 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -94,8 +94,7 @@ import Unison.HashQualified' qualified as HQ' import Unison.LabeledDependency as LD import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment (..)) -import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Names (Names (..)) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names @@ -143,7 +142,7 @@ import Unison.Syntax.NamePrinter prettyShortHash, styleHashQualified, ) -import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText) +import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.TermPrinter qualified as TermPrinter import Unison.Syntax.TypePrinter qualified as TypePrinter import Unison.Term (Term) @@ -306,7 +305,7 @@ notifyNumbered = \case "", tip $ "Add" - <> prettyName (Name.fromSegment "License") + <> prettyName (Name.fromSegment NameSegment.licenseSegment) <> "values for" <> prettyName (Name.fromSegment authorNS) <> "under" @@ -3219,7 +3218,7 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} = [] -> mempty x : ys -> " (" <> P.commas (x <> " updates" : ys) <> ")" pure $ n <> P.bold " patch " <> prettyName name <> message - -- 18. patch q + -- 18. patch q prettyNamePatch prefix (name, _patchDiff) = do n <- numPatch prefix name pure $ n <> P.bold " patch " <> prettyName name diff --git a/unison-cli/src/Unison/LSP/Completion.hs b/unison-cli/src/Unison/LSP/Completion.hs index 90fc8d5dd8..f50aa9c266 100644 --- a/unison-cli/src/Unison/LSP/Completion.hs +++ b/unison-cli/src/Unison/LSP/Completion.hs @@ -32,8 +32,8 @@ import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment (..)) -import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment.Internal (NameSegment) +import Unison.NameSegment.Internal qualified as NameSegment import Unison.Names (Names (..)) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE @@ -44,6 +44,7 @@ import Unison.Runtime.IOSource qualified as IOSource import Unison.Syntax.DeclPrinter qualified as DeclPrinter import Unison.Syntax.HashQualified' qualified as HQ' (toText) import Unison.Syntax.Name qualified as Name (nameP, parseText, toText) +import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.TypePrinter qualified as TypePrinter import Unison.Util.Monoid qualified as Monoid import Unison.Util.Pretty qualified as Pretty @@ -194,8 +195,7 @@ namesToCompletionTree Names {terms, types} = -- Special docs like "README" will still appear since they're not named 'doc' isDefinitionDoc name = case Name.reverseSegments name of - ((NameSegment.toUnescapedText -> "doc") :| _) -> True - _ -> False + (doc :| _) -> doc == NameSegment.docSegment nameToCompletionTree :: Name -> LabeledDependency -> CompletionTree nameToCompletionTree name ref = @@ -244,7 +244,7 @@ matchCompletions (CompletionTree tree) txt = in (current <> mkDefMatches subtreeMap) [prefix] -> Map.dropWhileAntitone (< prefix) subtreeMap - & Map.takeWhileAntitone (NameSegment.isPrefixOf prefix) + & Map.takeWhileAntitone (Text.isPrefixOf (NameSegment.toUnescapedText prefix) . NameSegment.toUnescapedText) & \matchingSubtrees -> let subMatches = ifoldMap (\ns subTree -> matchSegments [] subTree & consPathPrefix ns) matchingSubtrees in subMatches diff --git a/unison-cli/tests/Unison/Test/UriParser.hs b/unison-cli/tests/Unison/Test/UriParser.hs index ba71a26ba8..8c642eb0c7 100644 --- a/unison-cli/tests/Unison/Test/UriParser.hs +++ b/unison-cli/tests/Unison/Test/UriParser.hs @@ -6,12 +6,23 @@ import Data.These (These (..)) import Data.Void (Void) import EasyTest import Text.Megaparsec qualified as P -import Unison.Codebase.Editor.RemoteRepo (ReadGitRepo (..), ReadRemoteNamespace (..), ShareCodeserver (..), ShareUserHandle (..), WriteGitRemoteNamespace (..), WriteGitRepo (..), WriteRemoteNamespace (..), WriteShareRemoteNamespace (..), pattern ReadGitRemoteNamespace, pattern ReadShareLooseCode) +import Unison.Codebase.Editor.RemoteRepo + ( ReadGitRepo (..), + ReadRemoteNamespace (..), + ShareCodeserver (..), + ShareUserHandle (..), + WriteGitRemoteNamespace (..), + WriteGitRepo (..), + WriteRemoteNamespace (..), + WriteShareRemoteNamespace (..), + pattern ReadGitRemoteNamespace, + pattern ReadShareLooseCode, + ) import Unison.Codebase.Editor.UriParser qualified as UriParser import Unison.Codebase.Path qualified as Path import Unison.Codebase.ShortCausalHash (ShortCausalHash (..)) import Unison.Core.Project (ProjectBranchName (..), ProjectName (..)) -import Unison.NameSegment (NameSegment (..)) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Project (ProjectBranchSpecifier (..)) test :: Test () @@ -68,19 +79,22 @@ test = ] ] -gitR :: Text -> Maybe Text -> Maybe ShortCausalHash -> [NameSegment] -> ReadRemoteNamespace void -gitR url ref sch path = ReadRemoteNamespaceGit (ReadGitRemoteNamespace (ReadGitRepo url ref) sch (Path.fromList path)) +mkPath :: [Text] -> Path.Path +mkPath = Path.fromList . fmap NameSegment -gitW :: Text -> Maybe Text -> [NameSegment] -> WriteRemoteNamespace void -gitW url branch path = WriteRemoteNamespaceGit (WriteGitRemoteNamespace (WriteGitRepo url branch) (Path.fromList path)) +gitR :: Text -> Maybe Text -> Maybe ShortCausalHash -> [Text] -> ReadRemoteNamespace void +gitR url ref sch path = ReadRemoteNamespaceGit (ReadGitRemoteNamespace (ReadGitRepo url ref) sch (mkPath path)) -looseR :: Text -> [NameSegment] -> ReadRemoteNamespace void +gitW :: Text -> Maybe Text -> [Text] -> WriteRemoteNamespace void +gitW url branch path = WriteRemoteNamespaceGit (WriteGitRemoteNamespace (WriteGitRepo url branch) (mkPath path)) + +looseR :: Text -> [Text] -> ReadRemoteNamespace void looseR user path = - ReadShare'LooseCode (ReadShareLooseCode DefaultCodeserver (ShareUserHandle user) (Path.fromList path)) + ReadShare'LooseCode (ReadShareLooseCode DefaultCodeserver (ShareUserHandle user) (mkPath path)) -looseW :: Text -> [NameSegment] -> WriteRemoteNamespace void +looseW :: Text -> [Text] -> WriteRemoteNamespace void looseW user path = - WriteRemoteNamespaceShare (WriteShareRemoteNamespace DefaultCodeserver (ShareUserHandle user) (Path.fromList path)) + WriteRemoteNamespaceShare (WriteShareRemoteNamespace DefaultCodeserver (ShareUserHandle user) (mkPath path)) branchR :: These Text Text -> ReadRemoteNamespace (These ProjectName ProjectBranchName) branchR = diff --git a/unison-core/src/Unison/Name.hs b/unison-core/src/Unison/Name.hs index 3c91b09a78..30ac7297e1 100644 --- a/unison-core/src/Unison/Name.hs +++ b/unison-core/src/Unison/Name.hs @@ -66,7 +66,7 @@ import Data.Monoid (Sum (..)) import Data.RFC5051 qualified as RFC5051 import Data.Set qualified as Set import Unison.Name.Internal -import Unison.NameSegment (NameSegment (..)) +import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment import Unison.Position (Position (..)) import Unison.Prelude @@ -349,7 +349,7 @@ searchByRankedSuffix suffix rel = -- | precondition: input list is deduped, and so is the Name list in -- the tuple -preferShallowLibDepth :: Ord r => [([Name], r)] -> Set r +preferShallowLibDepth :: (Ord r) => [([Name], r)] -> Set r preferShallowLibDepth = \case [] -> Set.empty [x] -> Set.singleton (snd x) diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs index 0bd557cacf..431dbb266a 100644 --- a/unison-share-api/src/Unison/Server/Backend.hs +++ b/unison-share-api/src/Unison/Server/Backend.hs @@ -133,8 +133,8 @@ import Unison.Hashing.V2.Convert qualified as Hashing import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment (..)) -import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment (NameSegment) +import Unison.NameSegment.Internal qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names @@ -170,7 +170,7 @@ import Unison.Syntax.DeclPrinter qualified as DeclPrinter import Unison.Syntax.HashQualified' qualified as HQ' (toText) import Unison.Syntax.Name as Name (toText, unsafeParseText) import Unison.Syntax.NamePrinter qualified as NP -import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText) +import Unison.Syntax.NameSegment qualified as NameSegment (docSegment, libSegment, toEscapedText) import Unison.Syntax.TermPrinter qualified as TermPrinter import Unison.Syntax.TypePrinter qualified as TypePrinter import Unison.Term (Term) @@ -212,10 +212,10 @@ data BackendError = NoSuchNamespace Path.Absolute | -- Failed to parse path BadNamespace + -- | error message String - -- ^ error message + -- | namespace String - -- ^ namespace | CouldntExpandBranchHash ShortCausalHash | AmbiguousBranchHash ShortCausalHash (Set ShortCausalHash) | AmbiguousHashForDefinition ShortHash @@ -276,7 +276,7 @@ data TermEntry v a = TermEntry } deriving (Eq, Ord, Show, Generic) -termEntryLabeledDependencies :: Ord v => TermEntry v a -> Set LD.LabeledDependency +termEntryLabeledDependencies :: (Ord v) => TermEntry v a -> Set LD.LabeledDependency termEntryLabeledDependencies TermEntry {termEntryType, termEntryReferent, termEntryTag, termEntryName} = foldMap Type.labeledDependencies termEntryType <> Set.singleton (LD.TermReferent (Cv.referent2to1UsingCT ct termEntryReferent)) @@ -461,11 +461,11 @@ getTermTag codebase r sig = do V2Referent.Con ref _ -> Just <$> Codebase.runTransaction codebase (Codebase.getDeclType codebase ref) pure $ if - | isDoc -> Doc - | isTest -> Test - | Just CT.Effect <- constructorType -> Constructor Ability - | Just CT.Data <- constructorType -> Constructor Data - | otherwise -> Plain + | isDoc -> Doc + | isTest -> Test + | Just CT.Effect <- constructorType -> Constructor Ability + | Just CT.Data <- constructorType -> Constructor Data + | otherwise -> Plain getTypeTag :: (Var v) => @@ -726,7 +726,7 @@ mungeSyntaxText :: mungeSyntaxText = fmap Syntax.convertElement mkTypeDefinition :: - MonadIO m => + (MonadIO m) => Codebase IO Symbol Ann -> PPED.PrettyPrintEnvDecl -> Width -> @@ -842,7 +842,7 @@ docsForDefinitionName :: Name -> IO [TermReference] docsForDefinitionName codebase (NameSearch {termSearch}) searchType name = do - let potentialDocNames = [name, name Cons.:> "doc"] + let potentialDocNames = [name, name Cons.:> NameSegment.docSegment] Codebase.runTransaction codebase do refs <- potentialDocNames & foldMapM \name -> @@ -1219,7 +1219,7 @@ loadTypeDisplayObject c = \case <$> Codebase.getTypeDeclaration c id -- | Get the causal hash a given project branch points to -causalHashForProjectBranchName :: MonadIO m => ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe CausalHash) +causalHashForProjectBranchName :: (MonadIO m) => ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe CausalHash) causalHashForProjectBranchName (ProjectAndBranch projectName branchName) = do Q.loadProjectBranchByNames projectName branchName >>= \case Nothing -> pure Nothing diff --git a/unison-share-api/src/Unison/Server/Local.hs b/unison-share-api/src/Unison/Server/Local.hs index 211d79f7ea..bf86a8a80e 100644 --- a/unison-share-api/src/Unison/Server/Local.hs +++ b/unison-share-api/src/Unison/Server/Local.hs @@ -14,11 +14,10 @@ import Unison.Codebase.Path import Unison.Codebase.Path qualified as Path import Unison.HashQualified qualified as HQ import Unison.Name (Name) -import Unison.NameSegment (libSegment) -import Unison.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Server.Backend import Unison.Sqlite qualified as Sqlite +import Unison.Syntax.NameSegment qualified as NameSegment -- | Given an arbitrary query and perspective, find the name root the query belongs in, -- then return that root and the query relocated to that root. @@ -62,17 +61,15 @@ inferNamesRoot p b where findBaseProject :: Path -> Maybe Path findBaseProject - ( (NameSegment.toUnescapedText -> "public") - Cons.:< (NameSegment.toUnescapedText -> "base") - Cons.:< release - Cons.:< _rest - ) = - Just (Path.fromList ["public", "base", release]) + (public Cons.:< base Cons.:< release Cons.:< _rest) = + if public == NameSegment.publicLooseCodeSegment && base == NameSegment.baseSegment + then Just (Path.fromList [public, base, release]) + else Nothing findBaseProject _ = Nothing go :: Path -> Branch Sqlite.Transaction -> ReaderT Path (WriterT (Last Path) Sqlite.Transaction) () go p b = do childMap <- lift . lift $ nonEmptyChildren b - when (isJust $ Map.lookup libSegment childMap) $ ask >>= tell . Last . Just + when (isJust $ Map.lookup NameSegment.libSegment childMap) $ ask >>= tell . Last . Just case p of Path.Empty -> pure () (nextChild Cons.:< pathRemainder) -> @@ -99,7 +96,7 @@ inferNamesRoot p b -- Nothing findDepRoot :: Path -> Maybe Path findDepRoot (lib Cons.:< depRoot Cons.:< rest) - | lib == libSegment = + | lib == NameSegment.libSegment = -- Keep looking to see if the full path is actually in a transitive dependency, otherwise -- fallback to this spot ((Path.fromList [lib, depRoot] <>) <$> findDepRoot rest) diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs index 1ba846f120..3de04b5054 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs @@ -35,7 +35,7 @@ import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.HashQualified qualified as HQ import Unison.Name (Name) -import Unison.NameSegment (NameSegment (..)) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnvDecl.Sqlite qualified as PPESqlite diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs index 624ca071e0..bcb6ca5fa1 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs @@ -16,6 +16,7 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path import Unison.Codebase.Runtime qualified as Rt import Unison.Codebase.ShortCausalHash (ShortCausalHash) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Server.Backend @@ -73,4 +74,4 @@ namespaceDetails runtime codebase namespacePath mayRoot _mayWidth = do pure $ namespaceDetails where readmeNames = - Set.fromList ["README", "Readme", "ReadMe", "readme"] + Set.fromList $ NameSegment <$> ["README", "Readme", "ReadMe", "readme"] diff --git a/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs b/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs index e7fa113fa1..3ee32ec101 100644 --- a/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs +++ b/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs @@ -21,7 +21,7 @@ import Unison.HashQualified' qualified as HQ' import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment (..)) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.NamesWithHistory (SearchType (ExactName, IncludeSuffixes)) import Unison.Prelude import Unison.Reference (Reference) diff --git a/unison-share-api/src/Unison/Server/Orphans.hs b/unison-share-api/src/Unison/Server/Orphans.hs index 8aeadc269b..7451d2f183 100644 --- a/unison-share-api/src/Unison/Server/Orphans.hs +++ b/unison-share-api/src/Unison/Server/Orphans.hs @@ -29,7 +29,7 @@ import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment (..)) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Prelude import Unison.Project import Unison.Reference qualified as Reference diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index e2813860f4..4745e56578 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -51,7 +51,7 @@ import Unison.Lexer.Pos (Column, Line, Pos (Pos), column, line) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) -import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH @@ -59,7 +59,7 @@ import Unison.Syntax.HashQualified' qualified as HQ' (toText) import Unison.Syntax.Lexer.Token (Token (..), posP, tokenP) import Unison.Syntax.Name qualified as Name (isSymboly, nameP, toText, unsafeParseText) import Unison.Syntax.NameSegment (symbolyIdChar, wordyIdChar, wordyIdStartChar) -import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..), wordyP) +import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..), docSegment, wordyP) import Unison.Syntax.ReservedWords (delimiters, typeModifiers, typeOrAbility) import Unison.Syntax.ShortHash qualified as ShortHash (shortHashP) import Unison.Util.Bytes qualified as Bytes @@ -441,7 +441,7 @@ lexemes' eof = (Just (WordyId tname)) | isTopLevel -> beforeStartToks - <> [WordyId (HQ'.fromName (Name.snoc (HQ'.toName tname) "doc")) <$ openTok, Open "=" <$ openTok] + <> [WordyId (HQ'.fromName (Name.snoc (HQ'.toName tname) NameSegment.docSegment)) <$ openTok, Open "=" <$ openTok] <> [openTok] <> bodyToks0 <> [closeTok] diff --git a/unison-syntax/src/Unison/Syntax/NameSegment.hs b/unison-syntax/src/Unison/Syntax/NameSegment.hs index 79cdb3a7ae..fed4381ec5 100644 --- a/unison-syntax/src/Unison/Syntax/NameSegment.hs +++ b/unison-syntax/src/Unison/Syntax/NameSegment.hs @@ -1,6 +1,25 @@ -- | Utilities related to the parsing and printing of name segments using the default syntax. module Unison.Syntax.NameSegment - ( -- * String conversions + ( -- * Sentinel name segments + defaultPatchSegment, + docSegment, + libSegment, + publicLooseCodeSegment, + baseSegment, + snocSegment, + consSegment, + concatSegment, + watchSegment, + setSegment, + modifySegment, + licenseSegment, + metadataSegment, + authorsSegment, + copyrightHoldersSegment, + guidSegment, + builtinSegment, + + -- * String conversions toEscapedText, toEscapedTextBuilder, parseText, @@ -33,12 +52,64 @@ import Text.Megaparsec (ParsecT) import Text.Megaparsec qualified as P import Text.Megaparsec.Char qualified as P import Text.Megaparsec.Internal qualified as P (withParsecT) -import Unison.NameSegment (NameSegment (..)) -import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment (libSegment) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) +import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.Syntax.Lexer.Token (Token (..), posP) import Unison.Syntax.ReservedWords (keywords, reservedOperators) +------------------------------------------------------------------------------------------------------------------------ +-- special segment names + +defaultPatchSegment :: NameSegment +defaultPatchSegment = NameSegment "patch" + +docSegment :: NameSegment +docSegment = NameSegment "doc" + +publicLooseCodeSegment :: NameSegment +publicLooseCodeSegment = NameSegment "public" + +baseSegment :: NameSegment +baseSegment = NameSegment "base" + +snocSegment :: NameSegment +snocSegment = NameSegment ":+" + +consSegment :: NameSegment +consSegment = NameSegment "+:" + +concatSegment :: NameSegment +concatSegment = NameSegment "++" + +watchSegment :: NameSegment +watchSegment = NameSegment ">" + +setSegment :: NameSegment +setSegment = NameSegment "set" + +modifySegment :: NameSegment +modifySegment = NameSegment "modify" + +licenseSegment :: NameSegment +licenseSegment = NameSegment "License" + +metadataSegment :: NameSegment +metadataSegment = NameSegment "metadata" + +authorsSegment :: NameSegment +authorsSegment = NameSegment "authors" + +copyrightHoldersSegment :: NameSegment +copyrightHoldersSegment = NameSegment "copyrightHolders" + +guidSegment :: NameSegment +guidSegment = NameSegment "guid" + +builtinSegment :: NameSegment +builtinSegment = NameSegment "builtin" + ------------------------------------------------------------------------------------------------------------------------ -- String conversions @@ -91,7 +162,7 @@ renderParseErr = \case ReservedOperator s -> "reserved operator: " <> s ReservedWord s -> "reserved word: " <> s -segmentP :: Monad m => ParsecT (Token ParseErr) [Char] m NameSegment +segmentP :: (Monad m) => ParsecT (Token ParseErr) [Char] m NameSegment segmentP = P.withParsecT (fmap ReservedOperator) symbolyP <|> P.withParsecT (fmap ReservedWord) wordyP From 467dee15f8d34e615c1065013c0327dadd779533 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 24 May 2024 10:14:22 -0700 Subject: [PATCH 025/631] Checkpoint --- Input.hs | 335 ++++++++++++++++++ .../src/Unison/Codebase/Path.hs | 6 + .../src/Unison/Codebase/ProjectPath.hs | 32 +- unison-cli/src/Unison/Cli/MonadUtils.hs | 143 ++++---- unison-cli/src/Unison/Cli/Pretty.hs | 5 + unison-cli/src/Unison/Cli/ProjectUtils.hs | 16 +- .../Codebase/Editor/HandleInput/Branch.hs | 2 +- .../Editor/HandleInput/BranchRename.hs | 5 +- .../Codebase/Editor/HandleInput/Branches.hs | 9 +- .../Editor/HandleInput/DeleteBranch.hs | 86 +++-- .../Editor/HandleInput/DeleteProject.hs | 25 +- .../Codebase/Editor/HandleInput/InstallLib.hs | 17 +- .../Codebase/Editor/HandleInput/MoveTerm.hs | 9 +- .../Codebase/Editor/HandleInput/MoveType.hs | 7 +- .../Editor/HandleInput/ProjectCreate.hs | 20 +- .../Codebase/Editor/HandleInput/Update.hs | 10 +- .../Codebase/Editor/HandleInput/Update2.hs | 2 +- .../src/Unison/Codebase/Editor/Input.hs | 2 + .../src/Unison/CommandLine/Completion.hs | 2 +- .../src/Unison/CommandLine/FZFResolvers.hs | 2 +- .../src/Unison/CommandLine/InputPatterns.hs | 8 +- unison-cli/src/Unison/CommandLine/Main.hs | 2 +- .../Unison/Server/Local/Endpoints/Current.hs | 2 +- 23 files changed, 529 insertions(+), 218 deletions(-) create mode 100644 Input.hs diff --git a/Input.hs b/Input.hs new file mode 100644 index 0000000000..427d901fb4 --- /dev/null +++ b/Input.hs @@ -0,0 +1,335 @@ +module Unison.Codebase.Editor.Input + ( Input (..), + BranchSourceI (..), + DiffNamespaceToPatchInput (..), + GistInput (..), + PullSourceTarget (..), + PushRemoteBranchInput (..), + PushSourceTarget (..), + PushSource (..), + TestInput (..), + Event (..), + OutputLocation (..), + PatchPath, + BranchId, + AbsBranchId, + UnresolvedProjectBranch, + parseBranchId, + parseBranchId2, + parseShortCausalHash, + HashOrHQSplit', + Insistence (..), + PullMode (..), + OptionalPatch (..), + FindScope (..), + ShowDefinitionScope (..), + IsGlobal, + DeleteOutput (..), + DeleteTarget (..), + ) +where + +import Data.List.NonEmpty (NonEmpty) +import Data.Text qualified as Text +import Data.These (These) +import Unison.Codebase.Branch.Merge qualified as Branch +import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteGitRepo, WriteRemoteNamespace) +import Unison.Codebase.Path (Path, Path') +import Unison.Codebase.Path qualified as Path +import Unison.Codebase.Path.Parse qualified as Path +import Unison.Codebase.PushBehavior (PushBehavior) +import Unison.Codebase.ShortCausalHash (ShortCausalHash) +import Unison.Codebase.ShortCausalHash qualified as SCH +import Unison.CommandLine.BranchRelativePath (BranchRelativePath, parseBranchRelativePath) +import Unison.HashQualified qualified as HQ +import Unison.Name (Name) +import Unison.NameSegment (NameSegment) +import Unison.Prelude +import Unison.Project (ProjectAndBranch, ProjectAndBranchNames, ProjectBranchName, ProjectBranchNameOrLatestRelease, ProjectName, Semver) +import Unison.ShortHash (ShortHash) +import Unison.Util.Pretty qualified as P + +data Event + = UnisonFileChanged SourceName Source + deriving stock (Show) + +type Source = Text -- "id x = x\nconst a b = a" + +type SourceName = Text -- "foo.u" or "buffer 7" + +type PatchPath = Path.Split' + +data OptionalPatch = NoPatch | DefaultPatch | UsePatch PatchPath + deriving (Eq, Ord, Show) + +type BranchId = Either ShortCausalHash Path' + +-- | An unambiguous project branch name, use the current project name if not provided. +type UnresolvedProjectBranch = ProjectAndBranch (Maybe ProjectName) ProjectBranchName + +type AbsBranchId = Either ShortCausalHash Path.Absolute + +type HashOrHQSplit' = Either ShortHash Path.HQSplit' + +-- | Should we force the operation or not? +data Insistence = Force | Try + deriving (Show, Eq) + +parseBranchId :: String -> Either Text BranchId +parseBranchId ('#' : s) = case SCH.fromText (Text.pack s) of + Nothing -> Left "Invalid hash, expected a base32hex string." + Just h -> pure $ Left h +parseBranchId s = Right <$> Path.parsePath' s + +parseBranchId2 :: String -> Either (P.Pretty P.ColorText) (Either ShortCausalHash BranchRelativePath) +parseBranchId2 ('#' : s) = case SCH.fromText (Text.pack s) of + Nothing -> Left "Invalid hash, expected a base32hex string." + Just h -> Right (Left h) +parseBranchId2 s = Right <$> parseBranchRelativePath s + +parseShortCausalHash :: String -> Either String ShortCausalHash +parseShortCausalHash ('#' : s) | Just sch <- SCH.fromText (Text.pack s) = Right sch +parseShortCausalHash _ = Left "Invalid hash, expected a base32hex string." + +data PullMode + = PullWithHistory + | PullWithoutHistory + deriving (Eq, Show) + +type IsGlobal = Bool + +data Input + = -- names stuff: + -- directory ops + -- `Link` must describe a repo and a source path within that repo. + -- clone w/o merge, error if would clobber + ForkLocalBranchI (Either ShortCausalHash BranchRelativePath) BranchRelativePath + | -- merge first causal into destination + MergeLocalBranchI UnresolvedProjectBranch (Maybe UnresolvedProjectBranch) Branch.MergeMode + | PreviewMergeLocalBranchI UnresolvedProjectBranch (Maybe UnresolvedProjectBranch) + | DiffNamespaceI BranchId BranchId -- old new + | PullI !PullSourceTarget !PullMode + | PushRemoteBranchI PushRemoteBranchInput + | ResetRootI (Either ShortCausalHash Path') + | ResetI + ( These + (Either ShortCausalHash Path') + (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + ) + (Maybe UnresolvedProjectBranch) + | -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? + -- Does it make sense to fork from not-the-root of a Github repo? + -- used in Welcome module to give directions to user + CreateMessage (P.Pretty P.ColorText) + | -- Change directory. + SwitchBranchI Path' + | UpI + | PopBranchI + | -- > names foo + -- > names foo.bar + -- > names .foo.bar + -- > names .foo.bar#asdflkjsdf + -- > names #sdflkjsdfhsdf + NamesI IsGlobal (HQ.HashQualified Name) + | AliasTermI HashOrHQSplit' Path.Split' + | AliasTypeI HashOrHQSplit' Path.Split' + | AliasManyI [Path.HQSplit] Path' + | MoveAllI Path.Path' Path.Path' + | -- Move = Rename; It's an HQSplit' not an HQSplit', meaning the arg has to have a name. + MoveTermI Path.HQSplit' Path.Split' + | MoveTypeI Path.HQSplit' Path.Split' + | MoveBranchI Path.Path' Path.Path' + | MovePatchI Path.Split' Path.Split' + | CopyPatchI Path.Split' Path.Split' + | -- delete = unname + DeleteI DeleteTarget + | -- edits stuff: + LoadI (Maybe FilePath) + | ClearI + | AddI (Set Name) + | PreviewAddI (Set Name) + | UpdateI OptionalPatch (Set Name) + | Update2I + | PreviewUpdateI (Set Name) + | TodoI (Maybe PatchPath) Path' + | PropagatePatchI PatchPath Path' + | ListEditsI (Maybe PatchPath) + | -- -- create and remove update directives + DeprecateTermI PatchPath Path.HQSplit' + | DeprecateTypeI PatchPath Path.HQSplit' + | ReplaceI (HQ.HashQualified Name) (HQ.HashQualified Name) (Maybe PatchPath) + | RemoveTermReplacementI (HQ.HashQualified Name) (Maybe PatchPath) + | RemoveTypeReplacementI (HQ.HashQualified Name) (Maybe PatchPath) + | UndoI + | -- First `Maybe Int` is cap on number of results, if any + -- Second `Maybe Int` is cap on diff elements shown, if any + HistoryI (Maybe Int) (Maybe Int) BranchId + | -- execute an IO thunk with args + ExecuteI Text [String] + | -- save the result of a previous Execute + SaveExecuteResultI Name + | -- execute an IO [Result] + IOTestI (HQ.HashQualified Name) + | -- execute all in-scope IO tests + IOTestAllI + | -- make a standalone binary file + MakeStandaloneI String (HQ.HashQualified Name) + | -- execute an IO thunk using scheme + ExecuteSchemeI Text [String] + | -- compile to a scheme file + CompileSchemeI Text (HQ.HashQualified Name) + | TestI TestInput + | CreateAuthorI NameSegment {- identifier -} Text {- name -} + | -- Display provided definitions. + DisplayI OutputLocation (NonEmpty (HQ.HashQualified Name)) + | -- Display docs for provided terms. + DocsI (NonEmpty Path.HQSplit') + | -- other + FindI Bool FindScope [String] -- FindI isVerbose findScope query + | FindShallowI Path' + | FindPatchI + | StructuredFindI FindScope (HQ.HashQualified Name) -- sfind findScope query + | StructuredFindReplaceI (HQ.HashQualified Name) -- sfind.replace rewriteQuery + | -- Show provided definitions. + ShowDefinitionI OutputLocation ShowDefinitionScope (NonEmpty (HQ.HashQualified Name)) + | ShowReflogI + | UpdateBuiltinsI + | MergeBuiltinsI (Maybe Path) + | MergeIOBuiltinsI (Maybe Path) + | ListDependenciesI (HQ.HashQualified Name) + | ListDependentsI (HQ.HashQualified Name) + | -- | List all external dependencies of a given namespace, or the current namespace if + -- no path is provided. + NamespaceDependenciesI (Maybe Path') + | DebugTabCompletionI [String] -- The raw arguments provided + | DebugFuzzyOptionsI String [String] -- cmd and arguments + | DebugFormatI + | DebugNumberedArgsI + | DebugTypecheckedUnisonFileI + | DebugDumpNamespacesI + | DebugDumpNamespaceSimpleI + | DebugTermI (Bool {- Verbose mode -}) (HQ.HashQualified Name) + | DebugTypeI (HQ.HashQualified Name) + | DebugLSPFoldRangesI + | DebugClearWatchI + | DebugDoctorI + | DebugNameDiffI ShortCausalHash ShortCausalHash + | QuitI + | ApiI + | UiI Path' + | DocToMarkdownI Name + | DocsToHtmlI Path' FilePath + | GistI GistInput + | AuthLoginI + | VersionI + | DiffNamespaceToPatchI DiffNamespaceToPatchInput + | ProjectCreateI Bool {- try downloading base? -} (Maybe ProjectName) + | ProjectRenameI ProjectName + | ProjectSwitchI ProjectAndBranchNames + | ProjectsI + | BranchI BranchSourceI (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + | BranchRenameI ProjectBranchName + | BranchesI (Maybe ProjectName) + | CloneI ProjectAndBranchNames (Maybe ProjectAndBranchNames) + | ReleaseDraftI Semver + | UpgradeI !NameSegment !NameSegment + | EditNamespaceI [Path.Path] + | -- New merge algorithm: merge the given project branch into the current one. + MergeI (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + | LibInstallI !(ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) + deriving (Eq, Show) + +-- | The source of a `branch` command: what to make the new branch from. +data BranchSourceI + = -- | Create a branch from the current context + BranchSourceI'CurrentContext + | -- | Create an empty branch + BranchSourceI'Empty + | -- | Create a branch from this other branch + BranchSourceI'UnresolvedProjectBranch UnresolvedProjectBranch + deriving stock (Eq, Show) + +data DiffNamespaceToPatchInput = DiffNamespaceToPatchInput + { -- The first/earlier namespace. + branchId1 :: BranchId, + -- The second/later namespace. + branchId2 :: BranchId, + -- Where to store the patch that corresponds to the diff between the namespaces. + patch :: Path.Split' + } + deriving stock (Eq, Generic, Show) + +-- | @"push.gist repo"@ pushes the contents of the current namespace to @repo@. +data GistInput = GistInput + { repo :: WriteGitRepo + } + deriving stock (Eq, Show) + +-- | Pull source and target: either neither is specified, or only a source, or both. +data PullSourceTarget + = PullSourceTarget0 + | PullSourceTarget1 (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease)) + | PullSourceTarget2 (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease)) (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + deriving stock (Eq, Show) + +data PushSource + = PathySource Path' + | ProjySource (These ProjectName ProjectBranchName) + deriving stock (Eq, Show) + +-- | Push source and target: either neither is specified, or only a target, or both. +data PushSourceTarget + = PushSourceTarget0 + | PushSourceTarget1 (WriteRemoteNamespace (These ProjectName ProjectBranchName)) + | PushSourceTarget2 PushSource (WriteRemoteNamespace (These ProjectName ProjectBranchName)) + deriving stock (Eq, Show) + +data PushRemoteBranchInput = PushRemoteBranchInput + { sourceTarget :: PushSourceTarget, + pushBehavior :: PushBehavior + } + deriving stock (Eq, Show) + +data TestInput = TestInput + { -- | Should we run tests in the `lib` namespace? + includeLibNamespace :: Bool, + -- | Relative path to run the tests in. Ignore if `includeLibNamespace` is True - that means test everything. + path :: Path, + showFailures :: Bool, + showSuccesses :: Bool + } + deriving stock (Eq, Show) + +-- Some commands, like `view`, can dump output to either console or a file. +data OutputLocation + = ConsoleLocation + | LatestFileLocation + | FileLocation FilePath + -- ClipboardLocation + deriving (Eq, Show) + +data FindScope + = FindLocal Path + | FindLocalAndDeps Path + | FindGlobal + deriving stock (Eq, Show) + +data ShowDefinitionScope + = ShowDefinitionLocal + | ShowDefinitionGlobal + deriving stock (Eq, Show) + +data DeleteOutput + = DeleteOutput'Diff + | DeleteOutput'NoDiff + deriving stock (Eq, Show) + +data DeleteTarget + = DeleteTarget'TermOrType DeleteOutput [Path.HQSplit'] + | DeleteTarget'Term DeleteOutput [Path.HQSplit'] + | DeleteTarget'Type DeleteOutput [Path.HQSplit'] + | DeleteTarget'Namespace Insistence Path.Split + | DeleteTarget'Patch Path.Split' + | DeleteTarget'ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + | DeleteTarget'Project ProjectName + deriving stock (Eq, Show) diff --git a/parser-typechecker/src/Unison/Codebase/Path.hs b/parser-typechecker/src/Unison/Codebase/Path.hs index 3b7a7b483d..742833ad3f 100644 --- a/parser-typechecker/src/Unison/Codebase/Path.hs +++ b/parser-typechecker/src/Unison/Codebase/Path.hs @@ -29,6 +29,7 @@ module Unison.Codebase.Path prefixName2, unprefixName, HQSplit, + AbsSplit, Split, Split', HQSplit', @@ -179,6 +180,8 @@ unsplitHQ (p, a) = fmap (snoc p) a unsplitHQ' :: HQSplit' -> HQ'.HashQualified Path' unsplitHQ' (p, a) = fmap (snoc' p) a +type AbsSplit = (Absolute, NameSegment) + type Split = (Path, NameSegment) type HQSplit = (Path, HQ'.HQSegment) @@ -515,6 +518,9 @@ instance Resolve Absolute Relative Absolute where instance Resolve Absolute Relative Path' where resolve l r = AbsolutePath' (resolve l r) +instance Resolve Absolute Path Absolute where + resolve (Absolute l) r = Absolute (resolve l r) + instance Resolve Path' Path' Path' where resolve _ a@(AbsolutePath' {}) = a resolve (AbsolutePath' a) (RelativePath' r) = AbsolutePath' (resolve a r) diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index dc6497fd14..b2b831f9fb 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -8,8 +8,8 @@ module Unison.Codebase.ProjectPath path_, projectAndBranch_, toText, - asIds_, - asNames_, + toIds, + toNames, asProjectAndBranch_, ) where @@ -41,26 +41,12 @@ fromProjectAndBranch :: ProjectAndBranch Project ProjectBranch -> Path.Absolute fromProjectAndBranch (ProjectAndBranch proj branch) path = ProjectPath proj branch path -- | Project a project context into a project path of just IDs -asIds_ :: Lens' ProjectPath ProjectPathIds -asIds_ = lens get set - where - get (ProjectPath proj branch path) = ProjectPath (proj ^. #projectId) (branch ^. #branchId) path - set p (ProjectPath pId bId path) = - p - & #project . #projectId .~ pId - & #branch . #branchId .~ bId - & absPath_ .~ path +toIds :: ProjectPath -> ProjectPathIds +toIds (ProjectPath proj branch path) = ProjectPath (proj ^. #projectId) (branch ^. #branchId) path -- | Project a project context into a project path of just names -asNames_ :: Lens' ProjectPath ProjectPathNames -asNames_ = lens get set - where - get (ProjectPath proj branch path) = ProjectPath (proj ^. #name) (branch ^. #name) path - set p (ProjectPath pName bName path) = - p - & #project . #name .~ pName - & #branch . #name .~ bName - & absPath_ .~ path +toNames :: ProjectPath -> ProjectPathNames +toNames (ProjectPath proj branch path) = ProjectPath (proj ^. #name) (branch ^. #name) path asProjectAndBranch_ :: Lens' ProjectPath (ProjectAndBranch Project ProjectBranch) asProjectAndBranch_ = lens get set @@ -77,9 +63,9 @@ instance Bifoldable ProjectPathG where instance Bitraversable ProjectPathG where bitraverse f g (ProjectPath p b path) = ProjectPath <$> f p <*> g b <*> pure path -toText :: ProjectPathG ProjectName ProjectBranchName -> Text -toText (ProjectPath projName branchName path) = - into @Text projName <> "/" <> into @Text branchName <> ":" <> Path.absToText path +toText :: ProjectPathG Project ProjectBranch -> Text +toText (ProjectPath proj branch path) = + into @Text (proj ^. #name) <> "/" <> into @Text (branch ^. #name) <> ":" <> Path.absToText path absPath_ :: Lens' (ProjectPathG p b) Path.Absolute absPath_ = lens go set diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 29661ee6ac..c9d3e355ce 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -29,10 +29,10 @@ module Unison.Cli.MonadUtils getProjectRoot0, getCurrentBranch, getCurrentBranch0, - getBranchFromProjectRootPath, - getBranch0FromProjectRootPath, - getMaybeBranchFromProjectRootPath, - getMaybeBranch0FromProjectRootPath, + getBranchFromProjectPath, + getBranch0FromProjectPath, + getMaybeBranchFromProjectPath, + getMaybeBranch0FromProjectPath, expectBranchAtPath, expectBranchAtPath', expectBranch0AtPath, @@ -95,6 +95,8 @@ import U.Codebase.Branch qualified as V2 (Branch) import U.Codebase.Branch qualified as V2Branch import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash (..)) +import U.Codebase.Sqlite.Project (Project) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -118,7 +120,7 @@ import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Parser.Ann (Ann (..)) import Unison.Prelude -import Unison.Project (ProjectBranchName, ProjectName) +import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Reference (TypeReference) import Unison.Referent (Referent) import Unison.Sqlite qualified as Sqlite @@ -161,26 +163,26 @@ getCurrentPath = do getCurrentProjectName :: Cli ProjectName getCurrentProjectName = do - view (PP.asNames_ . #project) <$> getCurrentProjectPath + view (#project . #name) <$> getCurrentProjectPath getCurrentProjectBranchName :: Cli ProjectBranchName getCurrentProjectBranchName = do - view (PP.asNames_ . #branch) <$> getCurrentProjectPath + view (#branch . #name) <$> getCurrentProjectPath -- | Resolve a @Path@ (interpreted as relative) to a @Path.Absolute@, per the current path. -resolvePath :: Path -> Cli Path.Absolute +resolvePath :: Path -> Cli PP.ProjectPath resolvePath path = do - currentPath <- getCurrentPath - pure (Path.resolve currentPath (Path.Relative path)) + pp <- getCurrentProjectPath + pure $ pp & PP.absPath_ %~ \p -> Path.resolve p path -- | Resolve a @Path'@ to a @Path.Absolute@, per the current path. -resolvePath' :: Path' -> Cli Path.Absolute -resolvePath' path = do - currentPath <- getCurrentPath - pure (Path.resolve currentPath path) +resolvePath' :: Path' -> Cli PP.ProjectPath +resolvePath' path' = do + pp <- getCurrentProjectPath + pure $ pp & PP.absPath_ %~ \p -> Path.resolve p path' -- | Resolve a path split, per the current path. -resolveSplit' :: (Path', a) -> Cli (Path.Absolute, a) +resolveSplit' :: (Path', a) -> Cli (PP.ProjectPath, a) resolveSplit' = traverseOf _1 resolvePath' @@ -192,22 +194,24 @@ resolveSplit' = resolveAbsBranchId :: Input.AbsBranchId -> Cli (Branch IO) resolveAbsBranchId = \case Left hash -> resolveShortCausalHash hash - Right path -> getBranchFromProjectRootPath path + Right absPath -> do + pp <- resolvePath' (Path' (Left absPath)) + getBranchFromProjectPath pp -- | V2 version of 'resolveAbsBranchId2'. resolveAbsBranchIdV2 :: (forall void. Output.Output -> Sqlite.Transaction void) -> + ProjectAndBranch Project ProjectBranch -> Input.AbsBranchId -> Sqlite.Transaction (V2.Branch Sqlite.Transaction) -resolveAbsBranchIdV2 rollback = \case +resolveAbsBranchIdV2 rollback (ProjectAndBranch proj branch) = \case Left shortHash -> do hash <- resolveShortCausalHashToCausalHash rollback shortHash - succeed (Codebase.expectCausalBranchByCausalHash hash) - Right path -> succeed (Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute path)) - where - succeed getCausal = do - causal <- getCausal - V2Causal.value causal + causal <- (Codebase.expectCausalBranchByCausalHash hash) + V2Causal.value causal + Right absPath -> do + let pp = PP.ProjectPath proj branch absPath + Codebase.getShallowBranchAtProjectPath pp -- | Resolve a @BranchId@ to the corresponding @Branch IO@, or fail if no such branch hash is found. (Non-existent -- branches by path are OK - the empty branch will be returned). @@ -219,7 +223,7 @@ resolveBranchId branchId = do -- | Resolve a @BranchId@ to an @AbsBranchId@. resolveBranchIdToAbsBranchId :: Input.BranchId -> Cli Input.AbsBranchId resolveBranchIdToAbsBranchId = - traverseOf _Right resolvePath' + traverseOf _Right (fmap (view PP.absPath_) . resolvePath') -- | Resolve a @ShortCausalHash@ to the corresponding @Branch IO@, or fail if no such branch hash is found. resolveShortCausalHash :: ShortCausalHash -> Cli (Branch IO) @@ -288,25 +292,28 @@ getCurrentBranch0 = do Branch.head <$> getCurrentBranch -- | Get the branch at an absolute path from the project root. -getBranchFromProjectRootPath :: Path.Absolute -> Cli (Branch IO) -getBranchFromProjectRootPath path = - getMaybeBranchFromProjectRootPath path <&> fromMaybe Branch.empty +getBranchFromProjectPath :: PP.ProjectPath -> Cli (Branch IO) +getBranchFromProjectPath pp = + getMaybeBranchFromProjectPath pp <&> fromMaybe Branch.empty -- | Get the branch0 at an absolute path. -getBranch0FromProjectRootPath :: Path.Absolute -> Cli (Branch0 IO) -getBranch0FromProjectRootPath path = - Branch.head <$> getBranchFromProjectRootPath path +getBranch0FromProjectPath :: PP.ProjectPath -> Cli (Branch0 IO) +getBranch0FromProjectPath pp = + Branch.head <$> getBranchFromProjectPath pp -- | Get the maybe-branch at an absolute path. -getMaybeBranchFromProjectRootPath :: Path.Absolute -> Cli (Maybe (Branch IO)) -getMaybeBranchFromProjectRootPath path = do - rootBranch <- getProjectRoot - pure (Branch.getAt (Path.unabsolute path) rootBranch) +getMaybeBranchFromProjectPath :: PP.ProjectPath -> Cli (Maybe (Branch IO)) +getMaybeBranchFromProjectPath pp = do + Cli.Env {codebase} <- ask + let ProjectBranch {causalHashId} = pp ^. #branch + causalHash <- Cli.runTransaction $ Q.expectCausalHash causalHashId + rootBranch <- liftIO $ Codebase.expectBranchForHash codebase causalHash + pure (Branch.getAt (pp ^. PP.path_) rootBranch) -- | Get the maybe-branch0 at an absolute path. -getMaybeBranch0FromProjectRootPath :: Path.Absolute -> Cli (Maybe (Branch0 IO)) -getMaybeBranch0FromProjectRootPath path = - fmap Branch.head <$> getMaybeBranchFromProjectRootPath path +getMaybeBranch0FromProjectPath :: PP.ProjectPath -> Cli (Maybe (Branch0 IO)) +getMaybeBranch0FromProjectPath pp = + fmap Branch.head <$> getMaybeBranchFromProjectPath pp -- | Get the branch at a relative path, or return early if there's no such branch. expectBranchAtPath :: Path -> Cli (Branch IO) @@ -317,7 +324,7 @@ expectBranchAtPath = expectBranchAtPath' :: Path' -> Cli (Branch IO) expectBranchAtPath' path0 = do path <- resolvePath' path0 - getMaybeBranchFromProjectRootPath path & onNothingM (Cli.returnEarly (Output.BranchNotFound path0)) + getMaybeBranchFromProjectPath path & onNothingM (Cli.returnEarly (Output.BranchNotFound path0)) -- | Get the branch0 at an absolute or relative path, or return early if there's no such branch. expectBranch0AtPath' :: Path' -> Cli (Branch0 IO) @@ -343,48 +350,52 @@ assertNoBranchAtPath' path' = do -- current terms/types etc). branchExistsAtPath' :: Path' -> Cli Bool branchExistsAtPath' path' = do - absPath <- resolvePath' path' + pp <- resolvePath' path' Cli.runTransaction do - causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute absPath) - branch <- V2Causal.value causal + branch <- Codebase.getShallowBranchAtProjectPath pp isEmpty <- V2Branch.isEmpty branch pure (not isEmpty) ------------------------------------------------------------------------------------------------------------------------ -- Updating branches +relativizeActions :: (Foldable f) => f (Path.Absolute, x) -> [(Path, x)] +relativizeActions actions = + toList actions + & traversed . _1 %~ Path.unabsolute + stepAt :: Text -> - (Path, Branch0 IO -> Branch0 IO) -> + (Path.Absolute, Branch0 IO -> Branch0 IO) -> Cli () stepAt cause = stepManyAt @[] cause . pure stepAt' :: Text -> - (Path, Branch0 IO -> Cli (Branch0 IO)) -> + (Path.Absolute, Branch0 IO -> Cli (Branch0 IO)) -> Cli Bool stepAt' cause = stepManyAt' @[] cause . pure stepAtNoSync' :: - (Path, Branch0 IO -> Cli (Branch0 IO)) -> + (Path.Absolute, Branch0 IO -> Cli (Branch0 IO)) -> Cli Bool stepAtNoSync' = stepManyAtNoSync' @[] . pure stepAtNoSync :: - (Path, Branch0 IO -> Branch0 IO) -> + (Path.Absolute, Branch0 IO -> Branch0 IO) -> Cli () stepAtNoSync = stepManyAtNoSync @[] . pure stepAtM :: Text -> - (Path, Branch0 IO -> IO (Branch0 IO)) -> + (Path.Absolute, Branch0 IO -> IO (Branch0 IO)) -> Cli () stepAtM cause = stepManyAtM @[] cause . pure stepManyAt :: (Foldable f) => Text -> - f (Path, Branch0 IO -> Branch0 IO) -> + f (Path.Absolute, Branch0 IO -> Branch0 IO) -> Cli () stepManyAt reason actions = do stepManyAtNoSync actions @@ -393,7 +404,7 @@ stepManyAt reason actions = do stepManyAt' :: (Foldable f) => Text -> - f (Path, Branch0 IO -> Cli (Branch0 IO)) -> + f (Path.Absolute, Branch0 IO -> Cli (Branch0 IO)) -> Cli Bool stepManyAt' reason actions = do res <- stepManyAtNoSync' actions @@ -402,26 +413,26 @@ stepManyAt' reason actions = do stepManyAtNoSync' :: (Foldable f) => - f (Path, Branch0 IO -> Cli (Branch0 IO)) -> + f (Path.Absolute, Branch0 IO -> Cli (Branch0 IO)) -> Cli Bool stepManyAtNoSync' actions = do origRoot <- getProjectRoot - newRoot <- Branch.stepManyAtM actions origRoot + newRoot <- Branch.stepManyAtM (relativizeActions actions) origRoot setCurrentProjectRoot newRoot pure (origRoot /= newRoot) -- Like stepManyAt, but doesn't update the last saved root stepManyAtNoSync :: (Foldable f) => - f (Path, Branch0 IO -> Branch0 IO) -> + f (Path.Absolute, Branch0 IO -> Branch0 IO) -> Cli () -stepManyAtNoSync actions = - void . modifyProjectRoot $ Branch.stepManyAt actions +stepManyAtNoSync actions = do + void . modifyProjectRoot $ Branch.stepManyAt (relativizeActions actions) stepManyAtM :: (Foldable f) => Text -> - f (Path, Branch0 IO -> IO (Branch0 IO)) -> + f (Path.Absolute, Branch0 IO -> IO (Branch0 IO)) -> Cli () stepManyAtM reason actions = do stepManyAtMNoSync actions @@ -429,11 +440,11 @@ stepManyAtM reason actions = do stepManyAtMNoSync :: (Foldable f) => - f (Path, Branch0 IO -> IO (Branch0 IO)) -> + f (Path.Absolute, Branch0 IO -> IO (Branch0 IO)) -> Cli () stepManyAtMNoSync actions = do oldRoot <- getProjectRoot - newRoot <- liftIO (Branch.stepManyAtM actions oldRoot) + newRoot <- liftIO (Branch.stepManyAtM (relativizeActions actions) oldRoot) setCurrentProjectRoot newRoot -- | Sync the in-memory root branch. @@ -488,18 +499,18 @@ updateCurrentProjectRoot new reason = ------------------------------------------------------------------------------------------------------------------------ -- Getting terms -getTermsAt :: (Path.Absolute, HQ'.HQSegment) -> Cli (Set Referent) -getTermsAt path = do - rootBranch0 <- getProjectRoot0 - pure (BranchUtil.getTerm (Path.convert path) rootBranch0) +getTermsAt :: (PP.ProjectPath, HQ'.HQSegment) -> Cli (Set Referent) +getTermsAt (pp, hqSeg) = do + rootBranch0 <- getBranch0FromProjectPath pp + pure (BranchUtil.getTerm (mempty, hqSeg) rootBranch0) ------------------------------------------------------------------------------------------------------------------------ -- Getting types -getTypesAt :: (Path.Absolute, HQ'.HQSegment) -> Cli (Set TypeReference) -getTypesAt path = do - rootBranch0 <- getProjectRoot0 - pure (BranchUtil.getType (Path.convert path) rootBranch0) +getTypesAt :: (PP.ProjectPath, HQ'.HQSegment) -> Cli (Set TypeReference) +getTypesAt (pp, hqSeg) = do + rootBranch0 <- getBranch0FromProjectPath pp + pure (BranchUtil.getType (mempty, hqSeg) rootBranch0) ------------------------------------------------------------------------------------------------------------------------ -- Getting patches @@ -517,8 +528,8 @@ getPatchAt path = -- | Get the patch at a path. getMaybePatchAt :: Path.Split' -> Cli (Maybe Patch) getMaybePatchAt path0 = do - (path, name) <- resolveSplit' path0 - branch <- getBranch0FromProjectRootPath path + (pp, name) <- resolveSplit' path0 + branch <- getBranch0FromProjectPath pp liftIO (Branch.getMaybePatch name branch) -- | Get the patch at a path, or return early if there's no such patch. diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index c3a3ea88e2..aa22fa3daf 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -5,6 +5,7 @@ module Unison.Cli.Pretty ( displayBranchHash, prettyAbsolute, + prettyProjectPath, prettyBase32Hex#, prettyBase32Hex, prettyBranchId, @@ -88,6 +89,7 @@ import Unison.Codebase.Editor.RemoteRepo import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.Core.Project (ProjectBranchName) @@ -214,6 +216,9 @@ prettyRelative = P.blue . P.shown prettyAbsolute :: Path.Absolute -> Pretty prettyAbsolute = P.blue . P.shown +prettyProjectPath :: PP.ProjectPath -> Pretty +prettyProjectPath = P.blue . P.shown + prettySCH :: (IsString s) => ShortCausalHash -> P.Pretty s prettySCH hash = P.group $ "#" <> P.text (SCH.toText hash) diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index 8d9b66c15a..6758fea324 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -3,7 +3,6 @@ module Unison.Cli.ProjectUtils ( -- * Project/path helpers expectProjectBranchByName, resolveBranchRelativePath, - resolveProjectPath, resolveProjectBranch, -- * Name hydration @@ -47,7 +46,6 @@ import Unison.Cli.Share.Projects (IncludeSquashedHead) import Unison.Cli.Share.Projects qualified as Share import Unison.Codebase.Editor.Output (Output (LocalProjectBranchDoesntExist)) import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..)) @@ -108,7 +106,7 @@ hydrateNames = \case This projectName -> pure (ProjectAndBranch projectName (unsafeFrom @Text "main")) That branchName -> do pp <- Cli.getCurrentProjectPath - pure (ProjectAndBranch (pp ^. PP.asNames_ . #project) branchName) + pure (ProjectAndBranch (pp ^. #project . #name) branchName) These projectName branchName -> pure (ProjectAndBranch projectName branchName) -- Expect a local project+branch by ids. @@ -165,18 +163,6 @@ expectProjectAndBranchByTheseNames = \case maybeProjectAndBranch & onNothing do Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName)) --- | Expect/resolve a branch-relative path with the following rules: --- --- 1. If the project is missing, use the current project. --- 2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the current --- project, defaulting to 'main' if branch is unspecified. --- 3. If we just have a path, resolve it using the current project. -resolveProjectPath :: Project -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Maybe Path' -> Cli PP.ProjectPath -resolveProjectPath defaultProj mayProjAndBranch mayPath' = do - projAndBranch <- resolveProjectBranch defaultProj mayProjAndBranch - absPath <- fromMaybe Path.absoluteEmpty <$> traverse Cli.resolvePath' mayPath' - pure $ PP.fromProjectAndBranch projAndBranch absPath - -- | Expect/resolve branch reference with the following rules: -- -- 1. If the project is missing, use the provided project. diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 1393ce8ff7..e67fda5df4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -39,7 +39,7 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB Cli.returnEarly (Output.CannotCreateReleaseBranchWithBranchCommand newBranchName ver) ProjectBranchNameKind'NothingSpecial -> pure () - currentProjectName <- Cli.getCurrentProjectPath <&> view (PP.asNames_ . #project) + currentProjectName <- Cli.getCurrentProjectPath <&> view (#project . #name) destProject <- do Cli.runTransactionWithRollback \rollback -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs index bdf20d61be..1657568ca9 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs @@ -8,14 +8,15 @@ import Control.Lens ((^.)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Cli.MonadUtils qualified as Cli import Unison.Codebase.Editor.Output qualified as Output +import Unison.Codebase.ProjectPath qualified as PP import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectBranchNameKind (..), classifyProjectBranchName) handleBranchRename :: ProjectBranchName -> Cli () handleBranchRename newBranchName = do - (ProjectAndBranch project branch, _path) <- ProjectUtils.expectCurrentProjectBranch + PP.ProjectPath project branch _path <- Cli.getCurrentProjectPath case classifyProjectBranchName newBranchName of ProjectBranchNameKind'Contributor {} -> pure () diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs index 024ef29f26..8d82f100c1 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs @@ -10,14 +10,14 @@ import Network.URI (URI) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Cli.MonadUtils qualified as Cli import Unison.Codebase.Editor.Output qualified as Output import Unison.Prelude -import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) +import Unison.Project (ProjectBranchName, ProjectName) handleBranches :: Maybe ProjectName -> Cli () handleBranches maybeProjectName = do - maybeCurrentProjectIds <- ProjectUtils.getCurrentProjectIds + pp <- Cli.getCurrentProjectPath (project, branches) <- Cli.runTransactionWithRollback \rollback -> do project <- @@ -26,8 +26,7 @@ handleBranches maybeProjectName = do Queries.loadProjectByName projectName & onNothingM do rollback (Output.LocalProjectDoesntExist projectName) Nothing -> do - ProjectAndBranch projectId _ <- maybeCurrentProjectIds & onNothing (rollback Output.NotOnProjectBranch) - Queries.expectProject projectId + pure (pp ^. #project) branches <- Queries.loadAllProjectBranchInfo (project ^. #projectId) pure (project, branches) Cli.respondNumbered (Output.ListBranches (project ^. #name) (f branches)) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs index b6865748f1..7257c0f731 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs @@ -4,19 +4,18 @@ module Unison.Codebase.Editor.HandleInput.DeleteBranch ) where -import Control.Lens (over, (^.)) -import Data.Map.Strict qualified as Map -import Data.These (These (..)) +import Control.Lens +import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils -import Unison.Codebase.Branch qualified as Branch -import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.Editor.HandleInput.ProjectCreate +import Unison.Codebase.ProjectPath (ProjectPathG (..)) import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) +import Unison.Sqlite qualified as Sqlite import Witch (unsafeFrom) -- | Delete a project branch. @@ -25,47 +24,46 @@ import Witch (unsafeFrom) -- Its children branches, if any, are reparented to their grandparent, if any. You may delete the only branch in a -- project. handleDeleteBranch :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () -handleDeleteBranch projectAndBranchNames0 = do - projectAndBranchNames <- - ProjectUtils.hydrateNames - case projectAndBranchNames0 of - ProjectAndBranch Nothing branch -> That branch - ProjectAndBranch (Just project) branch -> These project branch +handleDeleteBranch projectAndBranchNames = do + ProjectPath currentProject currentBranch _ <- Cli.getCurrentProjectPath + ProjectAndBranch _proj branchToDelete <- ProjectUtils.resolveProjectBranch currentProject (projectAndBranchNames & #branch %~ Just) + Cli.runTransaction do + Queries.deleteProjectBranch (branchToDelete ^. #projectId) (branchToDelete ^. #branchId) - maybeCurrentBranch <- ProjectUtils.getCurrentProjectBranch - - deletedBranch <- - Cli.runTransactionWithRollback \rollback -> do - branch <- - Queries.loadProjectBranchByNames (projectAndBranchNames ^. #project) (projectAndBranchNames ^. #branch) - & onNothingM (rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames)) - Queries.deleteProjectBranch (branch ^. #projectId) (branch ^. #branchId) - pure branch - - let projectId = deletedBranch ^. #projectId - - Cli.stepAt - ("delete.branch " <> into @Text projectAndBranchNames) - ( Path.unabsolute (ProjectUtils.projectBranchesPath projectId), - \branchObject -> - branchObject - & over - Branch.children - (Map.delete (ProjectUtils.projectBranchSegment (deletedBranch ^. #branchId))) - ) + let projectId = branchToDelete ^. #projectId -- If the user is on the branch that they're deleting, we have to cd somewhere; try these in order: -- -- 1. cd to parent branch, if it exists -- 2. cd to "main", if it exists - -- 3. cd to loose code path `.` - whenJust maybeCurrentBranch \(ProjectAndBranch _currentProject currentBranch, _restPath) -> - when (deletedBranch == currentBranch) do - newPath <- - case deletedBranch ^. #parentBranchId of - Nothing -> - Cli.runTransaction (Queries.loadProjectBranchByName projectId (unsafeFrom @Text "main")) <&> \case - Nothing -> Path.Absolute Path.empty - Just mainBranch -> ProjectUtils.projectBranchPath (ProjectAndBranch projectId (mainBranch ^. #branchId)) - Just parentBranchId -> pure (ProjectUtils.projectBranchPath (ProjectAndBranch projectId parentBranchId)) - Cli.cd newPath + -- 3. Any other branch in the codebase + -- 4. Create a dummy project and go to /main + when (branchToDelete ^. #branchId == currentBranch ^. #branchId) do + mayNextLocation <- + Cli.runTransaction . runMaybeT $ + asum + [ parentBranch projectId (branchToDelete ^. #parentBranchId), + findMainBranchInProject projectId, + findAnyBranchInProject projectId, + findAnyBranchInCodebase + ] + nextLoc <- mayNextLocation `whenNothing` projectCreate False Nothing + Cli.switchProject nextLoc + where + parentBranch :: ProjectId -> Maybe ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + parentBranch projectId mayParentBranchId = do + parentBranchId <- hoistMaybe mayParentBranchId + pure (ProjectAndBranch projectId parentBranchId) + findMainBranchInProject :: ProjectId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + findMainBranchInProject projectId = do + branch <- MaybeT $ Queries.loadProjectBranchByName projectId (unsafeFrom @Text "main") + pure (ProjectAndBranch projectId (branch ^. #branchId)) + + findAnyBranchInProject :: ProjectId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + findAnyBranchInProject projectId = do + (someBranchId, _) <- MaybeT . fmap listToMaybe $ Queries.loadAllProjectBranchesBeginningWith projectId Nothing + pure (ProjectAndBranch projectId someBranchId) + findAnyBranchInCodebase :: MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + findAnyBranchInCodebase = do + (_, pbIds) <- MaybeT . fmap listToMaybe $ Queries.loadAllProjectBranchNamePairs + pure pbIds diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs index 0004204670..272bbe7a9e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs @@ -10,17 +10,16 @@ import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli -import Unison.Cli.ProjectUtils qualified as ProjectUtils -import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Editor.HandleInput.ProjectCreate (projectCreate) import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPathG (..)) import Unison.Prelude -import Unison.Project (ProjectAndBranch (..), ProjectName) +import Unison.Project (ProjectName) -- | Delete a project handleDeleteProject :: ProjectName -> Cli () handleDeleteProject projectName = do - maybeCurrentBranch <- ProjectUtils.getCurrentProjectBranch + ProjectPath currentProject _ _ <- Cli.getCurrentProjectPath deletedProject <- Cli.runTransactionWithRollback \rollback -> do @@ -30,14 +29,8 @@ handleDeleteProject projectName = do Queries.deleteProject (project ^. #projectId) pure project - let projectId = deletedProject ^. #projectId - - Cli.updateAt - ("delete.project " <> into @Text projectName) - (ProjectUtils.projectPath projectId) - (const Branch.empty) - - -- If the user is on the project that they're deleting, we cd to the root path - whenJust maybeCurrentBranch \(ProjectAndBranch currentProject _currentBranch, _restPath) -> - when (on (==) (view #projectId) deletedProject currentProject) do - Cli.cd (Path.Absolute Path.empty) + -- If the user is on the project that they're deleting, we create a new project to switch + -- to. + when (((==) `on` (view #projectId)) deletedProject currentProject) do + nextLoc <- projectCreate False Nothing + Cli.switchProject nextLoc diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs index 11d51197c5..6242eea115 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs @@ -10,8 +10,6 @@ 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 @@ -39,14 +37,6 @@ 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 <- @@ -75,7 +65,7 @@ handleInstallLib (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName) -- -- 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 + currentBranchObject <- Cli.getProjectRoot0 pure $ fresh (\i -> NameSegment.unsafeParseText . (<> "__" <> tShow i) . NameSegment.toUnescapedText) @@ -86,10 +76,7 @@ handleInstallLib (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName) (makeDependencyName libdepProjectName libdepBranchName) let libdepPath :: Path.Absolute - libdepPath = - Path.resolve - currentProjectBranchPath - (Path.Relative (Path.fromList [NameSegment.libSegment, libdepNameSegment])) + libdepPath = Path.Absolute $ Path.fromList [NameSegment.libSegment, libdepNameSegment] let reflogDescription = "lib.install " <> into @Text libdepProjectAndBranchNames _didUpdate <- Cli.updateAt reflogDescription libdepPath (\_empty -> remoteBranchObject) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs index fc57ff768f..52ccc84b10 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs @@ -1,6 +1,6 @@ module Unison.Codebase.Editor.HandleInput.MoveTerm (doMoveTerm, moveTermSteps) where -import Control.Lens (over, _2) +import Control.Lens import Data.Set qualified as Set import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -9,13 +9,14 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path (Path, Path') +import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.HashQualified' qualified as HQ' import Unison.NameSegment (NameSegment) import Unison.Prelude -moveTermSteps :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Cli [(Path, Branch0 m -> Branch0 m)] +moveTermSteps :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Cli [(Path.Absolute, Branch0 m -> Branch0 m)] moveTermSteps src' dest' = do src <- Cli.resolveSplit' src' srcTerms <- Cli.getTermsAt src @@ -29,7 +30,7 @@ moveTermSteps src' dest' = do destTerms <- Cli.getTermsAt (Path.convert dest) when (not (Set.null destTerms)) do Cli.returnEarly (Output.TermAlreadyExists dest' destTerms) - let p = Path.convert src + let p = src & _1 %~ view PP.absPath_ pure [ -- Mitchell: throwing away any hash-qualification here seems wrong! BranchUtil.makeDeleteTermName (over _2 HQ'.toName p) srcTerm, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs index b9da6747be..8d06e1ab03 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs @@ -1,6 +1,6 @@ module Unison.Codebase.Editor.HandleInput.MoveType (doMoveType, moveTypeSteps) where -import Control.Lens (over, _2) +import Control.Lens import Data.Set qualified as Set import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -11,6 +11,7 @@ import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path (Path, Path') import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.HashQualified' qualified as HQ' import Unison.NameSegment (NameSegment) import Unison.Prelude @@ -29,11 +30,11 @@ moveTypeSteps src' dest' = do destTypes <- Cli.getTypesAt (Path.convert dest) when (not (Set.null destTypes)) do Cli.returnEarly (Output.TypeAlreadyExists dest' destTypes) - let p = Path.convert src + let p = over _1 (view PP.path_) src pure [ -- Mitchell: throwing away any hash-qualification here seems wrong! BranchUtil.makeDeleteTypeName (over _2 HQ'.toName p) srcType, - BranchUtil.makeAddTypeName (Path.convert dest) srcType + BranchUtil.makeAddTypeName (over _1 (view PP.path_) dest) srcType ] doMoveType :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli () diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs index 90dead6159..aca9c87a2a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs @@ -17,7 +17,6 @@ import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli (stepAt) -import Unison.Cli.ProjectUtils (projectBranchPath) import Unison.Cli.Share.Projects qualified as Share import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch @@ -57,12 +56,13 @@ import Witch (unsafeFrom) -- -- For now, it doesn't seem worth it to do (1) or (2), since we want to do (3) eventually, and we'd rather not waste too -- much time getting everything perfectly correct before we get there. -projectCreate :: Bool -> Maybe ProjectName -> Cli () +projectCreate :: Bool -> Maybe ProjectName -> Cli (ProjectAndBranch ProjectId ProjectBranchId) projectCreate tryDownloadingBase maybeProjectName = do projectId <- liftIO (ProjectId <$> UUID.nextRandom) branchId <- liftIO (ProjectBranchId <$> UUID.nextRandom) let branchName = unsafeFrom @Text "main" + (_, emptyCausalHashId) <- Cli.runTransaction Codebase.emptyCausalHash projectName <- case maybeProjectName of @@ -74,7 +74,7 @@ projectCreate tryDownloadingBase maybeProjectName = do projectName : projectNames -> Queries.projectExistsByName projectName >>= \case False -> do - insertProjectAndBranch projectId projectName branchId branchName + insertProjectAndBranch projectId projectName branchId branchName emptyCausalHashId pure projectName True -> loop projectNames loop randomProjectNames @@ -82,13 +82,12 @@ projectCreate tryDownloadingBase maybeProjectName = do Cli.runTransactionWithRollback \rollback -> do Queries.projectExistsByName projectName >>= \case False -> do - insertProjectAndBranch projectId projectName branchId branchName + insertProjectAndBranch projectId projectName branchId branchName emptyCausalHashId pure projectName True -> rollback (Output.ProjectNameAlreadyExists projectName) - let path = projectBranchPath ProjectAndBranch {project = projectId, branch = branchId} Cli.respond (Output.CreatedProject (isNothing maybeProjectName) projectName) - Cli.cd path + Cli.switchProject (ProjectAndBranch projectId branchId) maybeBaseLatestReleaseBranchObject <- if tryDownloadingBase @@ -144,17 +143,18 @@ projectCreate tryDownloadingBase maybeProjectName = do (Map.insert NameSegment.libSegment projectBranchLibObject) Branch.empty0 - Cli.stepAt reflogDescription (Path.unabsolute path, const projectBranchObject) + Cli.stepAt reflogDescription (Path.absoluteEmpty, const projectBranchObject) Cli.respond Output.HappyCoding + pure ProjectAndBranch {project = projectId, branch = branchId} where reflogDescription = case maybeProjectName of Nothing -> "project.create" Just projectName -> "project.create " <> into @Text projectName -insertProjectAndBranch :: ProjectId -> ProjectName -> ProjectBranchId -> ProjectBranchName -> Sqlite.Transaction () -insertProjectAndBranch projectId projectName branchId branchName = do +insertProjectAndBranch :: ProjectId -> ProjectName -> ProjectBranchId -> ProjectBranchName -> CausalHashId -> Sqlite.Transaction () +insertProjectAndBranch projectId projectName branchId branchName chId = do Queries.insertProject projectId projectName Queries.insertProjectBranch Sqlite.ProjectBranch @@ -162,7 +162,7 @@ insertProjectAndBranch projectId projectName branchId branchName = do branchId, name = branchName, parentBranchId = Nothing, - rootCausalHash = error "Add causal hash id in insertProjectAndBranch" + causalHashId = chId } Queries.setMostRecentBranch projectId branchId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs index 23c9fb4736..77c7fc7885 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs @@ -174,16 +174,16 @@ handleUpdate input optionalPatch requestedNames = do -- take a look at the `updates` from the SlurpResult -- and make a patch diff to record a replacement from the old to new references Cli.stepManyAtMNoSync - ( [ ( Path.unabsolute currentPath', + ( [ ( currentPath', pure . doSlurpUpdates typeEdits termEdits termDeprecations ), - ( Path.unabsolute currentPath', + ( currentPath', pure . doSlurpAdds addsAndUpdates (Slurp.originalFile sr) ) ] ++ case patchOps of Nothing -> [] - Just (_, update, p) -> [(Path.unabsolute p, update)] + Just (_, update, p) -> [(p, update)] ) Cli.runTransaction . Codebase.addDefsToCodebase codebase @@ -501,7 +501,7 @@ getSlurpResultForUpdate requestedNames slurpCheckNames = do -- fresh2 = fresh1 + 2 -- fresh3 = fresh2 + 3 terms = - Map.fromList $ Map.elems refToGeneratedNameAndTerm <&> \(v,term) -> (v, (External, term)), + Map.fromList $ Map.elems refToGeneratedNameAndTerm <&> \(v, term) -> (v, (External, term)), -- In the context of this update, whatever watches were in the latest typechecked Unison file are -- irrelevant, so we don't need to copy them over. watches = Map.empty @@ -649,7 +649,7 @@ doSlurpUpdates typeEdits termEdits deprecated b0 = propagatePatchNoSync :: Patch -> Path.Absolute -> Cli Bool propagatePatchNoSync patch scopePath = Cli.time "propagatePatchNoSync" do - Cli.stepAtNoSync' (Path.unabsolute scopePath, Propagate.propagateAndApply patch) + Cli.stepAtNoSync' (scopePath, Propagate.propagateAndApply patch) recomponentize :: [(Reference.Id, a)] -> [(Hash, [a])] recomponentize = diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index de4e39c473..710a98a27a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -206,7 +206,7 @@ saveTuf getConstructors tuf = do Cli.runTransactionWithRollback \abort -> do Codebase.addDefsToCodebase codebase tuf typecheckedUnisonFileToBranchUpdates abort getConstructors tuf - Cli.stepAt "update" (Path.unabsolute currentPath, Branch.batchUpdates branchUpdates) + Cli.stepAt "update" (currentPath, Branch.batchUpdates branchUpdates) -- @typecheckedUnisonFileToBranchUpdates getConstructors file@ returns a list of branch updates (suitable for passing -- along to `batchUpdates` or some "step at" combinator) that corresponds to using all of the contents of @file@. diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 427d901fb4..5a9304c1ea 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -67,6 +67,8 @@ type BranchId = Either ShortCausalHash Path' -- | An unambiguous project branch name, use the current project name if not provided. type UnresolvedProjectBranch = ProjectAndBranch (Maybe ProjectName) ProjectBranchName +-- | TODO: You should probably use a `ProjectPath` instead of a `Path.Absolute` in most +-- cases. type AbsBranchId = Either ShortCausalHash Path.Absolute type HashOrHQSplit' = Either ShortHash Path.HQSplit' diff --git a/unison-cli/src/Unison/CommandLine/Completion.hs b/unison-cli/src/Unison/CommandLine/Completion.hs index 7249aea28c..d6ce46087a 100644 --- a/unison-cli/src/Unison/CommandLine/Completion.hs +++ b/unison-cli/src/Unison/CommandLine/Completion.hs @@ -145,7 +145,7 @@ completeWithinNamespace :: Sqlite.Transaction [System.Console.Haskeline.Completion.Completion] completeWithinNamespace compTypes query ppCtx = do shortHashLen <- Codebase.hashLength - b <- Codebase.getShallowBranchAtProjectPath (queryProjectPath ^. PP.asIds_) + b <- Codebase.getShallowBranchAtProjectPath queryProjectPath currentBranchSuggestions <- do nib <- namesInBranch shortHashLen b nib diff --git a/unison-cli/src/Unison/CommandLine/FZFResolvers.hs b/unison-cli/src/Unison/CommandLine/FZFResolvers.hs index 704fdc2b33..37fdff8b18 100644 --- a/unison-cli/src/Unison/CommandLine/FZFResolvers.hs +++ b/unison-cli/src/Unison/CommandLine/FZFResolvers.hs @@ -177,7 +177,7 @@ projectBranchOptions codebase _projCtx _searchBranch0 = do -- E.g. '@unison/base/main' projectBranchOptionsWithinCurrentProject :: OptionFetcher projectBranchOptionsWithinCurrentProject codebase projCtx _searchBranch0 = do - Codebase.runTransaction codebase (Q.loadAllProjectBranchesBeginningWith (projCtx ^. PP.asIds_ . #project) Nothing) + Codebase.runTransaction codebase (Q.loadAllProjectBranchesBeginningWith (projCtx ^. #project . #projectId) Nothing) <&> fmap (into @Text . snd) -- | Exported from here just so the debug command and actual implementation can use the same diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 93f8f58e18..d05b8929ce 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -3598,7 +3598,7 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient pp = do -- Complete the text into a branch name within the provided project handleBranchesComplete :: MonadIO m => Text -> Codebase m v a -> PP.ProjectPath -> m [Completion] handleBranchesComplete branchName codebase pp = do - let projId = pp ^. PP.asIds_ . #project + let projId = pp ^. #project . #projectId branches <- Codebase.runTransaction codebase do fmap (filterBranches config pp) do @@ -3615,7 +3615,7 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient pp = do & List.find (\Sqlite.Project {projectId} -> projectId == currentProjectId) & maybeToList - PP.ProjectPath currentProjectId _currentBranchId _currentPath = pp ^. PP.asIds_ + PP.ProjectPath currentProjectId _currentBranchId _currentPath = PP.toIds pp projectToCompletion :: Sqlite.Project -> Completion projectToCompletion project = @@ -3646,7 +3646,7 @@ handleBranchesComplete config branchName codebase pp = do branches <- Codebase.runTransaction codebase do fmap (filterBranches config pp) do - Queries.loadAllProjectBranchesBeginningWith (pp ^. PP.asIds_ . #project) (Just branchName) + Queries.loadAllProjectBranchesBeginningWith (pp ^. #project . #projectId) (Just branchName) pure (map currentProjectBranchToCompletion branches) filterBranches :: ProjectBranchSuggestionsConfig -> PP.ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)] @@ -3655,7 +3655,7 @@ filterBranches config pp branches = AllBranches -> branches ExcludeCurrentBranch -> branches & filter (\(branchId, _) -> branchId /= currentBranchId) where - currentBranchId = pp ^. PP.asIds_ . #branch + currentBranchId = pp ^. #branch . #branchId currentProjectBranchToCompletion :: (ProjectBranchId, ProjectBranchName) -> Completion currentProjectBranchToCompletion (_, branchName) = diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 78873f0d65..07061de029 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -83,7 +83,7 @@ getUserInput codebase authHTTPClient ppCtx currentProjectRoot numberedArgs = Just a -> pure a go :: Line.InputT IO Input go = do - let (PP.ProjectPath projectName projectBranchName path) = ppCtx ^. PP.asNames_ + let (PP.ProjectPath projectName projectBranchName path) = PP.toNames ppCtx let promptString = P.sep ":" diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs index 10acc76c96..9065c5de45 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs @@ -59,5 +59,5 @@ getCurrentProjectBranch codebase = do -- TODO: Come up with a better solution for this error "No current project path context" Just pp -> pp - let (PP.ProjectPath projName branchName path) = pp ^. PP.asNames_ + let (PP.ProjectPath projName branchName path) = PP.toNames pp pure $ Current (Just projName) (Just branchName) path From babd9b0c69404a8712ca6a54ec7fc520f1efa858 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 8 May 2024 12:52:56 -0600 Subject: [PATCH 026/631] Repair the Nix flake MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This does the minimum to get `nix flake check` working.; The primary issue is that flakes require flat package sets, and this flake produced nested ones. This flattens the package sets without renaming anything. E.g., `packages.${system}.docker.ucm` is now `packages.${system}.ucm`, and similar for other derivations. The only other change was to correct the attribute name for the UCM docker image’s command. --- flake.nix | 54 +++++++++++++++++++++++++++----------------------- nix/docker.nix | 2 +- 2 files changed, 30 insertions(+), 26 deletions(-) diff --git a/flake.nix b/flake.nix index a9628dc4ad..46e3ea3d6c 100644 --- a/flake.nix +++ b/flake.nix @@ -94,36 +94,40 @@ assert nixpkgs-packages.unwrapped-stack.version == versions.stack; assert nixpkgs-packages.hpack.version == versions.hpack; { - packages = nixpkgs-packages // { - default = haskell-nix-flake.defaultPackage; - haskell-nix = haskell-nix-flake.packages; - docker = import ./nix/docker.nix { inherit pkgs; haskell-nix = haskell-nix-flake.packages; }; - build-tools = pkgs.symlinkJoin { - name = "build-tools"; - paths = self.devShells."${system}".only-tools-nixpkgs.buildInputs; + packages = + nixpkgs-packages + // haskell-nix-flake.packages + // import ./nix/docker.nix { inherit pkgs; haskell-nix = haskell-nix-flake.packages; } + // { + default = haskell-nix-flake.defaultPackage; + build-tools = pkgs.symlinkJoin { + name = "build-tools"; + paths = self.devShells."${system}".only-tools-nixpkgs.buildInputs; + }; + all = pkgs.symlinkJoin { + name = "all"; + paths = + let + all-other-packages = builtins.attrValues (builtins.removeAttrs self.packages."${system}" [ "all" "build-tools" ]); + devshell-inputs = builtins.concatMap + (devShell: devShell.buildInputs ++ devShell.nativeBuildInputs) + [ + self.devShells."${system}".only-tools-nixpkgs + ]; + in + all-other-packages ++ devshell-inputs; + }; }; - all = pkgs.symlinkJoin { - name = "all"; - paths = - let - all-other-packages = builtins.attrValues (builtins.removeAttrs self.packages."${system}" [ "all" "build-tools" ]); - devshell-inputs = builtins.concatMap - (devShell: devShell.buildInputs ++ devShell.nativeBuildInputs) - [ - self.devShells."${system}".only-tools-nixpkgs - ]; - in - all-other-packages ++ devshell-inputs; - }; - }; apps = haskell-nix-flake.apps // { default = self.apps."${system}"."unison-cli-main:exe:unison"; }; - devShells = nixpkgs-devShells // { - default = self.devShells."${system}".only-tools-nixpkgs; - haskell-nix = haskell-nix-flake.devShells; - }; + devShells = + nixpkgs-devShells + // haskell-nix-flake.devShells + // { + default = self.devShells."${system}".only-tools-nixpkgs; + }; }); } diff --git a/nix/docker.nix b/nix/docker.nix index 4017a792d6..bfd4751e4f 100644 --- a/nix/docker.nix +++ b/nix/docker.nix @@ -5,6 +5,6 @@ name = "ucm"; tag = "latest"; contents = with pkgs; [ cacert fzf ]; - config.Cmd = [ "${haskell-nix."unison-cli:exe:unison"}/bin/unison" ]; + config.Cmd = [ "${haskell-nix."unison-cli-main:exe:unison"}/bin/unison" ]; }; } From 257337e9151bee1de3b4fce11adeac27875081cd Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 14 May 2024 00:11:40 -0600 Subject: [PATCH 027/631] Prefix the flattened flake outputs MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This adds some grouping to the outputs, since they can’t be grouped in attribute sets. It also updates the relevant docs with the new names. Here are the renamings: - `packages.haskell-nix.some:cabal:thing`→ `packages.component-some:cabal:thing` - `packages.docker.ucm` → `packages.docker-ucm` - `apps.haskell-nix.some:cabal:thing` → `apps.component-some:cabal:thing`, and - `devShells.haskell-nix.unison-cli` → `devShells.cabal-unison-cli`. --- development.markdown | 16 ++++++++-------- flake.nix | 14 +++++++++----- 2 files changed, 17 insertions(+), 13 deletions(-) diff --git a/development.markdown b/development.markdown index 22e9657c74..962a507c63 100644 --- a/development.markdown +++ b/development.markdown @@ -126,9 +126,9 @@ This is specified with the normal Some examples: ``` -nix build '.#haskell-nix.unison-cli:lib:unison-cli' -nix build '.#haskell-nix.unison-syntax:test:syntax-tests' -nix build '.#haskell-nix.unison-cli:exe:transcripts' +nix build '.#component-unison-cli:lib:unison-cli' +nix build '.#component-unison-syntax:test:syntax-tests' +nix build '.#component-unison-cli:exe:transcripts' ``` ### Development environments @@ -154,7 +154,7 @@ all non-local haskell dependencies (including profiling dependencies) are provided in the nix shell. ``` -nix develop '.#haskell-nix.local' +nix develop '.#cabal-local' ``` #### Get into a development environment for building a specific package @@ -164,17 +164,17 @@ all haskell dependencies of this package are provided by the nix shell (including profiling dependencies). ``` -nix develop '.#haskell-nix.' +nix develop '.#cabal-' ``` for example: ``` -nix develop '.#haskell-nix.unison-cli' +nix develop '.#cabal-unison-cli' ``` or ``` -nix develop '.#haskell-nix.unison-parser-typechecker' +nix develop '.#cabal-unison-parser-typechecker' ``` This is useful if you wanted to profile a package. For example, if you @@ -183,7 +183,7 @@ shells, cd into its directory, then run the program with profiling. ``` -nix develop '.#unison-parser-typechecker' +nix develop '.#cabal-unison-parser-typechecker' cd unison-cli cabal run --enable-profiling unison-cli-main:exe:unison -- +RTS -p ``` diff --git a/flake.nix b/flake.nix index 46e3ea3d6c..740109dd10 100644 --- a/flake.nix +++ b/flake.nix @@ -88,6 +88,10 @@ ''; }; }; + + renameAttrs = fn: nixpkgs.lib.mapAttrs' (name: value: { + inherit value; + name = fn name;}); in assert nixpkgs-packages.ormolu.version == versions.ormolu; assert nixpkgs-packages.hls.version == versions.hls; @@ -96,8 +100,8 @@ { packages = nixpkgs-packages - // haskell-nix-flake.packages - // import ./nix/docker.nix { inherit pkgs; haskell-nix = haskell-nix-flake.packages; } + // renameAttrs (name: "component-${name}") haskell-nix-flake.packages + // renameAttrs (name: "docker-${name}") (import ./nix/docker.nix { inherit pkgs; haskell-nix = haskell-nix-flake.packages; }) // { default = haskell-nix-flake.defaultPackage; build-tools = pkgs.symlinkJoin { @@ -119,13 +123,13 @@ }; }; - apps = haskell-nix-flake.apps // { - default = self.apps."${system}"."unison-cli-main:exe:unison"; + apps = renameAttrs (name: "component-${name}") haskell-nix-flake.apps // { + default = self.apps."${system}"."component-unison-cli-main:exe:unison"; }; devShells = nixpkgs-devShells - // haskell-nix-flake.devShells + // renameAttrs (name: "cabal-${name}") haskell-nix-flake.devShells // { default = self.devShells."${system}".only-tools-nixpkgs; }; From f515658504830d51e7ef779867aac4f5bbc771c1 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 16 May 2024 21:35:46 -0600 Subject: [PATCH 028/631] Ignore the Nix build result symlink --- .gitignore | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 8a2be67a49..e02fc7f2b2 100644 --- a/.gitignore +++ b/.gitignore @@ -24,5 +24,7 @@ dist-newstyle # Mac developers **/.DS_Store - /libb2.dylib + +# Nix +result From 457ca14a0551832daa8a104e2b97d85c2fa0aed5 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 24 May 2024 15:17:26 -0700 Subject: [PATCH 029/631] Allow updating branch heads --- .../U/Codebase/Sqlite/Queries.hs | 11 +++++++++ .../src/Unison/Codebase/Type.hs | 7 ------ unison-cli/src/Unison/Cli/MonadUtils.hs | 23 ++++++++++--------- .../Codebase/Editor/HandleInput/Merge2.hs | 12 +++++----- 4 files changed, 29 insertions(+), 24 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 208875cb10..e6e62d2d16 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -135,6 +135,7 @@ module U.Codebase.Sqlite.Queries insertProjectBranch, renameProjectBranch, deleteProjectBranch, + setProjectBranchHead, setMostRecentBranch, loadMostRecentBranch, @@ -3770,6 +3771,16 @@ deleteProjectBranch projectId branchId = do WHERE project_id = :projectId AND branch_id = :branchId |] +-- | Set project branch HEAD +setProjectBranchHead :: ProjectId -> ProjectBranchId -> CausalHashId -> Transaction () +setProjectBranchHead projectId branchId causalHashId = + execute + [sql| + UPDATE project_branch + SET causal_hash_id = :causalHashId + WHERE project_id = :projectId AND branch_id = :branchId + |] + data LoadRemoteBranchFlag = IncludeSelfRemote | ExcludeSelfRemote diff --git a/parser-typechecker/src/Unison/Codebase/Type.hs b/parser-typechecker/src/Unison/Codebase/Type.hs index d9da1aa2aa..b5241d0ce6 100644 --- a/parser-typechecker/src/Unison/Codebase/Type.hs +++ b/parser-typechecker/src/Unison/Codebase/Type.hs @@ -63,13 +63,6 @@ data Codebase m v a = Codebase putTypeDeclarationComponent :: Hash -> [Decl v a] -> Sqlite.Transaction (), -- getTermComponent :: Hash -> m (Maybe [Term v a]), getTermComponentWithTypes :: Hash -> Sqlite.Transaction (Maybe [(Term v a, Type v a)]), - -- | Get the root branch. - getRootBranch :: m (Branch m), - -- | Like 'putBranch', but also adjusts the root branch pointer afterwards. - putRootBranch :: - Text -> -- Reason for the change, will be recorded in the reflog - Branch m -> - m (), getBranchForHash :: CausalHash -> m (Maybe (Branch m)), -- | Put a branch into the codebase, which includes its children, its patches, and the branch itself, if they don't -- already exist. diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index c9d3e355ce..78ec10730c 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -50,7 +50,7 @@ module Unison.Cli.MonadUtils stepManyAtMNoSync, stepManyAtNoSync, syncRoot, - updateCurrentProjectRoot, + updateProjectBranchRoot, updateAtM, updateAt, updateAndStepAt, @@ -110,6 +110,7 @@ import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path (Path, Path' (..)) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath, ProjectPathG (..)) import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH @@ -457,12 +458,12 @@ syncRoot description = do -- an update occurred and false otherwise updateAtM :: Text -> - Path.Absolute -> + ProjectPath -> (Branch IO -> Cli (Branch IO)) -> Cli Bool -updateAtM reason (Path.Absolute p) f = do - b <- getProjectRoot - b' <- Branch.modifyAtM p f b +updateAtM reason pp f = do + b <- getBranchFromProjectPath (pp & PP.absPath_ .~ Path.absoluteEmpty) + b' <- Branch.modifyAtM (pp ^. PP.path_) f b updateCurrentProjectRoot b' reason pure $ b /= b' @@ -470,7 +471,7 @@ updateAtM reason (Path.Absolute p) f = do -- an update occurred and false otherwise updateAt :: Text -> - Path.Absolute -> + ProjectPath -> (Branch IO -> Branch IO) -> Cli Bool updateAt reason p f = do @@ -487,13 +488,13 @@ updateAndStepAt reason updates steps = do (Branch.stepManyAt steps) . (\root -> foldl' (\b (Path.Absolute p, f) -> Branch.modifyAt p f b) root updates) <$> getProjectRoot - updateCurrentProjectRoot root reason + ProjectPath _ projBranch _ <- getCurrentProjectPath + updateProjectBranchRoot projBranch root reason -updateCurrentProjectRoot :: Branch IO -> Text -> Cli () -updateCurrentProjectRoot new reason = +updateProjectBranchRoot :: ProjectBranch -> Branch IO -> Text -> Cli () +updateProjectBranchRoot projectBranch new reason = Cli.time "updateCurrentProjectRoot" do - Cli.Env {codebase} <- ask - liftIO (Codebase.putRootBranch codebase reason new) + runTransaction $ Q.setProjectBranchHead (projectBranch ^. #branchId) (Branch.headHash new) setCurrentProjectRoot new ------------------------------------------------------------------------------------------------------------------------ diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index d6685f1059..7a3a69b89e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -43,7 +43,7 @@ import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Builtin.Decls qualified as Builtin.Decls -import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceOrTarget (..), MergeSourceAndTarget (..)) +import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceAndTarget (..), MergeSourceOrTarget (..)) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli @@ -64,6 +64,7 @@ import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace (..), ReadShareLooseCode (..)) import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPathG (..)) import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache) import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions import Unison.Codebase.SqliteCodebase.Operations qualified as Operations @@ -136,11 +137,12 @@ import Unison.Util.SyntaxText (SyntaxText') import Unison.Var (Var) import Witch (unsafeFrom) import Prelude hiding (unzip, zip, zipWith) +import qualified U.Codebase.Sqlite.Queries as Q handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do -- Assert that Alice (us) is on a project branch, and grab the causal hash. - (ProjectAndBranch aliceProject aliceProjectBranch, _path) <- Cli.expectCurrentProjectBranch + ProjectPath aliceProject aliceProjectBranch _path <- Cli.getCurrentProjectPath aliceCausalHash <- Cli.runTransaction (projectBranchToCausalHash aliceProjectBranch) -- Resolve Bob's maybe-project-name + branch-name to the info the merge algorithm needs: the project name, branch @@ -182,9 +184,7 @@ handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do where projectBranchToCausalHash :: ProjectBranch -> Transaction CausalHash projectBranchToCausalHash branch = do - let path = Cli.projectBranchPath (ProjectAndBranch branch.projectId branch.branchId) - causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute path) - pure causal.causalHash + Q.expectCausalHash (branch ^. causalHashId) data MergeInfo = MergeInfo { alice :: !AliceMergeInfo, @@ -220,7 +220,7 @@ doMerge info = do let aliceBranchNames = ProjectAndBranch info.alice.project.name info.alice.projectBranch.name let mergeSource = MergeSourceOrTarget'Source info.bob.source let mergeTarget = MergeSourceOrTarget'Target aliceBranchNames - let mergeSourceAndTarget = MergeSourceAndTarget { alice = aliceBranchNames, bob = info.bob.source } + let mergeSourceAndTarget = MergeSourceAndTarget {alice = aliceBranchNames, bob = info.bob.source} Cli.Env {codebase} <- ask From 9756ac8c1ea86f430d09eba2cf66eac9c1d6a43c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 28 May 2024 09:24:45 -0700 Subject: [PATCH 030/631] WIP --- .../U/Codebase/Sqlite/Operations.hs | 31 ------------------- parser-typechecker/src/Unison/Codebase.hs | 3 -- .../src/Unison/Codebase/Execute.hs | 13 +++----- .../src/Unison/Codebase/SqliteCodebase.hs | 28 +---------------- .../Codebase/SqliteCodebase/Operations.hs | 11 ------- unison-cli/src/ArgParse.hs | 2 +- 6 files changed, 7 insertions(+), 81 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index b32babbf1c..2bd8e016ab 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -1,10 +1,5 @@ module U.Codebase.Sqlite.Operations ( -- * branches - saveRootBranch, - loadRootCausalHash, - expectRootCausalHash, - expectRootCausal, - expectRootBranchHash, loadCausalHashAtPath, expectCausalHashAtPath, loadCausalBranchAtPath, @@ -235,19 +230,6 @@ expectValueHashByCausalHashId = loadValueHashById <=< Q.expectCausalValueHashId loadValueHashById :: Db.BranchHashId -> Transaction BranchHash loadValueHashById = fmap BranchHash . Q.expectHash . Db.unBranchHashId -expectRootCausalHash :: Transaction CausalHash -expectRootCausalHash = Q.expectCausalHash =<< Q.expectNamespaceRoot - -expectRootBranchHash :: Transaction BranchHash -expectRootBranchHash = do - rootCausalHashId <- Q.expectNamespaceRoot - expectValueHashByCausalHashId rootCausalHashId - -loadRootCausalHash :: Transaction (Maybe CausalHash) -loadRootCausalHash = - runMaybeT $ - lift . Q.expectCausalHash =<< MaybeT Q.loadNamespaceRoot - -- | Load the causal hash at the given path from the provided root, if Nothing, use the -- codebase root. loadCausalHashAtPath :: Maybe CausalHash -> Q.TextPathSegments -> Transaction (Maybe CausalHash) @@ -616,16 +598,6 @@ s2cBranch (S.Branch.Full.Branch tms tps patches children) = boId <- Q.expectBranchObjectIdByCausalHashId chId expectBranch boId -saveRootBranch :: - HashHandle -> - C.Branch.CausalBranch Transaction -> - Transaction (Db.BranchObjectId, Db.CausalHashId) -saveRootBranch hh c = do - when debug $ traceM $ "Operations.saveRootBranch " ++ show (C.causalHash c) - (boId, chId) <- saveBranch hh c - Q.setNamespaceRoot chId - pure (boId, chId) - -- saveBranch is kind of a "deep save causal" -- we want a "shallow save causal" that could take a @@ -752,9 +724,6 @@ saveCausalObject hh (C.Causal.Causal hc he parents _) = do Q.saveCausal hh chId bhId parentCausalHashIds pure (chId, bhId) -expectRootCausal :: Transaction (C.Branch.CausalBranch Transaction) -expectRootCausal = Q.expectNamespaceRoot >>= expectCausalBranchByCausalHashId - loadCausalBranchByCausalHash :: CausalHash -> Transaction (Maybe (C.Branch.CausalBranch Transaction)) loadCausalBranchByCausalHash hc = do Q.loadCausalHashIdByCausalHash hc >>= \case diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 80d9fc41dd..e422d85d20 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -58,10 +58,7 @@ module Unison.Codebase getShallowProjectRootByNames, -- * Root branch - getRootBranch, - SqliteCodebase.Operations.getRootBranchExists, Operations.expectRootCausalHash, - putRootBranch, SqliteCodebase.Operations.namesAtPath, -- * Patches diff --git a/parser-typechecker/src/Unison/Codebase/Execute.hs b/parser-typechecker/src/Unison/Codebase/Execute.hs index 4d8a5317a9..21a34f8ffc 100644 --- a/parser-typechecker/src/Unison/Codebase/Execute.hs +++ b/parser-typechecker/src/Unison/Codebase/Execute.hs @@ -8,13 +8,11 @@ module Unison.Codebase.Execute where import Control.Exception (finally) import Control.Monad.Except import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch qualified as Branch -import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.MainTerm (getMainTerm) import Unison.Codebase.MainTerm qualified as MainTerm import Unison.Codebase.Runtime (Runtime) import Unison.Codebase.Runtime qualified as Runtime -import Unison.Names qualified as Names +import Unison.Names (Names) import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE @@ -24,15 +22,14 @@ import Unison.Util.Pretty qualified as P execute :: Codebase.Codebase IO Symbol Ann -> Runtime Symbol -> + Names -> Text -> IO (Either Runtime.Error ()) -execute codebase runtime mainName = +execute codebase runtime names mainName = (`finally` Runtime.terminate runtime) . runExceptT $ do - root <- liftIO $ Codebase.getRootBranch codebase - let parseNames = Names.makeAbsolute (Branch.toNames (Branch.head root)) - loadTypeOfTerm = Codebase.getTypeOfTerm codebase + let loadTypeOfTerm = Codebase.getTypeOfTerm codebase let mainType = Runtime.mainType runtime - mt <- liftIO $ Codebase.runTransaction codebase $ getMainTerm loadTypeOfTerm parseNames mainName mainType + mt <- liftIO $ Codebase.runTransaction codebase $ getMainTerm loadTypeOfTerm names mainName mainType case mt of MainTerm.NotAFunctionName s -> throwError ("Not a function name: " <> P.text s) MainTerm.NotFound s -> throwError ("Not found: " <> P.text s) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs index 18f21330e2..1d37f8e581 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs @@ -245,37 +245,13 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action rootBranchCache (runTransaction (CodebaseOps.uncachedLoadRootBranch branchCache getDeclType)) - putRootBranch :: Text -> Branch m -> m () - putRootBranch reason branch1 = do - now <- liftIO getCurrentTime - withRunInIO \runInIO -> do - -- this is naughty, the type says Transaction but it - -- won't run automatically with whatever Transaction - -- it is composed into unless the enclosing - -- Transaction is applied to the same db connection. - let branch1Trans = Branch.transform (Sqlite.unsafeIO . runInIO) branch1 - putRootBranchTrans :: Sqlite.Transaction () = do - let emptyCausalHash = Branch.headHash Branch.empty - fromRootCausalHash <- fromMaybe emptyCausalHash <$> Ops.loadRootCausalHash - let toRootCausalHash = Branch.headHash branch1 - CodebaseOps.putRootBranch branch1Trans - Ops.appendReflog (Reflog.Entry {time = now, fromRootCausalHash, toRootCausalHash, reason}) - - -- We need to update the database and the cached - -- value. We want to keep these in sync, so we take - -- the cache lock while updating sqlite. - withLock - rootBranchCache - (\restore _ -> restore $ runInIO $ runTransaction putRootBranchTrans) - (\_ -> Just branch1Trans) - -- if this blows up on cromulent hashes, then switch from `hashToHashId` -- to one that returns Maybe. getBranchForHash :: CausalHash -> m (Maybe (Branch m)) getBranchForHash h = fmap (Branch.transform runTransaction) <$> runTransaction (CodebaseOps.getBranchForHash branchCache getDeclType h) - putBranch :: Branch m -> m () + putBranch :: Branch m -> m CausalHash putBranch branch = withRunInIO \runInIO -> runInIO (runTransaction (CodebaseOps.putBranch (Branch.transform (Sqlite.unsafeIO . runInIO) branch))) @@ -334,8 +310,6 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action putTypeDeclaration, putTypeDeclarationComponent, getTermComponentWithTypes, - getRootBranch, - putRootBranch, getBranchForHash, putBranch, syncFromDirectory, diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index 48a183864d..c3fc112510 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -387,17 +387,6 @@ uncachedLoadRootBranch branchCache getDeclType = do causal2 <- Ops.expectRootCausal Cv.causalbranch2to1 branchCache getDeclType causal2 --- | Get whether the root branch exists. -getRootBranchExists :: Transaction Bool -getRootBranchExists = - isJust <$> Ops.loadRootCausalHash - -putRootBranch :: Branch Transaction -> Transaction () -putRootBranch branch1 = do - -- todo: check to see if root namespace hash has been externally modified - -- and do something (merge?) it if necessary. But for now, we just overwrite it. - void (Ops.saveRootBranch v2HashHandle (Cv.causalbranch1to2 branch1)) - -- if this blows up on cromulent hashes, then switch from `hashToHashId` -- to one that returns Maybe. getBranchForHash :: diff --git a/unison-cli/src/ArgParse.hs b/unison-cli/src/ArgParse.hs index 84f2ae538c..1a3c4bb9db 100644 --- a/unison-cli/src/ArgParse.hs +++ b/unison-cli/src/ArgParse.hs @@ -66,7 +66,7 @@ type SymbolName = Text -- | Valid ways to provide source code to the run command data RunSource = RunFromPipe SymbolName - | RunFromSymbol SymbolName + | RunFromSymbol ProjectPath | RunFromFile FilePath SymbolName | RunCompiled FilePath deriving (Show, Eq) From 647072d2c7250952932b28aa5a421327267093dd Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 28 May 2024 14:34:05 -0600 Subject: [PATCH 031/631] Allow structured args in more find commands --- .../src/Unison/CommandLine/InputPatterns.hs | 21 ++++--------------- 1 file changed, 4 insertions(+), 17 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index b674b8c4a0..8a01919f4b 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1244,17 +1244,8 @@ findIn' cmd mkfscope = I.Visible [("namespace", Required, namespaceArg), ("query", ZeroPlus, exactDefinitionArg)] findHelp - $ \case - p : args -> - Input.FindI False . mkfscope - <$> first P.text (handlePathArg p) - -- __FIXME__: This changes things a bit. Previously, `find` and - -- friends would just expand the numbered args and search - -- for them like any other string, but now it recognizes - -- that you’re trying to look up something you already - -- have, and refuses to. Is that the right thing to do? We - -- _could_ still serialize in this case. - <*> traverse (unsupportedStructuredArgument "text") args + \case + p : args -> Input.FindI False . mkfscope <$> handlePathArg p <*> pure (unifyArgument <$> args) _ -> Left findHelp findHelp :: P.Pretty CT.ColorText @@ -1332,9 +1323,7 @@ findVerbose = ( "`find.verbose` searches for definitions like `find`, but includes hashes " <> "and aliases in the results." ) - ( fmap (Input.FindI True $ Input.FindLocal Path.empty) - . traverse (unsupportedStructuredArgument "text") - ) + (pure . Input.FindI True (Input.FindLocal Path.empty) . fmap unifyArgument) findVerboseAll :: InputPattern findVerboseAll = @@ -1346,9 +1335,7 @@ findVerboseAll = ( "`find.all.verbose` searches for definitions like `find.all`, but includes hashes " <> "and aliases in the results." ) - ( fmap (Input.FindI True $ Input.FindLocalAndDeps Path.empty) - . traverse (unsupportedStructuredArgument "text") - ) + (pure . Input.FindI True (Input.FindLocalAndDeps Path.empty) . fmap unifyArgument) renameTerm :: InputPattern renameTerm = From c6f1f2c2a8625c4d34d6a43e85bf691c574bedaa Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 28 May 2024 14:37:26 -0600 Subject: [PATCH 032/631] =?UTF-8?q?Don=E2=80=99t=20allow=20`ProjectBranch`?= =?UTF-8?q?=20as=20project=20arg?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 8a01919f4b..8fa5afb769 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -369,8 +369,6 @@ handleProjectArg = ) ( \case SA.Project project -> pure project - -- __FIXME__: Do we want to treat a project branch as a project? - SA.ProjectBranch (ProjectAndBranch (Just project) _) -> pure project otherArgType -> Left $ wrongStructuredArgument "a path" otherArgType ) From a9c29d01c5f05203f5e0e55e1b253a4e5890bb7e Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 28 May 2024 14:35:31 -0600 Subject: [PATCH 033/631] Have handlers fail with `Pretty`, not `Text` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This also generally improves formatting: - follows the longer line convention in Unison and - removes unnecessary `( … )` and `$` before `LambdaCase` args. --- .../src/Unison/CommandLine/InputPatterns.hs | 925 +++++++----------- 1 file changed, 336 insertions(+), 589 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 8fa5afb769..7f7524dd2b 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -233,24 +233,15 @@ formatStructuredArgument = \case SA.HashQualified hqName -> HQ.toText hqName SA.Project projectName -> into @Text projectName SA.ProjectBranch (ProjectAndBranch mproj branch) -> - maybe - (Text.cons '/' . into @Text) - (\project -> into @Text . ProjectAndBranch project) - mproj - branch - SA.Ref reference -> - -- also: ShortHash.toText . Reference.toShortHash - Reference.toText reference - SA.Namespace causalHash -> - -- also: ("#" <>) . Hash.toBase32HexText . unCausalHash - ("#" <>) . SCH.toText $ SCH.fromHash schLength causalHash - SA.NameWithBranchPrefix absBranchId name -> - prefixBranchId absBranchId name - SA.HashQualifiedWithBranchPrefix absBranchId hq'Name -> - HQ'.toTextWith (prefixBranchId absBranchId) hq'Name + maybe (Text.cons '/' . into @Text) (\project -> into @Text . ProjectAndBranch project) mproj branch + -- also: ShortHash.toText . Reference.toShortHash + SA.Ref reference -> Reference.toText reference + -- also: ("#" <>) . Hash.toBase32HexText . unCausalHash + SA.Namespace causalHash -> ("#" <>) . SCH.toText $ SCH.fromHash schLength causalHash + SA.NameWithBranchPrefix absBranchId name -> prefixBranchId absBranchId name + SA.HashQualifiedWithBranchPrefix absBranchId hq'Name -> HQ'.toTextWith (prefixBranchId absBranchId) hq'Name SA.ShallowListEntry path entry -> entryToHQText path entry - SA.SearchResult searchRoot searchResult -> - HQ.toText $ searchResultToHQ searchRoot searchResult + SA.SearchResult searchRoot searchResult -> HQ.toText $ searchResultToHQ searchRoot searchResult where -- E.g. -- prefixBranchId "#abcdef" "base.List.map" -> "#abcdef:.base.List.map" @@ -261,8 +252,8 @@ formatStructuredArgument = \case Right pathPrefix -> Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name) entryToHQText :: Path' -> ShallowListEntry v Ann -> Text - entryToHQText pathArg e = - fixup $ case e of + entryToHQText pathArg = + fixup . \case ShallowTypeEntry te -> Backend.typeEntryDisplayName te ShallowTermEntry te -> Backend.termEntryDisplayName te ShallowBranchEntry ns _ _ -> NameSegment.toEscapedText ns @@ -303,26 +294,17 @@ searchResultToHQ oprefix = \case addPrefix :: Name -> Name addPrefix = maybe id Path.prefixName2 oprefix -unsupportedStructuredArgument :: - Text -> I.Argument -> Either (P.Pretty CT.ColorText) String +unsupportedStructuredArgument :: Text -> I.Argument -> Either (P.Pretty CT.ColorText) String unsupportedStructuredArgument expected = - either - pure - (const . Left . P.text $ "can’t use a numbered argument for " <> expected) + either pure (const . Left . P.text $ "can’t use a numbered argument for " <> expected) expectedButActually :: Text -> Text -> Text -> Text expectedButActually expected actualValue actualType = - "Expected " - <> expected - <> ", but the numbered arg resulted in " - <> actualValue - <> ", which is " - <> actualType - <> "." - -wrongStructuredArgument :: Text -> StructuredArgument -> Text + "Expected " <> expected <> ", but the numbered arg resulted in " <> actualValue <> ", which is " <> actualType <> "." + +wrongStructuredArgument :: Text -> StructuredArgument -> P.Pretty CT.ColorText wrongStructuredArgument expected actual = - expectedButActually + P.text $ expectedButActually expected (formatStructuredArgument actual) case actual of @@ -358,194 +340,151 @@ makeExampleEOS p args = helpFor :: InputPattern -> P.Pretty CT.ColorText helpFor = I.help -handleProjectArg :: I.Argument -> Either Text ProjectName +handleProjectArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectName handleProjectArg = either ( \name -> - first - (const $ "“" <> Text.pack name <> "” is an invalid project name") - . tryInto @ProjectName - $ Text.pack name - ) - ( \case - SA.Project project -> pure project - otherArgType -> Left $ wrongStructuredArgument "a path" otherArgType + first (const . P.text $ "“" <> Text.pack name <> "” is an invalid project name") . tryInto @ProjectName $ + Text.pack name ) + \case + SA.Project project -> pure project + otherArgType -> Left $ wrongStructuredArgument "a project" otherArgType -handleLooseCodeOrProjectArg :: - I.Argument -> Either Text Input.LooseCodeOrProject +handleLooseCodeOrProjectArg :: I.Argument -> Either (P.Pretty CT.ColorText) Input.LooseCodeOrProject handleLooseCodeOrProjectArg = either - ( maybe (Left "invalid path or project branch") pure - . parseLooseCodeOrProject - ) - ( \case - SA.AbsolutePath path -> pure . This $ Path.absoluteToPath' path - SA.ProjectBranch pb -> pure $ That pb - otherArgType -> - Left $ wrongStructuredArgument "a path or project branch" otherArgType - ) + (maybe (Left $ P.text "invalid path or project branch") pure . parseLooseCodeOrProject) + \case + SA.AbsolutePath path -> pure . This $ Path.absoluteToPath' path + SA.ProjectBranch pb -> pure $ That pb + otherArgType -> Left $ wrongStructuredArgument "a path or project branch" otherArgType handleMaybeProjectBranchArg :: - I.Argument -> - Either (P.Pretty CT.ColorText) (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) + I.Argument -> Either (P.Pretty CT.ColorText) (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) handleMaybeProjectBranchArg = either (megaparse branchWithOptionalProjectParser . Text.pack) - ( \case - SA.ProjectBranch pb -> pure pb - otherArgType -> Left . P.text $ wrongStructuredArgument "a branch" otherArgType - ) + \case + SA.ProjectBranch pb -> pure pb + otherArgType -> Left $ wrongStructuredArgument "a branch" otherArgType handleProjectMaybeBranchArg :: - I.Argument -> - Either Text (ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) + I.Argument -> Either (P.Pretty CT.ColorText) (ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) handleProjectMaybeBranchArg = either - (first (const "The argument wasn’t a project") . tryInto . Text.pack) - ( \case - SA.Project proj -> pure $ ProjectAndBranch proj Nothing - SA.ProjectBranch (ProjectAndBranch (Just proj) branch) -> - pure . ProjectAndBranch proj . pure $ ProjectBranchNameOrLatestRelease'Name branch - otherArgType -> Left $ wrongStructuredArgument "a project" otherArgType - ) + (first (const $ P.text "The argument wasn’t a project") . tryInto . Text.pack) + \case + SA.Project proj -> pure $ ProjectAndBranch proj Nothing + SA.ProjectBranch (ProjectAndBranch (Just proj) branch) -> + pure . ProjectAndBranch proj . pure $ ProjectBranchNameOrLatestRelease'Name branch + otherArgType -> Left $ wrongStructuredArgument "a project" otherArgType -handleHashQualifiedNameArg :: - I.Argument -> Either (P.Pretty CT.ColorText) (HQ.HashQualified Name) +handleHashQualifiedNameArg :: I.Argument -> Either (P.Pretty CT.ColorText) (HQ.HashQualified Name) handleHashQualifiedNameArg = either parseHashQualifiedName - ( \case - SA.Name name -> pure $ HQ.NameOnly name - SA.NameWithBranchPrefix (Left _) name -> pure $ HQ.NameOnly name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . HQ.NameOnly . Name.makeAbsolute $ Path.prefixName prefix name - SA.Ref ref -> pure . HQ.HashOnly $ Reference.toShortHash ref - SA.HashQualified hqname -> pure hqname - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toHQ hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> - pure . HQ'.toHQ $ Name.makeAbsolute . Path.prefixName prefix <$> hqname - SA.SearchResult mpath result -> pure $ searchResultToHQ mpath result - otherArgType -> - Left . P.text $ wrongStructuredArgument "a hash-qualified name" otherArgType - ) - -handlePathArg :: I.Argument -> Either Text Path.Path + \case + SA.Name name -> pure $ HQ.NameOnly name + SA.NameWithBranchPrefix mprefix name -> + pure . HQ.NameOnly $ foldr (\prefix -> Name.makeAbsolute . Path.prefixName prefix) name mprefix + SA.Ref ref -> pure . HQ.HashOnly $ Reference.toShortHash ref + SA.HashQualified hqname -> pure hqname + SA.HashQualifiedWithBranchPrefix mprefix hqname -> + pure . HQ'.toHQ $ foldr (\prefix -> fmap $ Name.makeAbsolute . Path.prefixName prefix) hqname mprefix + SA.SearchResult mpath result -> pure $ searchResultToHQ mpath result + otherArgType -> Left $ wrongStructuredArgument "a hash-qualified name" otherArgType + +handlePathArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path handlePathArg = either - Path.parsePath + (first P.text . Path.parsePath) \case SA.Name name -> pure $ Path.fromName name - SA.NameWithBranchPrefix (Left _) name -> pure $ Path.fromName name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . Path.fromName $ Path.prefixName prefix name - otherArgType -> - Left $ wrongStructuredArgument "a relative path" otherArgType + SA.NameWithBranchPrefix mprefix name -> pure . Path.fromName $ foldr Path.prefixName name mprefix + otherArgType -> Left $ wrongStructuredArgument "a relative path" otherArgType -handlePath'Arg :: I.Argument -> Either Text Path.Path' +handlePath'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path' handlePath'Arg = either - Path.parsePath' - ( \case - SA.AbsolutePath path -> pure $ Path.absoluteToPath' path - SA.Name name -> pure $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> pure $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name - otherArgType -> Left $ wrongStructuredArgument "a namespace" otherArgType - ) + (first P.text . Path.parsePath') + \case + SA.AbsolutePath path -> pure $ Path.absoluteToPath' path + SA.Name name -> pure $ Path.fromName' name + SA.NameWithBranchPrefix mprefix name -> + pure . Path.fromName' $ foldr (\prefix -> Name.makeAbsolute . Path.prefixName prefix) name mprefix + otherArgType -> Left $ wrongStructuredArgument "a namespace" otherArgType -handleNewName :: I.Argument -> Either Text Path.Split' +handleNewName :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split' handleNewName = either - Path.parseSplit' + (first P.text . Path.parseSplit') (const . Left $ "can’t use a numbered argument for a new name") -handleNewPath :: I.Argument -> Either Text Path.Path' +handleNewPath :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path' handleNewPath = either - Path.parsePath' + (first P.text . Path.parsePath') (const . Left $ "can’t use a numbered argument for a new namespace") -- | When only a relative name is allowed. -handleSplitArg :: I.Argument -> Either Text Path.Split +handleSplitArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split handleSplitArg = either - Path.parseSplit - ( \case - SA.Name name | Name.isRelative name -> pure $ Path.splitFromName name - SA.NameWithBranchPrefix (Left _) name - | Name.isRelative name -> - pure $ Path.splitFromName name - SA.NameWithBranchPrefix (Right prefix) name - | Name.isRelative name -> - pure . Path.splitFromName . Name.makeAbsolute $ - Path.prefixName prefix name - otherNumArg -> - Left $ wrongStructuredArgument "a relative name" otherNumArg - ) + (first P.text . Path.parseSplit) + \case + SA.Name name | Name.isRelative name -> pure $ Path.splitFromName name + SA.NameWithBranchPrefix (Left _) name | Name.isRelative name -> pure $ Path.splitFromName name + SA.NameWithBranchPrefix (Right prefix) name + | Name.isRelative name -> pure . Path.splitFromName . Name.makeAbsolute $ Path.prefixName prefix name + otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg -handleSplit'Arg :: I.Argument -> Either Text Path.Split' +handleSplit'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split' handleSplit'Arg = either - Path.parseSplit' - ( \case - SA.Name name -> pure $ Path.splitFromName' name - SA.NameWithBranchPrefix (Left _) name -> pure $ Path.splitFromName' name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . Path.splitFromName' . Name.makeAbsolute $ Path.prefixName prefix name - otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg - ) + (first P.text . Path.parseSplit') + \case + SA.Name name -> pure $ Path.splitFromName' name + SA.NameWithBranchPrefix (Left _) name -> pure $ Path.splitFromName' name + SA.NameWithBranchPrefix (Right prefix) name -> + pure . Path.splitFromName' . Name.makeAbsolute $ Path.prefixName prefix name + otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg -handleProjectBranchNameArg :: I.Argument -> Either Text ProjectBranchName +handleProjectBranchNameArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectBranchName handleProjectBranchNameArg = either - (first (const "Wanted a branch name, but it wasn’t") . tryInto . Text.pack) - ( \case - SA.ProjectBranch (ProjectAndBranch _ branch) -> pure branch - otherNumArg -> Left $ wrongStructuredArgument "a branch name" otherNumArg - ) + (first (const $ P.text "Wanted a branch name, but it wasn’t") . tryInto . Text.pack) + \case + SA.ProjectBranch (ProjectAndBranch _ branch) -> pure branch + otherNumArg -> Left $ wrongStructuredArgument "a branch name" otherNumArg -handleBranchIdArg :: I.Argument -> Either Text Input.BranchId +handleBranchIdArg :: I.Argument -> Either (P.Pretty CT.ColorText) Input.BranchId handleBranchIdArg = either - Input.parseBranchId - ( \case - SA.AbsolutePath path -> pure . pure $ Path.absoluteToPath' path - SA.Name name -> pure . pure $ Path.fromName' name - SA.NameWithBranchPrefix mprefix name -> - pure . pure . Path.fromName' $ - either (const name) (Name.makeAbsolute . flip Path.prefixName name) mprefix - SA.Namespace hash -> pure . Left $ SCH.fromHash schLength hash - otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg - ) + (first P.text . Input.parseBranchId) + \case + SA.AbsolutePath path -> pure . pure $ Path.absoluteToPath' path + SA.Name name -> pure . pure $ Path.fromName' name + SA.NameWithBranchPrefix mprefix name -> + pure . pure . Path.fromName' $ either (const name) (Name.makeAbsolute . flip Path.prefixName name) mprefix + SA.Namespace hash -> pure . Left $ SCH.fromHash schLength hash + otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg handleBranchIdOrProjectArg :: I.Argument -> - Either - Text - ( These - Input.BranchId - (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - ) + Either (P.Pretty CT.ColorText) (These Input.BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)) handleBranchIdOrProjectArg = either - ( maybe (Left "Expected a branch or project, but it’s not") pure - . branchIdOrProject - ) - ( \case - SA.Namespace hash -> pure . This . Left $ SCH.fromHash schLength hash - SA.AbsolutePath path -> - pure . This . pure $ Path.absoluteToPath' path - SA.Name name -> pure . This . pure $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> - pure . This . pure $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . This . pure . Path.fromName' . Name.makeAbsolute $ - Path.prefixName prefix name - SA.ProjectBranch pb -> pure $ pure pb - otherArgType -> Left $ wrongStructuredArgument "a branch" otherArgType - ) + (maybe (Left $ P.text "Expected a branch or project, but it’s not") pure . branchIdOrProject) + \case + SA.Namespace hash -> pure . This . Left $ SCH.fromHash schLength hash + SA.AbsolutePath path -> pure . This . pure $ Path.absoluteToPath' path + SA.Name name -> pure . This . pure $ Path.fromName' name + SA.NameWithBranchPrefix (Left _) name -> pure . This . pure $ Path.fromName' name + SA.NameWithBranchPrefix (Right prefix) name -> + pure . This . pure . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + SA.ProjectBranch pb -> pure $ pure pb + otherArgType -> Left $ wrongStructuredArgument "a branch" otherArgType where branchIdOrProject :: String -> @@ -565,57 +504,44 @@ handleBranchIdOrProjectArg = (Right bid, Left _) -> Just (This bid) (Right bid, Right pr) -> Just (These bid pr) -handleBranchId2Arg :: - I.Argument -> Either (P.Pretty P.ColorText) (Either ShortCausalHash BranchRelativePath) +handleBranchId2Arg :: I.Argument -> Either (P.Pretty P.ColorText) (Either ShortCausalHash BranchRelativePath) handleBranchId2Arg = either Input.parseBranchId2 - ( \case - SA.Namespace hash -> pure . Left $ SCH.fromHash schLength hash - SA.AbsolutePath path -> - pure . pure . LoosePath $ Path.absoluteToPath' path - SA.Name name -> pure . pure . LoosePath $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> - pure . pure . LoosePath $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . pure . LoosePath . Path.fromName' . Name.makeAbsolute $ - Path.prefixName prefix name - SA.ProjectBranch (ProjectAndBranch mproject branch) -> - pure . pure . BranchRelative . This $ - maybe (Left branch) (pure . (,branch)) mproject - otherNumArg -> - Left . P.text $ wrongStructuredArgument "a branch id" otherNumArg - ) + \case + SA.Namespace hash -> pure . Left $ SCH.fromHash schLength hash + SA.AbsolutePath path -> pure . pure . LoosePath $ Path.absoluteToPath' path + SA.Name name -> pure . pure . LoosePath $ Path.fromName' name + SA.NameWithBranchPrefix (Left _) name -> pure . pure . LoosePath $ Path.fromName' name + SA.NameWithBranchPrefix (Right prefix) name -> + pure . pure . LoosePath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + SA.ProjectBranch (ProjectAndBranch mproject branch) -> + pure . pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject + otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg -handleBranchRelativePathArg :: - I.Argument -> Either (P.Pretty P.ColorText) BranchRelativePath +handleBranchRelativePathArg :: I.Argument -> Either (P.Pretty P.ColorText) BranchRelativePath handleBranchRelativePathArg = either parseBranchRelativePath - ( \case - SA.AbsolutePath path -> pure . LoosePath $ Path.absoluteToPath' path - SA.Name name -> pure . LoosePath $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> - pure . LoosePath $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . LoosePath . Path.fromName' . Name.makeAbsolute $ - Path.prefixName prefix name - SA.ProjectBranch (ProjectAndBranch mproject branch) -> - pure . BranchRelative . This $ - maybe (Left branch) (pure . (,branch)) mproject - otherNumArg -> - Left . P.text $ wrongStructuredArgument "a branch id" otherNumArg - ) + \case + SA.AbsolutePath path -> pure . LoosePath $ Path.absoluteToPath' path + SA.Name name -> pure . LoosePath $ Path.fromName' name + SA.NameWithBranchPrefix (Left _) name -> pure . LoosePath $ Path.fromName' name + SA.NameWithBranchPrefix (Right prefix) name -> + pure . LoosePath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + SA.ProjectBranch (ProjectAndBranch mproject branch) -> + pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject + otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg -hqNameToSplit' :: HQ.HashQualified Name -> Either Text Path.HQSplit' +hqNameToSplit' :: HQ.HashQualified Name -> Either (P.Pretty CT.ColorText) Path.HQSplit' hqNameToSplit' = \case - HQ.HashOnly _ -> Left "Only have a hash" + HQ.HashOnly _ -> Left $ P.text "Only have a hash" HQ.NameOnly name -> pure . fmap HQ'.NameOnly $ Path.splitFromName' name HQ.HashQualified name hash -> pure . fmap (`HQ'.HashQualified` hash) $ Path.splitFromName' name -hqNameToSplit :: HQ.HashQualified Name -> Either Text Path.HQSplit +hqNameToSplit :: HQ.HashQualified Name -> Either (P.Pretty CT.ColorText) Path.HQSplit hqNameToSplit = \case - HQ.HashOnly _ -> Left "Only have a hash" + HQ.HashOnly _ -> Left $ P.text "Only have a hash" HQ.NameOnly name -> pure . fmap HQ'.NameOnly $ Path.splitFromName name HQ.HashQualified name hash -> pure . fmap (`HQ'.HashQualified` hash) $ Path.splitFromName name @@ -629,85 +555,75 @@ hq'NameToSplit = \case HQ'.NameOnly name -> HQ'.NameOnly <$> Path.splitFromName name HQ'.HashQualified name hash -> flip HQ'.HashQualified hash <$> Path.splitFromName name -handleHashQualifiedSplit'Arg :: I.Argument -> Either Text Path.HQSplit' +handleHashQualifiedSplit'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.HQSplit' handleHashQualifiedSplit'Arg = either - Path.parseHQSplit' - ( \case - SA.HashQualified name -> hqNameToSplit' name - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit' hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> - pure . hq'NameToSplit' $ Name.makeAbsolute . Path.prefixName prefix <$> hqname - SA.SearchResult mpath result -> hqNameToSplit' $ searchResultToHQ mpath result - otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg - ) - -handleHashQualifiedSplitArg :: I.Argument -> Either Text Path.HQSplit + (first P.text . Path.parseHQSplit') + \case + SA.HashQualified name -> hqNameToSplit' name + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit' hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + pure . hq'NameToSplit' $ Name.makeAbsolute . Path.prefixName prefix <$> hqname + SA.SearchResult mpath result -> hqNameToSplit' $ searchResultToHQ mpath result + otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg + +handleHashQualifiedSplitArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.HQSplit handleHashQualifiedSplitArg = either - Path.parseHQSplit - ( \case - SA.HashQualified name -> hqNameToSplit name - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> - pure . hq'NameToSplit $ Name.makeAbsolute . Path.prefixName prefix <$> hqname - SA.SearchResult mpath result -> hqNameToSplit $ searchResultToHQ mpath result - otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg - ) - -handleShortCausalHashArg :: I.Argument -> Either Text ShortCausalHash + (first P.text . Path.parseHQSplit) + \case + SA.HashQualified name -> hqNameToSplit name + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + pure . hq'NameToSplit $ Name.makeAbsolute . Path.prefixName prefix <$> hqname + SA.SearchResult mpath result -> hqNameToSplit $ searchResultToHQ mpath result + otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg + +handleShortCausalHashArg :: I.Argument -> Either (P.Pretty CT.ColorText) ShortCausalHash handleShortCausalHashArg = either - (first Text.pack . Input.parseShortCausalHash) - ( \case - SA.Namespace hash -> pure $ SCH.fromHash schLength hash - otherNumArg -> Left $ wrongStructuredArgument "a causal hash" otherNumArg - ) + (first (P.text . Text.pack) . Input.parseShortCausalHash) + \case + SA.Namespace hash -> pure $ SCH.fromHash schLength hash + otherNumArg -> Left $ wrongStructuredArgument "a causal hash" otherNumArg handleShortHashOrHQSplit'Arg :: - I.Argument -> Either Text (Either ShortHash Path.HQSplit') + I.Argument -> Either (P.Pretty CT.ColorText) (Either ShortHash Path.HQSplit') handleShortHashOrHQSplit'Arg = either - Path.parseShortHashOrHQSplit' - ( \case - SA.Ref ref -> pure $ Left $ Reference.toShortHash ref - SA.HashQualified name -> pure <$> hqNameToSplit' name - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure . pure $ hq'NameToSplit' hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> - pure . pure $ hq'NameToSplit' (Name.makeAbsolute . Path.prefixName prefix <$> hqname) - SA.SearchResult mpath result -> - fmap pure . hqNameToSplit' $ searchResultToHQ mpath result - otherNumArg -> Left $ wrongStructuredArgument "a hash or name" otherNumArg - ) - -handleRelativeNameSegmentArg :: I.Argument -> Either Text NameSegment + (first P.text . Path.parseShortHashOrHQSplit') + \case + SA.Ref ref -> pure $ Left $ Reference.toShortHash ref + SA.HashQualified name -> pure <$> hqNameToSplit' name + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure . pure $ hq'NameToSplit' hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + pure . pure $ hq'NameToSplit' (Name.makeAbsolute . Path.prefixName prefix <$> hqname) + SA.SearchResult mpath result -> fmap pure . hqNameToSplit' $ searchResultToHQ mpath result + otherNumArg -> Left $ wrongStructuredArgument "a hash or name" otherNumArg + +handleRelativeNameSegmentArg :: I.Argument -> Either (P.Pretty CT.ColorText) NameSegment handleRelativeNameSegmentArg arg = do name <- handleNameArg arg let (segment NE.:| tail) = Name.reverseSegments name if Name.isRelative name && null tail then pure segment - else Left "Wanted a single relative name segment, but it wasn’t." + else Left $ P.text "Wanted a single relative name segment, but it wasn’t." -handleNameArg :: I.Argument -> Either Text Name +handleNameArg :: I.Argument -> Either (P.Pretty CT.ColorText) Name handleNameArg = either - (Name.parseTextEither . Text.pack) - ( \case - SA.Name name -> pure name - SA.NameWithBranchPrefix (Left _) name -> pure name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . Name.makeAbsolute $ Path.prefixName prefix name - SA.HashQualified hqname -> - maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> - pure . Name.makeAbsolute . Path.prefixName prefix $ HQ'.toName hqname - SA.SearchResult mpath result -> - maybe (Left "can’t find a name from the numbered arg") pure - . HQ.toName - $ searchResultToHQ mpath result - otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg - ) + (first P.text . Name.parseTextEither . Text.pack) + \case + SA.Name name -> pure name + SA.NameWithBranchPrefix (Left _) name -> pure name + SA.NameWithBranchPrefix (Right prefix) name -> pure . Name.makeAbsolute $ Path.prefixName prefix name + SA.HashQualified hqname -> maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + pure . Name.makeAbsolute . Path.prefixName prefix $ HQ'.toName hqname + SA.SearchResult mpath result -> + maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result + otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg handlePullSourceArg :: I.Argument -> @@ -717,68 +633,45 @@ handlePullSourceArg :: handlePullSourceArg = either (megaparse (readRemoteNamespaceParser ProjectBranchSpecifier'NameOrLatestRelease) . Text.pack) - ( \case - SA.Project project -> - pure . RemoteRepo.ReadShare'ProjectBranch $ This project - SA.ProjectBranch (ProjectAndBranch project branch) -> - pure . RemoteRepo.ReadShare'ProjectBranch . maybe That These project $ - ProjectBranchNameOrLatestRelease'Name branch - otherNumArg -> - Left . P.text $ wrongStructuredArgument "a source to pull from" otherNumArg - ) + \case + SA.Project project -> pure . RemoteRepo.ReadShare'ProjectBranch $ This project + SA.ProjectBranch (ProjectAndBranch project branch) -> + pure . RemoteRepo.ReadShare'ProjectBranch . maybe That These project $ + ProjectBranchNameOrLatestRelease'Name branch + otherNumArg -> Left $ wrongStructuredArgument "a source to pull from" otherNumArg handlePushTargetArg :: - I.Argument -> - Either Text (WriteRemoteNamespace (These ProjectName ProjectBranchName)) + I.Argument -> Either (P.Pretty CT.ColorText) (WriteRemoteNamespace (These ProjectName ProjectBranchName)) handlePushTargetArg = either - ( maybe (Left "Wanted a source to push from, but this ain’t it.") pure - . parsePushTarget - ) - ( fmap RemoteRepo.WriteRemoteProjectBranch - . \case - SA.Project project -> pure $ This project - SA.ProjectBranch (ProjectAndBranch project branch) -> - pure $ maybe That These project branch - otherNumArg -> - Left $ wrongStructuredArgument "a source to push from" otherNumArg - ) + (maybe (Left "Wanted a source to push from, but this ain’t it.") pure . parsePushTarget) + $ fmap RemoteRepo.WriteRemoteProjectBranch . \case + SA.Project project -> pure $ This project + SA.ProjectBranch (ProjectAndBranch project branch) -> pure $ maybe That These project branch + otherNumArg -> Left $ wrongStructuredArgument "a source to push from" otherNumArg -handlePushSourceArg :: I.Argument -> Either Text Input.PushSource +handlePushSourceArg :: I.Argument -> Either (P.Pretty CT.ColorText) Input.PushSource handlePushSourceArg = either - ( maybe (Left "Wanted a source to push from, but this ain’t it.") pure - . parsePushSource - ) - ( \case - SA.AbsolutePath path -> pure . Input.PathySource $ Path.absoluteToPath' path - SA.Name name -> pure . Input.PathySource $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> - pure . Input.PathySource $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . Input.PathySource . Path.fromName' . Name.makeAbsolute $ - Path.prefixName prefix name - SA.Project project -> pure . Input.ProjySource $ This project - SA.ProjectBranch (ProjectAndBranch project branch) -> - pure . Input.ProjySource . maybe That These project $ branch - otherNumArg -> - Left $ wrongStructuredArgument "a source to push from" otherNumArg - ) + (maybe (Left $ P.text "Wanted a source to push from, but this ain’t it.") pure . parsePushSource) + \case + SA.AbsolutePath path -> pure . Input.PathySource $ Path.absoluteToPath' path + SA.Name name -> pure . Input.PathySource $ Path.fromName' name + SA.NameWithBranchPrefix (Left _) name -> pure . Input.PathySource $ Path.fromName' name + SA.NameWithBranchPrefix (Right prefix) name -> + pure . Input.PathySource . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + SA.Project project -> pure . Input.ProjySource $ This project + SA.ProjectBranch (ProjectAndBranch project branch) -> pure . Input.ProjySource $ maybe That These project branch + otherNumArg -> Left $ wrongStructuredArgument "a source to push from" otherNumArg -handleProjectAndBranchNamesArg :: I.Argument -> Either Text ProjectAndBranchNames +handleProjectAndBranchNamesArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectAndBranchNames handleProjectAndBranchNamesArg = either - ( first (const "The argument wasn’t a project or branch") - . tryInto @ProjectAndBranchNames - . Text.pack - ) - ( fmap ProjectAndBranchNames'Unambiguous . \case - SA.Project project -> pure $ This project - SA.ProjectBranch (ProjectAndBranch mproj branch) -> - pure $ maybe That These mproj branch - otherNumArg -> - Left $ wrongStructuredArgument "a project or branch" otherNumArg - ) + (first (const $ P.text "The argument wasn’t a project or branch") . tryInto @ProjectAndBranchNames . Text.pack) + $ fmap ProjectAndBranchNames'Unambiguous . \case + SA.Project project -> pure $ This project + SA.ProjectBranch (ProjectAndBranch mproj branch) -> pure $ maybe That These mproj branch + otherNumArg -> Left $ wrongStructuredArgument "a project or branch" otherNumArg mergeBuiltins :: InputPattern mergeBuiltins = @@ -788,9 +681,9 @@ mergeBuiltins = I.Hidden [("namespace", Optional, namespaceArg)] "Adds the builtins (excluding `io` and misc) to the specified namespace. Defaults to `builtin.`" - $ \case + \case [] -> pure . Input.MergeBuiltinsI $ Nothing - [p] -> bimap P.text (Input.MergeBuiltinsI . Just) $ handlePathArg p + [p] -> Input.MergeBuiltinsI . Just <$> handlePathArg p _ -> Left (I.help mergeBuiltins) mergeIOBuiltins :: InputPattern @@ -803,7 +696,7 @@ mergeIOBuiltins = "Adds all the builtins, including `io` and misc., to the specified namespace. Defaults to `builtin.`" \case [] -> pure . Input.MergeIOBuiltinsI $ Nothing - [p] -> bimap P.text (Input.MergeIOBuiltinsI . Just) $ handlePathArg p + [p] -> Input.MergeIOBuiltinsI . Just <$> handlePathArg p _ -> Left (I.help mergeBuiltins) updateBuiltins :: InputPattern @@ -839,16 +732,15 @@ todo = ) ] ) - ( \case - patchStr : ws -> first (warn . P.text) $ do - patch <- handleSplit'Arg patchStr - branch <- case ws of - [] -> pure Path.relativeEmpty' - [pathStr] -> handlePath'Arg pathStr - _ -> Left "`todo` just takes a patch and one optional namespace" - Right $ Input.TodoI (Just patch) branch - [] -> Right $ Input.TodoI Nothing Path.relativeEmpty' - ) + \case + patchStr : ws -> first warn $ do + patch <- handleSplit'Arg patchStr + branch <- case ws of + [] -> pure Path.relativeEmpty' + [pathStr] -> handlePath'Arg pathStr + _ -> Left "`todo` just takes a patch and one optional namespace" + Right $ Input.TodoI (Just patch) branch + [] -> Right $ Input.TodoI Nothing Path.relativeEmpty' load :: InputPattern load = @@ -866,13 +758,10 @@ load = ) ] ) - ( \case - [] -> pure $ Input.LoadI Nothing - [file] -> - Input.LoadI . Just - <$> unsupportedStructuredArgument "a file name" file - _ -> Left (I.help load) - ) + \case + [] -> pure $ Input.LoadI Nothing + [file] -> Input.LoadI . Just <$> unsupportedStructuredArgument "a file name" file + _ -> Left (I.help load) clear :: InputPattern clear = @@ -887,10 +776,9 @@ clear = ) ] ) - ( \case - [] -> pure Input.ClearI - _ -> Left (I.help clear) - ) + \case + [] -> pure Input.ClearI + _ -> Left (I.help clear) add :: InputPattern add = @@ -902,7 +790,7 @@ add = ( "`add` adds to the codebase all the definitions from the most recently " <> "typechecked file." ) - $ bimap P.text (Input.AddI . Set.fromList) . traverse handleNameArg + $ fmap (Input.AddI . Set.fromList) . traverse handleNameArg previewAdd :: InputPattern previewAdd = @@ -916,7 +804,7 @@ previewAdd = <> "results. Use `load` to reparse & typecheck the file if the context " <> "has changed." ) - $ bimap P.text (Input.PreviewAddI . Set.fromList) . traverse handleNameArg + $ fmap (Input.PreviewAddI . Set.fromList) . traverse handleNameArg update :: InputPattern update = @@ -962,8 +850,7 @@ updateOldNoPatch = ) ] ) - $ bimap P.text (Input.UpdateI Input.NoPatch . Set.fromList) - . traverse handleNameArg + $ fmap (Input.UpdateI Input.NoPatch . Set.fromList) . traverse handleNameArg updateOld :: InputPattern updateOld = @@ -998,10 +885,8 @@ updateOld = ] ) \case - patchStr : ws -> first P.text do - patch <- handleSplit'Arg patchStr - Input.UpdateI (Input.UsePatch patch) . Set.fromList - <$> traverse handleNameArg ws + patchStr : ws -> + Input.UpdateI . Input.UsePatch <$> handleSplit'Arg patchStr <*> fmap Set.fromList (traverse handleNameArg ws) [] -> Right $ Input.UpdateI Input.DefaultPatch mempty previewUpdate :: InputPattern @@ -1016,8 +901,7 @@ previewUpdate = <> "typechecking results. Use `load` to reparse & typecheck the file if " <> "the context has changed." ) - $ bimap P.text (Input.PreviewUpdateI . Set.fromList) - . traverse handleNameArg + $ fmap (Input.PreviewUpdateI . Set.fromList) . traverse handleNameArg view :: InputPattern view = @@ -1077,11 +961,7 @@ display = "`display` without arguments invokes a search to select a definition to display, which requires that `fzf` can be found within your PATH." ] ) - $ maybe - (Left $ I.help display) - ( fmap (Input.DisplayI Input.ConsoleLocation) - . traverse handleHashQualifiedNameArg - ) + $ maybe (Left $ I.help display) (fmap (Input.DisplayI Input.ConsoleLocation) . traverse handleHashQualifiedNameArg) . NE.nonEmpty displayTo :: InputPattern @@ -1119,10 +999,7 @@ docs = "`docs` without arguments invokes a search to select which definition to view documentation for, which requires that `fzf` can be found within your PATH." ] ) - $ maybe - (Left $ I.help docs) - (bimap P.text Input.DocsI . traverse handleHashQualifiedSplit'Arg) - . NE.nonEmpty + $ maybe (Left $ I.help docs) (fmap Input.DocsI . traverse handleHashQualifiedSplit'Arg) . NE.nonEmpty api :: InputPattern api = @@ -1144,7 +1021,7 @@ ui = help = P.wrap "`ui` opens the Local UI in the default browser.", parse = \case [] -> pure $ Input.UiI Path.relativeEmpty' - [path] -> bimap P.text Input.UiI $ handlePath'Arg path + [path] -> Input.UiI <$> handlePath'Arg path _ -> Left (I.help ui) } @@ -1307,7 +1184,7 @@ findShallow = ) ( fmap Input.FindShallowI . \case [] -> pure Path.relativeEmpty' - [path] -> first P.text $ handlePath'Arg path + [path] -> handlePath'Arg path _ -> Left (I.help findShallow) ) @@ -1345,17 +1222,9 @@ renameTerm = ("new location", Required, newNameArg) ] "`move.term foo bar` renames `foo` to `bar`." - ( \case - [oldName, newName] -> - first P.text $ - Input.MoveTermI - <$> handleHashQualifiedSplit'Arg oldName - <*> handleNewName newName - _ -> - Left . P.warnCallout $ - P.wrap - "`rename.term` takes two arguments, like `rename.term oldname newname`." - ) + \case + [oldName, newName] -> Input.MoveTermI <$> handleHashQualifiedSplit'Arg oldName <*> handleNewName newName + _ -> Left . P.warnCallout $ P.wrap "`rename.term` takes two arguments, like `rename.term oldname newname`." moveAll :: InputPattern moveAll = @@ -1367,17 +1236,9 @@ moveAll = ("new location", Required, newNameArg) ] "`move foo bar` renames the term, type, and namespace foo to bar." - ( \case - [oldName, newName] -> - first P.text $ - Input.MoveAllI - <$> handlePath'Arg oldName - <*> handleNewPath newName - _ -> - Left . P.warnCallout $ - P.wrap - "`move` takes two arguments, like `move oldname newname`." - ) + \case + [oldName, newName] -> Input.MoveAllI <$> handlePath'Arg oldName <*> handleNewPath newName + _ -> Left . P.warnCallout $ P.wrap "`move` takes two arguments, like `move oldname newname`." renameType :: InputPattern renameType = @@ -1389,17 +1250,10 @@ renameType = ("new location", Required, newNameArg) ] "`move.type foo bar` renames `foo` to `bar`." - ( \case - [oldName, newName] -> - first P.text $ - Input.MoveTypeI - <$> handleHashQualifiedSplit'Arg oldName - <*> handleNewName newName - _ -> - Left . P.warnCallout $ - P.wrap - "`rename.type` takes two arguments, like `rename.type oldname newname`." - ) + \case + [oldName, newName] -> Input.MoveTypeI <$> handleHashQualifiedSplit'Arg oldName <*> handleNewName newName + _ -> + Left . P.warnCallout $ P.wrap "`rename.type` takes two arguments, like `rename.type oldname newname`." deleteGen :: Maybe String -> ArgumentType -> String -> ([Path.HQSplit'] -> DeleteTarget) -> InputPattern deleteGen suffix queryCompletionArg target mkTarget = @@ -1438,12 +1292,9 @@ deleteGen suffix queryCompletionArg target mkTarget = I.Visible [("definition to delete", OnePlus, queryCompletionArg)] info - ( \case - [] -> Left . P.warnCallout $ P.wrap warn - queries -> - bimap P.text (Input.DeleteI . mkTarget) $ - traverse handleHashQualifiedSplit'Arg queries - ) + \case + [] -> Left . P.warnCallout $ P.wrap warn + queries -> Input.DeleteI . mkTarget <$> traverse handleHashQualifiedSplit'Arg queries delete :: InputPattern delete = deleteGen Nothing exactDefinitionTypeOrTermQueryArg "term or type" (DeleteTarget'TermOrType DeleteOutput'NoDiff) @@ -1475,9 +1326,7 @@ deleteProject = [ ("`delete.project foo`", "deletes the local project `foo`") ], parse = \case - [name] -> - bimap P.text (Input.DeleteI . DeleteTarget'Project) $ - handleProjectArg name + [name] -> Input.DeleteI . DeleteTarget'Project <$> handleProjectArg name _ -> Left (showPatternHelp deleteProject) } @@ -1494,9 +1343,7 @@ deleteBranch = ("`delete.branch /bar`", "deletes the branch `bar` in the current project") ], parse = \case - [name] -> - Input.DeleteI . DeleteTarget'ProjectBranch - <$> handleMaybeProjectBranchArg name + [name] -> Input.DeleteI . DeleteTarget'ProjectBranch <$> handleMaybeProjectBranchArg name _ -> Left (showPatternHelp deleteBranch) } where @@ -1516,15 +1363,8 @@ aliasTerm = [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)] "`alias.term foo bar` introduces `bar` with the same definition as `foo`." $ \case - [oldName, newName] -> - first P.text $ - Input.AliasTermI - <$> handleShortHashOrHQSplit'Arg oldName - <*> handleSplit'Arg newName - _ -> - Left . warn $ - P.wrap - "`alias.term` takes two arguments, like `alias.term oldname newname`." + [oldName, newName] -> Input.AliasTermI <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + _ -> Left . warn $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`." aliasType :: InputPattern aliasType = @@ -1534,16 +1374,9 @@ aliasType = I.Visible [("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)] "`alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`." - $ \case - [oldName, newName] -> - first P.text $ - Input.AliasTypeI - <$> handleShortHashOrHQSplit'Arg oldName - <*> handleSplit'Arg newName - _ -> - Left . warn $ - P.wrap - "`alias.type` takes two arguments, like `alias.type oldname newname`." + \case + [oldName, newName] -> Input.AliasTypeI <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + _ -> Left . warn $ P.wrap "`alias.type` takes two arguments, like `alias.type oldname newname`." aliasMany :: InputPattern aliasMany = @@ -1561,12 +1394,9 @@ aliasMany = <> "creates aliases `.quux.foo.foo` and `.quux.bar.bar`." ] ) - $ \case + \case srcs@(_ : _) Cons.:> dest -> - first P.text $ - Input.AliasManyI - <$> traverse handleHashQualifiedSplitArg srcs - <*> handlePath'Arg dest + Input.AliasManyI <$> traverse handleHashQualifiedSplitArg srcs <*> handlePath'Arg dest _ -> Left (I.help aliasMany) up :: InputPattern @@ -1577,10 +1407,9 @@ up = I.Hidden [] (P.wrapColumn2 [(makeExample up [], "move current path up one level (deprecated)")]) - ( \case - [] -> Right Input.UpI - _ -> Left (I.help up) - ) + \case + [] -> Right Input.UpI + _ -> Left (I.help up) cd :: InputPattern cd = @@ -1608,9 +1437,9 @@ cd = ] ] ) - $ \case + \case [Left ".."] -> Right Input.UpI - [p] -> bimap P.text Input.SwitchBranchI $ handlePath'Arg p + [p] -> Input.SwitchBranchI <$> handlePath'Arg p _ -> Left (I.help cd) back :: InputPattern @@ -1654,13 +1483,8 @@ deleteNamespaceForce = deleteNamespaceParser :: P.Pretty CT.ColorText -> Input.Insistence -> I.Arguments -> Either (P.Pretty CT.ColorText) Input deleteNamespaceParser helpText insistence = \case - [Left "."] -> - first fromString - . pure - $ Input.DeleteI (DeleteTarget'Namespace insistence Nothing) - [p] -> - bimap P.text (Input.DeleteI . DeleteTarget'Namespace insistence . pure) $ - handleSplitArg p + [Left "."] -> first fromString . pure $ Input.DeleteI (DeleteTarget'Namespace insistence Nothing) + [p] -> Input.DeleteI . DeleteTarget'Namespace insistence . pure <$> handleSplitArg p _ -> Left helpText renameBranch :: InputPattern @@ -1671,10 +1495,8 @@ renameBranch = I.Visible [("namespace to move", Required, namespaceArg), ("new location", Required, newNameArg)] "`move.namespace foo bar` renames the path `foo` to `bar`." - $ \case - [src, dest] -> - first P.text $ - Input.MoveBranchI <$> handlePath'Arg src <*> handlePath'Arg dest + \case + [src, dest] -> Input.MoveBranchI <$> handlePath'Arg src <*> handlePath'Arg dest _ -> Left (I.help renameBranch) history :: InputPattern @@ -1693,10 +1515,8 @@ history = ) ] ) - $ \case - [src] -> - bimap P.text (Input.HistoryI (Just 10) (Just 10)) $ - handleBranchIdArg src + \case + [src] -> Input.HistoryI (Just 10) (Just 10) <$> handleBranchIdArg src [] -> pure $ Input.HistoryI (Just 10) (Just 10) (Right Path.currentPath) _ -> Left (I.help history) @@ -1721,11 +1541,8 @@ forkLocal = ) ] ) - $ \case - [src, dest] -> - Input.ForkLocalBranchI - <$> handleBranchId2Arg src - <*> handleBranchRelativePathArg dest + \case + [src, dest] -> Input.ForkLocalBranchI <$> handleBranchId2Arg src <*> handleBranchRelativePathArg dest _ -> Left (I.help forkLocal) libInstallInputPattern :: InputPattern @@ -1755,7 +1572,7 @@ libInstallInputPattern = ] ], parse = \case - [arg] -> bimap P.text Input.LibInstallI $ handleProjectMaybeBranchArg arg + [arg] -> Input.LibInstallI <$> handleProjectMaybeBranchArg arg _ -> Left (I.help libInstallInputPattern) } @@ -1775,17 +1592,10 @@ reset = ("`reset #pvfd222s8n /topic`", "reset the branch `topic` of the current project to the causal `#pvfd222s8n`.") ] ) - ( \case - [arg0] -> - Input.ResetI - <$> first P.text (handleBranchIdOrProjectArg arg0) - <*> pure Nothing - [arg0, arg1] -> - Input.ResetI - <$> first P.text (handleBranchIdOrProjectArg arg0) - <*> bimap P.text pure (handleLooseCodeOrProjectArg arg1) - _ -> Left $ I.help reset - ) + \case + [arg0] -> Input.ResetI <$> handleBranchIdOrProjectArg arg0 <*> pure Nothing + [arg0, arg1] -> Input.ResetI <$> handleBranchIdOrProjectArg arg0 <*> fmap pure (handleLooseCodeOrProjectArg arg1) + _ -> Left $ I.help reset where config = ProjectBranchSuggestionsConfig @@ -1816,7 +1626,7 @@ resetRoot = ] ) $ \case - [src] -> bimap P.text Input.ResetRootI $ handleBranchIdArg src + [src] -> Input.ResetRootI <$> handleBranchIdArg src _ -> Left (I.help resetRoot) pull :: InputPattern @@ -1949,7 +1759,7 @@ debugFuzzyOptions = P.wrap $ "or `debug.fuzzy-options merge - _`" ] ) - $ \case + \case (cmd : args) -> Input.DebugFuzzyOptionsI <$> unsupportedStructuredArgument "a command" cmd @@ -2014,13 +1824,9 @@ push = ) . \case [] -> pure Input.PushSourceTarget0 - [targetStr] -> - bimap P.text Input.PushSourceTarget1 $ handlePushTargetArg targetStr + [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr [targetStr, sourceStr] -> - first P.text $ - Input.PushSourceTarget2 - <$> handlePushSourceArg sourceStr - <*> handlePushTargetArg targetStr + Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr _ -> Left (I.help push) where suggestionsConfig = @@ -2069,13 +1875,9 @@ pushCreate = ) . \case [] -> pure Input.PushSourceTarget0 - [targetStr] -> - bimap P.text Input.PushSourceTarget1 $ handlePushTargetArg targetStr + [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr [targetStr, sourceStr] -> - first P.text $ - Input.PushSourceTarget2 - <$> handlePushSourceArg sourceStr - <*> handlePushTargetArg targetStr + Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr _ -> Left (I.help pushForce) where suggestionsConfig = @@ -2103,13 +1905,9 @@ pushForce = ) . \case [] -> pure Input.PushSourceTarget0 - [targetStr] -> - bimap P.text Input.PushSourceTarget1 $ handlePushTargetArg targetStr + [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr [targetStr, sourceStr] -> - first P.text $ - Input.PushSourceTarget2 - <$> handlePushSourceArg sourceStr - <*> handlePushTargetArg targetStr + Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr _ -> Left (I.help pushForce) where suggestionsConfig = @@ -2147,13 +1945,9 @@ pushExhaustive = ) . \case [] -> pure Input.PushSourceTarget0 - [targetStr] -> - bimap P.text Input.PushSourceTarget1 $ handlePushTargetArg targetStr + [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr [targetStr, sourceStr] -> - first P.text $ - Input.PushSourceTarget2 - <$> handlePushSourceArg sourceStr - <*> handlePushTargetArg targetStr + Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr _ -> Left (I.help pushExhaustive) where suggestionsConfig = @@ -2182,11 +1976,10 @@ mergeOldSquashInputPattern = <> "additional history entry.", parse = \case [src, dest] -> - first P.text $ - Input.MergeLocalBranchI - <$> handleLooseCodeOrProjectArg src - <*> handleLooseCodeOrProjectArg dest - <*> pure Branch.SquashMerge + Input.MergeLocalBranchI + <$> handleLooseCodeOrProjectArg src + <*> handleLooseCodeOrProjectArg dest + <*> pure Branch.SquashMerge _ -> Left $ I.help mergeOldSquashInputPattern } where @@ -2229,17 +2022,15 @@ mergeOldInputPattern = ) ( \case [src] -> - first P.text $ - Input.MergeLocalBranchI - <$> handleLooseCodeOrProjectArg src - <*> pure (This Path.relativeEmpty') - <*> pure Branch.RegularMerge + Input.MergeLocalBranchI + <$> handleLooseCodeOrProjectArg src + <*> pure (This Path.relativeEmpty') + <*> pure Branch.RegularMerge [src, dest] -> - first P.text $ - Input.MergeLocalBranchI - <$> handleLooseCodeOrProjectArg src - <*> handleLooseCodeOrProjectArg dest - <*> pure Branch.RegularMerge + Input.MergeLocalBranchI + <$> handleLooseCodeOrProjectArg src + <*> handleLooseCodeOrProjectArg dest + <*> pure Branch.RegularMerge _ -> Left $ I.help mergeOldInputPattern ) where @@ -2303,16 +2094,8 @@ diffNamespace = ] ) ( \case - [before, after] -> - first P.text $ - Input.DiffNamespaceI - <$> handleBranchIdArg before - <*> handleBranchIdArg after - [before] -> - first P.text $ - Input.DiffNamespaceI - <$> handleBranchIdArg before - <*> pure (pure Path.currentPath) + [before, after] -> Input.DiffNamespaceI <$> handleBranchIdArg before <*> handleBranchIdArg after + [before] -> Input.DiffNamespaceI <$> handleBranchIdArg before <*> pure (pure Path.currentPath) _ -> Left $ I.help diffNamespace ) where @@ -2340,16 +2123,9 @@ mergeOldPreviewInputPattern = ] ) ( \case - [src] -> - first P.text $ - Input.PreviewMergeLocalBranchI - <$> handleLooseCodeOrProjectArg src - <*> pure (This Path.relativeEmpty') + [src] -> Input.PreviewMergeLocalBranchI <$> handleLooseCodeOrProjectArg src <*> pure (This Path.relativeEmpty') [src, dest] -> - first P.text $ - Input.PreviewMergeLocalBranchI - <$> handleLooseCodeOrProjectArg src - <*> handleLooseCodeOrProjectArg dest + Input.PreviewMergeLocalBranchI <$> handleLooseCodeOrProjectArg src <*> handleLooseCodeOrProjectArg dest _ -> Left $ I.help mergeOldPreviewInputPattern ) where @@ -2409,7 +2185,7 @@ editNamespace = [ "`edit.namespace` will load all terms and types contained within the current namespace into your scratch file. This includes definitions in namespaces, but excludes libraries.", "`edit.namespace ns1 ns2 ...` loads the terms and types contained within the provided namespaces." ], - parse = bimap P.text Input.EditNamespaceI . traverse handlePathArg + parse = fmap Input.EditNamespaceI . traverse handlePathArg } topicNameArg :: ArgumentType @@ -2705,8 +2481,7 @@ namespaceDependencies = [("namespace", Optional, namespaceArg)] "List the external dependencies of the specified namespace." $ \case - [p] -> - bimap P.text (Input.NamespaceDependenciesI . pure) $ handlePath'Arg p + [p] -> Input.NamespaceDependenciesI . pure <$> handlePath'Arg p [] -> pure (Input.NamespaceDependenciesI Nothing) _ -> Left (I.help namespaceDependencies) @@ -2831,15 +2606,9 @@ debugNameDiff = visibility = I.Hidden, args = [("before namespace", Required, namespaceArg), ("after namespace", Required, namespaceArg)], help = P.wrap "List all name changes between two causal hashes. Does not detect patch changes.", - parse = - ( \case - [from, to] -> - first P.text $ - Input.DebugNameDiffI - <$> handleShortCausalHashArg from - <*> handleShortCausalHashArg to - _ -> Left (I.help debugNameDiff) - ) + parse = \case + [from, to] -> Input.DebugNameDiffI <$> handleShortCausalHashArg from <*> handleShortCausalHashArg to + _ -> Left (I.help debugNameDiff) } test :: InputPattern @@ -2867,7 +2636,7 @@ test = ) . \case [] -> pure Path.empty - [pathString] -> first P.text $ handlePathArg pathString + [pathString] -> handlePathArg pathString _ -> Left $ I.help test } @@ -2904,10 +2673,10 @@ docsToHtml = ) ] ) - $ \case + \case [namespacePath, destinationFilePath] -> Input.DocsToHtmlI - <$> first P.text (handlePath'Arg namespacePath) + <$> handlePath'Arg namespacePath <*> unsupportedStructuredArgument "a file name" destinationFilePath _ -> Left $ showPatternHelp docsToHtml @@ -2924,9 +2693,8 @@ docToMarkdown = ) ] ) - $ \case - [docNameText] -> - bimap P.text Input.DocToMarkdownI $ handleNameArg docNameText + \case + [docNameText] -> Input.DocToMarkdownI <$> handleNameArg docNameText _ -> Left $ showPatternHelp docToMarkdown execute :: InputPattern @@ -2962,7 +2730,7 @@ saveExecuteResult = <> "as `name`." ) $ \case - [w] -> first P.text $ Input.SaveExecuteResultI <$> handleNameArg w + [w] -> Input.SaveExecuteResultI <$> handleNameArg w _ -> Left $ showPatternHelp saveExecuteResult ioTest :: InputPattern @@ -3085,10 +2853,8 @@ createAuthor = \case symbolStr : authorStr@(_ : _) -> Input.CreateAuthorI - <$> first P.text (handleRelativeNameSegmentArg symbolStr) - <*> fmap - (parseAuthorName . unwords) - (traverse (unsupportedStructuredArgument "text") authorStr) + <$> handleRelativeNameSegmentArg symbolStr + <*> fmap (parseAuthorName . unwords) (traverse (unsupportedStructuredArgument "text") authorStr) _ -> Left $ showPatternHelp createAuthor where -- let's have a real parser in not too long @@ -3172,10 +2938,8 @@ projectCreate = ("`project.create foo`", "creates a project named `foo`") ], parse = \case - [] -> Right (Input.ProjectCreateI True Nothing) - [name] -> - bimap P.text (Input.ProjectCreateI True . pure) $ - handleProjectArg name + [] -> pure $ Input.ProjectCreateI True Nothing + [name] -> Input.ProjectCreateI True . pure <$> handleProjectArg name _ -> Left $ showPatternHelp projectCreate } @@ -3192,10 +2956,8 @@ projectCreateEmptyInputPattern = ("`project.create-empty foo`", "creates an empty project named `foo`") ], parse = \case - [] -> Right (Input.ProjectCreateI False Nothing) - [name] -> - bimap P.text (Input.ProjectCreateI False . pure) $ - handleProjectArg name + [] -> pure $ Input.ProjectCreateI False Nothing + [name] -> Input.ProjectCreateI False . pure <$> handleProjectArg name _ -> Left $ showPatternHelp projectCreateEmptyInputPattern } @@ -3211,8 +2973,7 @@ projectRenameInputPattern = [ ("`project.rename foo`", "renames the current project to `foo`") ], parse = \case - [nameString] -> - bimap P.text Input.ProjectRenameI $ handleProjectArg nameString + [nameString] -> Input.ProjectRenameI <$> handleProjectArg nameString _ -> Left (showPatternHelp projectRenameInputPattern) } @@ -3231,9 +2992,7 @@ projectSwitch = ("`switch /bar`", "switches to the branch `bar` in the current project") ], parse = \case - [name] -> - bimap P.text Input.ProjectSwitchI $ - handleProjectAndBranchNamesArg name + [name] -> Input.ProjectSwitchI <$> handleProjectAndBranchNamesArg name _ -> Left (showPatternHelp projectSwitch) } where @@ -3269,8 +3028,7 @@ branchesInputPattern = ], parse = \case [] -> Right (Input.BranchesI Nothing) - [nameString] -> - bimap P.text (Input.BranchesI . pure) $ handleProjectArg nameString + [nameString] -> Input.BranchesI . pure <$> handleProjectArg nameString _ -> Left (showPatternHelp branchesInputPattern) } @@ -3293,11 +3051,9 @@ branchInputPattern = parse = \case [source0, name] -> Input.BranchI . Input.BranchSourceI'LooseCodeOrProject - <$> first P.text (handleLooseCodeOrProjectArg source0) + <$> handleLooseCodeOrProjectArg source0 <*> handleMaybeProjectBranchArg name - [name] -> - Input.BranchI Input.BranchSourceI'CurrentContext - <$> handleMaybeProjectBranchArg name + [name] -> Input.BranchI Input.BranchSourceI'CurrentContext <$> handleMaybeProjectBranchArg name _ -> Left $ showPatternHelp branchInputPattern } where @@ -3340,8 +3096,7 @@ branchRenameInputPattern = P.wrapColumn2 [("`branch.rename foo`", "renames the current branch to `foo`")], parse = \case - [name] -> - bimap P.text Input.BranchRenameI $ handleProjectBranchNameArg name + [name] -> Input.BranchRenameI <$> handleProjectBranchNameArg name _ -> Left (showPatternHelp branchRenameInputPattern) } @@ -3375,16 +3130,11 @@ clone = ) ], parse = \case - [remoteNames] -> do - first P.text $ - Input.CloneI - <$> handleProjectAndBranchNamesArg remoteNames - <*> pure Nothing + [remoteNames] -> Input.CloneI <$> handleProjectAndBranchNamesArg remoteNames <*> pure Nothing [remoteNames, localNames] -> - first P.text $ - Input.CloneI - <$> handleProjectAndBranchNamesArg remoteNames - <*> fmap pure (handleProjectAndBranchNamesArg localNames) + Input.CloneI + <$> handleProjectAndBranchNamesArg remoteNames + <*> fmap pure (handleProjectAndBranchNamesArg localNames) _ -> Left $ showPatternHelp clone } @@ -3417,10 +3167,7 @@ upgrade = "`upgrade old new` upgrades library dependency `lib.old` to `lib.new`, and, if successful, deletes `lib.old`.", parse = \case [oldString, newString] -> - first P.text $ - Input.UpgradeI - <$> handleRelativeNameSegmentArg oldString - <*> handleRelativeNameSegmentArg newString + Input.UpgradeI <$> handleRelativeNameSegmentArg oldString <*> handleRelativeNameSegmentArg newString _ -> Left $ I.help upgrade } From f8474ff457f2d3a28bba854376e3b16b819e5168 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 28 May 2024 16:54:33 -0600 Subject: [PATCH 034/631] Handle `SCH` carefully in `StructuredArgument`s When `StructuredArgument`s are used as an input, preserve the entire hash. When printed, take the length as an optional argument (and show the full hash when unavailable). --- .../src/Unison/Codebase/ShortCausalHash.hs | 9 +++++++ .../src/Unison/Codebase/Editor/HandleInput.hs | 3 ++- .../src/Unison/Codebase/Editor/Output.hs | 4 ++-- .../src/Unison/CommandLine/InputPatterns.hs | 24 +++++++------------ .../src/Unison/CommandLine/OutputMessages.hs | 3 ++- 5 files changed, 24 insertions(+), 19 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs b/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs index 7533519337..7e8b40e75b 100644 --- a/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs +++ b/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs @@ -2,6 +2,7 @@ module Unison.Codebase.ShortCausalHash ( toString, toHash, fromHash, + fromFullHash, fromText, ShortCausalHash (..), ) @@ -27,6 +28,14 @@ fromHash :: (Coercible h Hash.Hash) => Int -> h -> ShortCausalHash fromHash len = ShortCausalHash . Text.take len . Hash.toBase32HexText . coerce +-- | This allows a full hash to be preserved as a `ShortCausalHash`. +-- +-- `ShortCausalHash` is used for input when we expect a user to enter a hash on the command line, so they aren’t +-- required to enter the full hash. However, these inputs may also come from an internal source, and in such cases, +-- there is no reason to truncate the hash. +fromFullHash :: (Coercible h Hash.Hash) => h -> ShortCausalHash +fromFullHash = ShortCausalHash . Hash.toBase32HexText . coerce + -- abc -> SCH abc -- #abc -> SCH abc fromText :: Text -> Maybe ShortCausalHash diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 9f934f574f..26eb5723ff 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -812,8 +812,9 @@ loop e = do ListDependenciesI hq -> handleDependencies hq NamespaceDependenciesI path -> handleNamespaceDependencies path DebugNumberedArgsI -> do + schLength <- Cli.runTransaction Codebase.branchHashLength numArgs <- use #numberedArgs - Cli.respond (DumpNumberedArgs numArgs) + Cli.respond (DumpNumberedArgs schLength numArgs) DebugTypecheckedUnisonFileI -> do hqLength <- Cli.runTransaction Codebase.hashLength uf <- Cli.expectLatestTypecheckedFile diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 4aa79eed30..ca67d3e4b9 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -27,7 +27,7 @@ import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import Unison.Auth.Types (CredentialFailure) -import Unison.Cli.MergeTypes (MergeSourceOrTarget, MergeSourceAndTarget) +import Unison.Cli.MergeTypes (MergeSourceAndTarget, MergeSourceOrTarget) import Unison.Cli.Share.Projects.Types qualified as Share import Unison.Codebase.Editor.Input import Unison.Codebase.Editor.Output.BranchDiff (BranchDiffOutput) @@ -302,7 +302,7 @@ data Output | ListDependencies PPE.PrettyPrintEnv (Set LabeledDependency) [HQ.HashQualified Name] [HQ.HashQualified Name] -- types, terms | -- | List dependents of a type or term. ListDependents PPE.PrettyPrintEnv (Set LabeledDependency) [HQ.HashQualified Name] [HQ.HashQualified Name] -- types, terms - | DumpNumberedArgs NumberedArgs + | DumpNumberedArgs HashLength NumberedArgs | DumpBitBooster CausalHash (Map CausalHash [CausalHash]) | DumpUnisonFileHashes Int [(Name, Reference.Id)] [(Name, Reference.Id)] [(Name, Reference.Id)] | BadName Text diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 7f7524dd2b..dac3379049 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -220,14 +220,8 @@ import Unison.Util.Monoid (intercalateMap) import Unison.Util.Pretty qualified as P import Unison.Util.Pretty.MegaParsec (prettyPrintParseError) --- | --- --- __FIXME__: Don’t hardcode this -schLength :: Int -schLength = 10 - -formatStructuredArgument :: StructuredArgument -> Text -formatStructuredArgument = \case +formatStructuredArgument :: Maybe Int -> StructuredArgument -> Text +formatStructuredArgument schLength = \case SA.AbsolutePath path -> into @Text $ show path SA.Name name -> Name.toText name SA.HashQualified hqName -> HQ.toText hqName @@ -237,7 +231,7 @@ formatStructuredArgument = \case -- also: ShortHash.toText . Reference.toShortHash SA.Ref reference -> Reference.toText reference -- also: ("#" <>) . Hash.toBase32HexText . unCausalHash - SA.Namespace causalHash -> ("#" <>) . SCH.toText $ SCH.fromHash schLength causalHash + SA.Namespace causalHash -> ("#" <>) . SCH.toText $ maybe SCH.fromFullHash SCH.fromHash schLength causalHash SA.NameWithBranchPrefix absBranchId name -> prefixBranchId absBranchId name SA.HashQualifiedWithBranchPrefix absBranchId hq'Name -> HQ'.toTextWith (prefixBranchId absBranchId) hq'Name SA.ShallowListEntry path entry -> entryToHQText path entry @@ -270,7 +264,7 @@ formatStructuredArgument = \case -- command /should/ accept a structured argument of some type, but currently -- wants a `String`. unifyArgument :: I.Argument -> String -unifyArgument = either id (Text.unpack . formatStructuredArgument) +unifyArgument = either id (Text.unpack . formatStructuredArgument Nothing) showPatternHelp :: InputPattern -> P.Pretty CT.ColorText showPatternHelp i = @@ -306,7 +300,7 @@ wrongStructuredArgument :: Text -> StructuredArgument -> P.Pretty CT.ColorText wrongStructuredArgument expected actual = P.text $ expectedButActually expected - (formatStructuredArgument actual) + (formatStructuredArgument Nothing actual) case actual of SA.Ref _ -> "a reference" SA.Name _ -> "a name" @@ -467,7 +461,7 @@ handleBranchIdArg = SA.Name name -> pure . pure $ Path.fromName' name SA.NameWithBranchPrefix mprefix name -> pure . pure . Path.fromName' $ either (const name) (Name.makeAbsolute . flip Path.prefixName name) mprefix - SA.Namespace hash -> pure . Left $ SCH.fromHash schLength hash + SA.Namespace hash -> pure . Left $ SCH.fromFullHash hash otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg handleBranchIdOrProjectArg :: @@ -477,7 +471,7 @@ handleBranchIdOrProjectArg = either (maybe (Left $ P.text "Expected a branch or project, but it’s not") pure . branchIdOrProject) \case - SA.Namespace hash -> pure . This . Left $ SCH.fromHash schLength hash + SA.Namespace hash -> pure . This . Left $ SCH.fromFullHash hash SA.AbsolutePath path -> pure . This . pure $ Path.absoluteToPath' path SA.Name name -> pure . This . pure $ Path.fromName' name SA.NameWithBranchPrefix (Left _) name -> pure . This . pure $ Path.fromName' name @@ -509,7 +503,7 @@ handleBranchId2Arg = either Input.parseBranchId2 \case - SA.Namespace hash -> pure . Left $ SCH.fromHash schLength hash + SA.Namespace hash -> pure . Left $ SCH.fromFullHash hash SA.AbsolutePath path -> pure . pure . LoosePath $ Path.absoluteToPath' path SA.Name name -> pure . pure . LoosePath $ Path.fromName' name SA.NameWithBranchPrefix (Left _) name -> pure . pure . LoosePath $ Path.fromName' name @@ -584,7 +578,7 @@ handleShortCausalHashArg = either (first (P.text . Text.pack) . Input.parseShortCausalHash) \case - SA.Namespace hash -> pure $ SCH.fromHash schLength hash + SA.Namespace hash -> pure $ SCH.fromFullHash hash otherNumArg -> Left $ wrongStructuredArgument "a causal hash" otherNumArg handleShortHashOrHQSplit'Arg :: diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 43e6c9fbbb..0054183d4a 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1545,7 +1545,8 @@ notifyUser dir = \case prettyNamespaceKey dest <> "is already up-to-date with" <> P.group (prettyNamespaceKey src <> ".") - DumpNumberedArgs args -> pure . P.numberedList $ fmap (P.text . IP.formatStructuredArgument) args + DumpNumberedArgs schLength args -> + pure . P.numberedList $ fmap (P.text . IP.formatStructuredArgument (pure schLength)) args NoConflictsOrEdits -> pure (P.okCallout "No conflicts or edits in progress.") HelpMessage pat -> pure $ IP.showPatternHelp pat From efcff6e076dc67e949281b1b5dee92b268d23b04 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 28 May 2024 17:17:22 -0600 Subject: [PATCH 035/631] Add an EditorConfig config MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit https://editorconfig.org/ This provides limited editor-agnostic style information. The only one I care about here is `max_line_length`, since Ormolu doesn’t manage that. It sets up my editor so that comments wrap at the expected place, and gives me a hint when expressions should be split. The other values just seem like reasonable ones, but they can also be removed (and/or customized for particular file types). --- .editorconfig | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 .editorconfig diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000000..24503cfc21 --- /dev/null +++ b/.editorconfig @@ -0,0 +1,11 @@ +# Multi-editor style config: https://EditorConfig.org + +root = true + +[*] +charset = utf-8 +end_of_line = lf +indent_style = space +insert_final_newline = true +max_line_length = 120 +trim_trailing_whitespace = true From 50334f262f9628fd8a6b120d5979654778d00362 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 28 May 2024 16:44:01 -0400 Subject: [PATCH 036/631] make "lenient" decl coherency check that can't fail --- lib/unison-prelude/src/Unison/Util/Map.hs | 6 + .../src/Unison/Merge/DeclCoherencyCheck.hs | 151 +++++++++++++----- .../src/Unison/Merge/DeclNameLookup.hs | 5 + 3 files changed, 121 insertions(+), 41 deletions(-) diff --git a/lib/unison-prelude/src/Unison/Util/Map.hs b/lib/unison-prelude/src/Unison/Util/Map.hs index 3f46ad42af..be67d730b3 100644 --- a/lib/unison-prelude/src/Unison/Util/Map.hs +++ b/lib/unison-prelude/src/Unison/Util/Map.hs @@ -5,6 +5,7 @@ module Unison.Util.Map bitraverse, bitraversed, deleteLookup, + deleteLookupJust, elemsSet, foldM, foldMapM, @@ -106,6 +107,11 @@ deleteLookup :: (Ord k) => k -> Map k v -> (Maybe v, Map k v) deleteLookup = Map.alterF (,Nothing) +-- | Like 'deleteLookup', but asserts the value is in the map prior to deletion. +deleteLookupJust :: (HasCallStack, Ord k) => k -> Map k v -> (v, Map k v) +deleteLookupJust = + Map.alterF (maybe (error (reportBug "E525283" "deleteLookupJust: element not found")) (,Nothing)) + -- | Like 'Map.elems', but return the values as a set. elemsSet :: Ord v => Map k v -> Set v elemsSet = diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index b763d4e55a..a548129046 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -82,10 +82,11 @@ module Unison.Merge.DeclCoherencyCheck ( IncoherentDeclReason (..), checkDeclCoherency, + lenientCheckDeclCoherency, ) where -import Control.Lens (view, (%=), (.=)) +import Control.Lens (over, view, (%=), (.=), _2) import Control.Monad.Except (ExceptT) import Control.Monad.Except qualified as Except import Control.Monad.State.Strict (StateT) @@ -108,9 +109,8 @@ import Unison.NameSegment (NameSegment) import Unison.Prelude import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Unison.Sqlite (Transaction) import Unison.Util.Defns (Defns (..), DefnsF) -import Unison.Util.Map qualified as Map (deleteLookup, upsertF) +import Unison.Util.Map qualified as Map (deleteLookup, deleteLookupJust, upsertF) import Unison.Util.Nametree (Nametree (..)) data IncoherentDeclReason @@ -129,9 +129,11 @@ data IncoherentDeclReason | IncoherentDeclReason'StrayConstructor !Name checkDeclCoherency :: - (TypeReferenceId -> Transaction Int) -> + forall m. + Monad m => + (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> - Transaction (Either IncoherentDeclReason DeclNameLookup) + m (Either IncoherentDeclReason DeclNameLookup) checkDeclCoherency loadDeclNumConstructors = Except.runExceptT . fmap (view #declNameLookup) @@ -140,10 +142,10 @@ checkDeclCoherency loadDeclNumConstructors = where go :: [NameSegment] -> - (Nametree (Defns (Map NameSegment Referent) (Map NameSegment TypeReference))) -> - StateT DeclCoherencyCheckState (ExceptT IncoherentDeclReason Transaction) () - go prefix (Nametree Defns {terms, types} children) = do - for_ (Map.toList terms) \case + (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + StateT DeclCoherencyCheckState (ExceptT IncoherentDeclReason m) () + go prefix (Nametree defns children) = do + for_ (Map.toList defns.terms) \case (_, Referent.Ref _) -> pure () (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure () (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do @@ -152,35 +154,35 @@ checkDeclCoherency loadDeclNumConstructors = #expectedConstructors .= expectedConstructors1 where f :: - Maybe (Name, IntMap MaybeConstructorName) -> - Either IncoherentDeclReason (Name, IntMap MaybeConstructorName) + Maybe (Name, IntMap (Maybe Name)) -> + Either IncoherentDeclReason (Name, IntMap (Maybe Name)) f = \case Nothing -> Left (IncoherentDeclReason'StrayConstructor (fullName name)) Just (typeName, expected) -> (typeName,) <$> IntMap.alterF g (fromIntegral @Word64 @Int conId) expected where - g :: Maybe MaybeConstructorName -> Either IncoherentDeclReason (Maybe MaybeConstructorName) + g :: Maybe (Maybe Name) -> Either IncoherentDeclReason (Maybe (Maybe Name)) g = \case Nothing -> error "didnt put expected constructor id" - Just NoConstructorNameYet -> Right (Just (YesConstructorName (fullName name))) - Just (YesConstructorName firstName) -> + Just Nothing -> Right (Just (Just (fullName name))) + Just (Just firstName) -> Left (IncoherentDeclReason'ConstructorAlias firstName (fullName name)) childrenWeWentInto <- - forMaybe (Map.toList types) \case + forMaybe (Map.toList defns.types) \case (_, ReferenceBuiltin _) -> pure Nothing (name, ReferenceDerived typeRef) -> do DeclCoherencyCheckState {expectedConstructors} <- State.get whatHappened <- do let recordNewDecl :: - Maybe (Name, IntMap MaybeConstructorName) -> - Compose (ExceptT IncoherentDeclReason Transaction) WhatHappened (Name, IntMap MaybeConstructorName) + Maybe (Name, IntMap (Maybe Name)) -> + Compose (ExceptT IncoherentDeclReason m) WhatHappened (Name, IntMap (Maybe Name)) recordNewDecl = Compose . \case Just (shorterTypeName, _) -> Except.throwError (IncoherentDeclReason'NestedDeclAlias shorterTypeName typeName) Nothing -> lift (loadDeclNumConstructors typeRef) <&> \case 0 -> UninhabitedDecl - n -> InhabitedDecl (typeName, IntMap.fromAscList [(i, NoConstructorNameYet) | i <- [0 .. n - 1]]) + n -> InhabitedDecl (typeName, IntMap.fromAscList [(i, Nothing) | i <- [0 .. n - 1]]) lift (getCompose (Map.upsertF recordNewDecl typeRef expectedConstructors)) case whatHappened of UninhabitedDecl -> do @@ -197,18 +199,92 @@ checkDeclCoherency loadDeclNumConstructors = let (fromJust -> (_typeName, maybeConstructorNames), expectedConstructors1) = Map.deleteLookup typeRef expectedConstructors constructorNames <- - unMaybeConstructorNames maybeConstructorNames & onNothing do + sequence (IntMap.elems maybeConstructorNames) & onNothing do Except.throwError (IncoherentDeclReason'MissingConstructorName typeName) #expectedConstructors .= expectedConstructors1 - #declNameLookup %= \declNameLookup -> - DeclNameLookup - { constructorToDecl = - List.foldl' - (\acc constructorName -> Map.insert constructorName typeName acc) - declNameLookup.constructorToDecl - constructorNames, - declToConstructors = Map.insert typeName constructorNames declNameLookup.declToConstructors - } + #declNameLookup . #constructorToDecl %= \constructorToDecl -> + List.foldl' + (\acc constructorName -> Map.insert constructorName typeName acc) + constructorToDecl + constructorNames + #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames + pure (Just name) + where + typeName = fullName name + + let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto + for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child + where + fullName name = + Name.fromReverseSegments (name :| prefix) + +lenientCheckDeclCoherency :: + forall m. + Monad m => + (TypeReferenceId -> m Int) -> + Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> + m (Map Name [Maybe Name]) +lenientCheckDeclCoherency loadDeclNumConstructors = + fmap (view #declToConstructors) + . (`State.execStateT` LenientDeclCoherencyCheckState Map.empty Map.empty) + . go [] + where + go :: + [NameSegment] -> + (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + StateT LenientDeclCoherencyCheckState m () + go prefix (Nametree defns children) = do + for_ (Map.toList defns.terms) \case + (_, Referent.Ref _) -> pure () + (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure () + (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do + #expectedConstructors %= Map.adjust (Map.map f) typeRef + where + f :: IntMap (Maybe Name) -> IntMap (Maybe Name) + f = + IntMap.adjust g (fromIntegral @Word64 @Int conId) + where + g :: Maybe Name -> Maybe Name + g = \case + Nothing -> Just (fullName name) + -- Ignore constructor alias, just keep first name we found + Just firstName -> Just firstName + + childrenWeWentInto <- + forMaybe (Map.toList defns.types) \case + (_, ReferenceBuiltin _) -> pure Nothing + (name, ReferenceDerived typeRef) -> do + whatHappened <- do + let recordNewDecl :: m (WhatHappened (Map Name (IntMap (Maybe Name)))) + recordNewDecl = + loadDeclNumConstructors typeRef <&> \case + 0 -> UninhabitedDecl + n -> InhabitedDecl (Map.singleton typeName (IntMap.fromAscList [(i, Nothing) | i <- [0 .. n - 1]])) + state <- State.get + lift (getCompose (Map.upsertF (\_ -> Compose recordNewDecl) typeRef state.expectedConstructors)) + case whatHappened of + UninhabitedDecl -> do + #declToConstructors %= Map.insert typeName [] + pure Nothing + InhabitedDecl expectedConstructors1 -> do + let child = Map.findWithDefault (Nametree (Defns Map.empty Map.empty) Map.empty) name children + #expectedConstructors .= expectedConstructors1 + go (name : prefix) child + state <- State.get + let (maybeConstructorNames, expectedConstructors) = + Map.alterF f typeRef state.expectedConstructors + where + f :: + Maybe (Map Name (IntMap (Maybe Name))) -> + (IntMap (Maybe Name), Maybe (Map Name (IntMap (Maybe Name)))) + f = + -- fromJust is safe here because we upserted `typeRef` key above + -- deleteLookupJust is safe here because we upserted `typeName` key above + fromJust + >>> Map.deleteLookupJust typeName + >>> over _2 \m -> if Map.null m then Nothing else Just m + #expectedConstructors .= expectedConstructors + #declToConstructors %= Map.insert typeName (IntMap.elems maybeConstructorNames) pure (Just name) where typeName = fullName name @@ -220,23 +296,16 @@ checkDeclCoherency loadDeclNumConstructors = Name.fromReverseSegments (name :| prefix) data DeclCoherencyCheckState = DeclCoherencyCheckState - { expectedConstructors :: !(Map TypeReferenceId (Name, IntMap MaybeConstructorName)), + { expectedConstructors :: !(Map TypeReferenceId (Name, IntMap (Maybe Name))), declNameLookup :: !DeclNameLookup } deriving stock (Generic) -data MaybeConstructorName - = NoConstructorNameYet - | YesConstructorName !Name - -unMaybeConstructorNames :: IntMap MaybeConstructorName -> Maybe [Name] -unMaybeConstructorNames = - traverse f . IntMap.elems - where - f :: MaybeConstructorName -> Maybe Name - f = \case - NoConstructorNameYet -> Nothing - YesConstructorName name -> Just name +data LenientDeclCoherencyCheckState = LenientDeclCoherencyCheckState + { expectedConstructors :: !(Map TypeReferenceId (Map Name (IntMap (Maybe Name)))), + declToConstructors :: !(Map Name [Maybe Name]) + } + deriving stock (Generic) data WhatHappened a = UninhabitedDecl diff --git a/unison-merge/src/Unison/Merge/DeclNameLookup.hs b/unison-merge/src/Unison/Merge/DeclNameLookup.hs index c3e663172b..9fa85b99d9 100644 --- a/unison-merge/src/Unison/Merge/DeclNameLookup.hs +++ b/unison-merge/src/Unison/Merge/DeclNameLookup.hs @@ -12,8 +12,13 @@ import Data.Semigroup.Generic (GenericSemigroupMonoid (..)) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration import Unison.Name (Name) +import Unison.NameSegment (NameSegment) import Unison.Prelude +import Unison.Reference (TypeReference) +import Unison.Referent (Referent) import Unison.Syntax.Name qualified as Name +import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Util.Nametree (Nametree (..)) import Unison.Var (Var) -- | A lookup from decl-to-constructor name and vice-versa. From 52283ed3f7ded8cae8aa45cb08fd6128e36331fb Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 29 May 2024 10:38:13 -0400 Subject: [PATCH 037/631] minor cleanup --- .../src/Unison/Merge/DeclCoherencyCheck.hs | 82 ++++++++++++------- 1 file changed, 51 insertions(+), 31 deletions(-) diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index a548129046..82cff729f3 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -102,6 +102,7 @@ import Data.Maybe (fromJust) import Data.Set qualified as Set import U.Codebase.Reference (Reference' (..), TypeReference, TypeReferenceId) import Unison.ConstructorReference (GConstructorReference (..)) +import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) import Unison.Name (Name) import Unison.Name qualified as Name @@ -154,18 +155,16 @@ checkDeclCoherency loadDeclNumConstructors = #expectedConstructors .= expectedConstructors1 where f :: - Maybe (Name, IntMap (Maybe Name)) -> - Either IncoherentDeclReason (Name, IntMap (Maybe Name)) + Maybe (Name, ConstructorNames) -> + Either IncoherentDeclReason (Name, ConstructorNames) f = \case - Nothing -> Left (IncoherentDeclReason'StrayConstructor (fullName name)) - Just (typeName, expected) -> (typeName,) <$> IntMap.alterF g (fromIntegral @Word64 @Int conId) expected - where - g :: Maybe (Maybe Name) -> Either IncoherentDeclReason (Maybe (Maybe Name)) - g = \case - Nothing -> error "didnt put expected constructor id" - Just Nothing -> Right (Just (Just (fullName name))) - Just (Just firstName) -> - Left (IncoherentDeclReason'ConstructorAlias firstName (fullName name)) + Nothing -> Left (IncoherentDeclReason'StrayConstructor name1) + Just (typeName, expected) -> + case recordConstructorName conId name1 expected of + Left existingName -> Left (IncoherentDeclReason'ConstructorAlias existingName name1) + Right expected1 -> Right (typeName, expected1) + where + name1 = fullName name childrenWeWentInto <- forMaybe (Map.toList defns.types) \case @@ -174,15 +173,15 @@ checkDeclCoherency loadDeclNumConstructors = DeclCoherencyCheckState {expectedConstructors} <- State.get whatHappened <- do let recordNewDecl :: - Maybe (Name, IntMap (Maybe Name)) -> - Compose (ExceptT IncoherentDeclReason m) WhatHappened (Name, IntMap (Maybe Name)) + Maybe (Name, ConstructorNames) -> + Compose (ExceptT IncoherentDeclReason m) WhatHappened (Name, ConstructorNames) recordNewDecl = Compose . \case Just (shorterTypeName, _) -> Except.throwError (IncoherentDeclReason'NestedDeclAlias shorterTypeName typeName) Nothing -> lift (loadDeclNumConstructors typeRef) <&> \case 0 -> UninhabitedDecl - n -> InhabitedDecl (typeName, IntMap.fromAscList [(i, Nothing) | i <- [0 .. n - 1]]) + n -> InhabitedDecl (typeName, emptyConstructorNames n) lift (getCompose (Map.upsertF recordNewDecl typeRef expectedConstructors)) case whatHappened of UninhabitedDecl -> do @@ -238,28 +237,18 @@ lenientCheckDeclCoherency loadDeclNumConstructors = (_, Referent.Ref _) -> pure () (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure () (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do - #expectedConstructors %= Map.adjust (Map.map f) typeRef - where - f :: IntMap (Maybe Name) -> IntMap (Maybe Name) - f = - IntMap.adjust g (fromIntegral @Word64 @Int conId) - where - g :: Maybe Name -> Maybe Name - g = \case - Nothing -> Just (fullName name) - -- Ignore constructor alias, just keep first name we found - Just firstName -> Just firstName + #expectedConstructors %= Map.adjust (Map.map (lenientRecordConstructorName conId (fullName name))) typeRef childrenWeWentInto <- forMaybe (Map.toList defns.types) \case (_, ReferenceBuiltin _) -> pure Nothing (name, ReferenceDerived typeRef) -> do whatHappened <- do - let recordNewDecl :: m (WhatHappened (Map Name (IntMap (Maybe Name)))) + let recordNewDecl :: m (WhatHappened (Map Name ConstructorNames)) recordNewDecl = loadDeclNumConstructors typeRef <&> \case 0 -> UninhabitedDecl - n -> InhabitedDecl (Map.singleton typeName (IntMap.fromAscList [(i, Nothing) | i <- [0 .. n - 1]])) + n -> InhabitedDecl (Map.singleton typeName (emptyConstructorNames n)) state <- State.get lift (getCompose (Map.upsertF (\_ -> Compose recordNewDecl) typeRef state.expectedConstructors)) case whatHappened of @@ -275,8 +264,8 @@ lenientCheckDeclCoherency loadDeclNumConstructors = Map.alterF f typeRef state.expectedConstructors where f :: - Maybe (Map Name (IntMap (Maybe Name))) -> - (IntMap (Maybe Name), Maybe (Map Name (IntMap (Maybe Name)))) + Maybe (Map Name ConstructorNames) -> + (ConstructorNames, Maybe (Map Name ConstructorNames)) f = -- fromJust is safe here because we upserted `typeRef` key above -- deleteLookupJust is safe here because we upserted `typeName` key above @@ -296,17 +285,48 @@ lenientCheckDeclCoherency loadDeclNumConstructors = Name.fromReverseSegments (name :| prefix) data DeclCoherencyCheckState = DeclCoherencyCheckState - { expectedConstructors :: !(Map TypeReferenceId (Name, IntMap (Maybe Name))), + { expectedConstructors :: !(Map TypeReferenceId (Name, ConstructorNames)), declNameLookup :: !DeclNameLookup } deriving stock (Generic) data LenientDeclCoherencyCheckState = LenientDeclCoherencyCheckState - { expectedConstructors :: !(Map TypeReferenceId (Map Name (IntMap (Maybe Name)))), + { expectedConstructors :: !(Map TypeReferenceId (Map Name ConstructorNames)), declToConstructors :: !(Map Name [Maybe Name]) } deriving stock (Generic) +-- A partial mapping from constructor id to name; a collection of constructor names starts out with the correct number +-- of keys (per the number of data constructors) all mapped to Nothing. Then, as names are discovered by walking a +-- name tree, Nothings become Justs. +type ConstructorNames = + IntMap (Maybe Name) + +-- Make an empty set of constructor names given the number of constructors. +emptyConstructorNames :: Int -> ConstructorNames +emptyConstructorNames numConstructors = + IntMap.fromAscList [(i, Nothing) | i <- [0 .. numConstructors - 1]] + +recordConstructorName :: HasCallStack => ConstructorId -> Name -> ConstructorNames -> Either Name ConstructorNames +recordConstructorName conId conName = + IntMap.alterF f (fromIntegral @Word64 @Int conId) + where + f :: Maybe (Maybe Name) -> Either Name (Maybe (Maybe Name)) + f = \case + Nothing -> error (reportBug "E397219" ("recordConstructorName: didn't expect constructor id " ++ show conId)) + Just Nothing -> Right (Just (Just conName)) + Just (Just existingName) -> Left existingName + +lenientRecordConstructorName :: ConstructorId -> Name -> ConstructorNames -> ConstructorNames +lenientRecordConstructorName conId conName = + IntMap.adjust f (fromIntegral @Word64 @Int conId) + where + f :: Maybe Name -> Maybe Name + f = \case + Nothing -> Just conName + -- Ignore constructor alias, just keep first name we found + Just existingName -> Just existingName + data WhatHappened a = UninhabitedDecl | InhabitedDecl !a From 32cde2cd35976029e4c548edcd08becbd48c6601 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 29 May 2024 12:41:59 -0400 Subject: [PATCH 038/631] relax merge preconditions on lca --- .../Codebase/Editor/HandleInput/Merge2.hs | 50 +++---- .../src/Unison/Codebase/Editor/Output.hs | 8 +- .../src/Unison/CommandLine/OutputMessages.hs | 24 ++-- unison-core/src/Unison/DataDeclaration.hs | 17 ++- .../src/Unison/Merge/DeclCoherencyCheck.hs | 6 + .../src/Unison/Merge/DeclNameLookup.hs | 30 ---- unison-merge/src/Unison/Merge/Diff.hs | 58 ++++++-- unison-merge/src/Unison/Merge/Synhash.hs | 50 +++---- unison-src/transcripts/merge.md | 67 +++++++++ unison-src/transcripts/merge.output.md | 136 ++++++++++++++++++ 10 files changed, 327 insertions(+), 119 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index d6685f1059..d492d46500 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -43,7 +43,7 @@ import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Builtin.Decls qualified as Builtin.Decls -import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceOrTarget (..), MergeSourceAndTarget (..)) +import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceAndTarget (..), MergeSourceOrTarget (..)) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli @@ -76,7 +76,7 @@ import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' import Unison.Merge.CombineDiffs (CombinedDiffOp (..), combineDiffs) import Unison.Merge.Database (MergeDatabase (..), makeMergeDatabase, referent2to1) -import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason (..), checkDeclCoherency) +import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason (..), checkDeclCoherency, lenientCheckDeclCoherency) import Unison.Merge.DeclNameLookup (DeclNameLookup (..), expectConstructorNames) import Unison.Merge.Diff qualified as Merge import Unison.Merge.DiffOp (DiffOp (..)) @@ -220,7 +220,7 @@ doMerge info = do let aliceBranchNames = ProjectAndBranch info.alice.project.name info.alice.projectBranch.name let mergeSource = MergeSourceOrTarget'Source info.bob.source let mergeTarget = MergeSourceOrTarget'Target aliceBranchNames - let mergeSourceAndTarget = MergeSourceAndTarget { alice = aliceBranchNames, bob = info.bob.source } + let mergeSourceAndTarget = MergeSourceAndTarget {alice = aliceBranchNames, bob = info.bob.source} Cli.Env {codebase} <- ask @@ -267,19 +267,17 @@ doMerge info = do Cli.returnEarly (Output.MergeDefnsInLib who) -- Load Alice/Bob/LCA definitions and decl name lookups - (defns3, declNameLookups3) <- do + (defns3, declNameLookups, lcaDeclToConstructors) <- do + let emptyNametree = Nametree {value = Defns Map.empty Map.empty, children = Map.empty} + let loadDefns branch = + Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) & onLeftM \conflictedName -> + Cli.returnEarly case conflictedName of + ConflictedName'Term name refs -> Output.MergeConflictedTermName name refs + ConflictedName'Type name refs -> Output.MergeConflictedTypeName name refs let load = \case - Nothing -> - pure - ( Nametree {value = Defns Map.empty Map.empty, children = Map.empty}, - DeclNameLookup Map.empty Map.empty - ) + Nothing -> pure (emptyNametree, DeclNameLookup Map.empty Map.empty) Just (who, branch) -> do - defns <- - Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) & onLeftM \conflictedName -> - Cli.returnEarly case conflictedName of - ConflictedName'Term name refs -> Output.MergeConflictedTermName name refs - ConflictedName'Type name refs -> Output.MergeConflictedTypeName name refs + defns <- loadDefns branch declNameLookup <- Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) & onLeftM \err -> Cli.returnEarly case err of @@ -291,23 +289,23 @@ doMerge info = do IncoherentDeclReason'StrayConstructor name -> Output.MergeStrayConstructor who name pure (defns, declNameLookup) - (aliceDefns0, aliceDeclNameLookup) <- load (Just (Just mergeTarget, branches.alice)) - (bobDefns0, bobDeclNameLookup) <- load (Just (Just mergeSource, branches.bob)) - (lcaDefns0, lcaDeclNameLookup) <- load ((Nothing,) <$> branches.lca) + (aliceDefns0, aliceDeclNameLookup) <- load (Just (mergeTarget, branches.alice)) + (bobDefns0, bobDeclNameLookup) <- load (Just (mergeSource, branches.bob)) + lcaDefns0 <- maybe (pure emptyNametree) loadDefns branches.lca + lcaDeclToConstructors <- Cli.runTransaction (lenientCheckDeclCoherency db.loadDeclNumConstructors lcaDefns0) let flatten defns = Defns (flattenNametree (view #terms) defns) (flattenNametree (view #types) defns) let defns3 = flatten <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} - let declNameLookups3 = ThreeWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup, lca = lcaDeclNameLookup} + let declNameLookups = TwoWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup} - pure (defns3, declNameLookups3) + pure (defns3, declNameLookups, lcaDeclToConstructors) let defns = ThreeWay.forgetLca defns3 - let declNameLookups = ThreeWay.forgetLca declNameLookups3 - liftIO (debugFunctions.debugDefns defns3 declNameLookups3) + liftIO (debugFunctions.debugDefns defns3 declNameLookups lcaDeclToConstructors) -- Diff LCA->Alice and LCA->Bob - diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups3 defns3) + diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups lcaDeclToConstructors defns3) liftIO (debugFunctions.debugDiffs diffs) @@ -1032,7 +1030,8 @@ data DebugFunctions = DebugFunctions { debugCausals :: TwoOrThreeWay (V2.CausalBranch Transaction) -> IO (), debugDefns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - ThreeWay DeclNameLookup -> + TwoWay DeclNameLookup -> + Map Name [Maybe Name] -> IO (), debugDiffs :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) -> IO (), debugCombinedDiff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> IO (), @@ -1073,9 +1072,10 @@ realDebugCausals causals = do realDebugDefns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - ThreeWay DeclNameLookup -> + TwoWay DeclNameLookup -> + Map Name [Maybe Name] -> IO () -realDebugDefns defns declNameLookups = do +realDebugDefns defns declNameLookups _lcaDeclNameLookup = do Text.putStrLn (Text.bold "\n=== Alice definitions ===") debugDefns1 (bimap BiMultimap.range BiMultimap.range defns.alice) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 421f39121c..dd333effd3 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -395,11 +395,11 @@ data Output | MergeConflictedTermName !Name !(NESet Referent) | MergeConflictedTypeName !Name !(NESet TypeReference) | MergeConflictInvolvingBuiltin !Name - | MergeConstructorAlias !(Maybe MergeSourceOrTarget) !Name !Name + | MergeConstructorAlias !MergeSourceOrTarget !Name !Name | MergeDefnsInLib !MergeSourceOrTarget - | MergeMissingConstructorName !(Maybe MergeSourceOrTarget) !Name - | MergeNestedDeclAlias !(Maybe MergeSourceOrTarget) !Name !Name - | MergeStrayConstructor !(Maybe MergeSourceOrTarget) !Name + | MergeMissingConstructorName !MergeSourceOrTarget !Name + | MergeNestedDeclAlias !MergeSourceOrTarget !Name !Name + | MergeStrayConstructor !MergeSourceOrTarget !Name | InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment data UpdateOrUpgrade = UOUUpdate | UOUUpgrade diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index a56b7faab4..e75b8b65e5 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1488,12 +1488,10 @@ notifyUser dir = \case "There's a merge conflict on" <> P.group (prettyName name <> ",") <> "but it's a builtin on one or both branches. We can't yet handle merge conflicts on builtins." - MergeConstructorAlias maybeAliceOrBob name1 name2 -> + MergeConstructorAlias aliceOrBob name1 name2 -> pure . P.wrap $ "On" - <> case maybeAliceOrBob of - Nothing -> "the LCA," - Just aliceOrBob -> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") <> prettyName name1 <> "and" <> prettyName name2 @@ -1504,32 +1502,26 @@ notifyUser dir = \case <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") <> "there's a type or term directly in the `lib` namespace, but I expected only library dependencies to be in there." <> "Please remove it before merging." - MergeMissingConstructorName maybeAliceOrBob name -> + MergeMissingConstructorName aliceOrBob name -> pure . P.wrap $ "On" - <> case maybeAliceOrBob of - Nothing -> "the LCA," - Just aliceOrBob -> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") <> "the type" <> prettyName name <> "is missing a name for one of its constructors. Please add one before merging." - MergeNestedDeclAlias maybeAliceOrBob shorterName longerName -> + MergeNestedDeclAlias aliceOrBob shorterName longerName -> pure . P.wrap $ "On" - <> case maybeAliceOrBob of - Nothing -> "the LCA," - Just aliceOrBob -> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") <> "the type" <> prettyName longerName <> "is an alias of" <> P.group (prettyName shorterName <> ".") <> "Type aliases cannot be nested. Please make them disjoint before merging." - MergeStrayConstructor maybeAliceOrBob name -> + MergeStrayConstructor aliceOrBob name -> pure . P.wrap $ "On" - <> case maybeAliceOrBob of - Nothing -> "the LCA," - Just aliceOrBob -> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") <> "the constructor" <> prettyName name <> "is not in a subnamespace of a name of its type." diff --git a/unison-core/src/Unison/DataDeclaration.hs b/unison-core/src/Unison/DataDeclaration.hs index 9467880ca2..e06f715123 100644 --- a/unison-core/src/Unison/DataDeclaration.hs +++ b/unison-core/src/Unison/DataDeclaration.hs @@ -33,10 +33,11 @@ module Unison.DataDeclaration constructors_, asDataDecl_, declAsDataDecl_, + setConstructorNames, ) where -import Control.Lens (Iso', Lens', imap, iso, lens, over, _3) +import Control.Lens (Iso', Lens', imap, iso, lens, over, set, _2, _3) import Control.Monad.State (evalState) import Data.Map qualified as Map import Data.Set qualified as Set @@ -164,6 +165,20 @@ constructorVars dd = fst <$> constructors dd constructorNames :: (Var v) => DataDeclaration v a -> [Text] constructorNames dd = Var.name <$> constructorVars dd +-- | Overwrite the constructor names with the given list, given in canonical order, which is assumed to be of the +-- correct length. +-- +-- Presumably this is called because the decl was loaded from the database outside of the context of a namespace, +-- since it's not stored with names there, so we had plugged in dummy names like "Constructor1", "Constructor2", ... +-- +-- Then, at some point, we discover the constructors' names in a namespace, and now we'd like to combine the two +-- together to get a Decl structure in memory with good/correct names for constructors. +setConstructorNames :: [v] -> Decl v a -> Decl v a +setConstructorNames constructorNames = + over + (declAsDataDecl_ . constructors_) + (zipWith (set _2) constructorNames) + -- This function is unsound, since the `rid` and the `decl` have to match. -- It should probably be hashed directly from the Decl, once we have a -- reliable way of doing that. —AI diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 82cff729f3..b62b9f44dc 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -217,6 +217,12 @@ checkDeclCoherency loadDeclNumConstructors = fullName name = Name.fromReverseSegments (name :| prefix) +-- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns a mapping from decl name to +-- constructor names, where constructor names can be missing. +-- +-- This function exists merely to extract a best-effort decl-name-to-constructor-name mapping for the LCA of a merge. +-- We require Alice and Bob to have coherent decls, but their LCA is out of the user's control and may have incoherent +-- decls, and whether or not it does, we still need to compute *some* syntactic hash for its decls. lenientCheckDeclCoherency :: forall m. Monad m => diff --git a/unison-merge/src/Unison/Merge/DeclNameLookup.hs b/unison-merge/src/Unison/Merge/DeclNameLookup.hs index 9fa85b99d9..08611a944c 100644 --- a/unison-merge/src/Unison/Merge/DeclNameLookup.hs +++ b/unison-merge/src/Unison/Merge/DeclNameLookup.hs @@ -2,24 +2,13 @@ module Unison.Merge.DeclNameLookup ( DeclNameLookup (..), expectDeclName, expectConstructorNames, - setConstructorNames, ) where -import Control.Lens (over) import Data.Map.Strict qualified as Map import Data.Semigroup.Generic (GenericSemigroupMonoid (..)) -import Unison.DataDeclaration (Decl) -import Unison.DataDeclaration qualified as DataDeclaration import Unison.Name (Name) -import Unison.NameSegment (NameSegment) import Unison.Prelude -import Unison.Reference (TypeReference) -import Unison.Referent (Referent) -import Unison.Syntax.Name qualified as Name -import Unison.Util.Defns (Defns (..), DefnsF) -import Unison.Util.Nametree (Nametree (..)) -import Unison.Var (Var) -- | A lookup from decl-to-constructor name and vice-versa. -- @@ -62,22 +51,3 @@ expectConstructorNames DeclNameLookup {declToConstructors} x = case Map.lookup x declToConstructors of Nothing -> error (reportBug "E077058" ("Expected decl name key " <> show x <> " in decl name lookup")) Just y -> y - --- | Set the constructor names of a data declaration. --- --- Presumably this is used because the decl was loaded from the database outside of the context of a namespace, because --- it's not stored with names there, so we plugged in dummy names like "Constructor1", "Constructor2", ... --- --- Then, at some point, a `DeclNameLookup` was constructed for the corresponding namespace, and now we'd like to --- combine the two together to get a Decl structure in memory with good/correct names for constructors. -setConstructorNames :: forall a v. Var v => DeclNameLookup -> Name -> Decl v a -> Decl v a -setConstructorNames declNameLookup name = - case Map.lookup name declNameLookup.declToConstructors of - Nothing -> id - Just constructorNames -> - over - (DataDeclaration.declAsDataDecl_ . DataDeclaration.constructors_) - ( zipWith - (\realConName (ann, _junkConName, typ) -> (ann, Name.toVar realConName, typ)) - constructorNames - ) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index f361c77b24..754b36be78 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -9,23 +9,30 @@ import Data.Semialign (alignWith) import Data.Set qualified as Set import Data.These (These (..)) import U.Codebase.Reference (TypeReference) -import Unison.Hash (Hash) +import Unison.DataDeclaration (Decl) +import Unison.DataDeclaration qualified as DataDeclaration +import Unison.Hash (Hash (Hash)) import Unison.HashQualified' qualified as HQ' import Unison.Merge.Database (MergeDatabase (..)) import Unison.Merge.DeclNameLookup (DeclNameLookup) import Unison.Merge.DeclNameLookup qualified as DeclNameLookup import Unison.Merge.DiffOp (DiffOp (..)) -import Unison.Merge.Synhash qualified as Synhash +import Unison.Merge.Synhash import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.ThreeWay (ThreeWay (..)) +import Unison.Merge.ThreeWay qualified as ThreeWay import Unison.Merge.TwoWay (TwoWay (..)) import Unison.Merge.Updated (Updated (..)) import Unison.Name (Name) +import Unison.Parser.Ann (Ann) import Unison.Prelude hiding (catMaybes) import Unison.PrettyPrintEnv (PrettyPrintEnv (..)) import Unison.PrettyPrintEnv qualified as Ppe +import Unison.Reference (Reference' (..), TypeReferenceId) import Unison.Referent (Referent) import Unison.Sqlite (Transaction) +import Unison.Symbol (Symbol) +import Unison.Syntax.Name qualified as Name import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith) @@ -40,12 +47,29 @@ import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith) -- branches. If the hash of a name did not change, it will not appear in the map. nameBasedNamespaceDiff :: MergeDatabase -> - ThreeWay DeclNameLookup -> + TwoWay DeclNameLookup -> + Map Name [Maybe Name] -> ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> Transaction (TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)) -nameBasedNamespaceDiff db declNameLookups defns = do - diffs <- sequence (synhashDefns <$> declNameLookups <*> defns) - pure (diffNamespaceDefns diffs.lca <$> TwoWay {alice = diffs.alice, bob = diffs.bob}) +nameBasedNamespaceDiff db declNameLookups lcaDeclToConstructors defns = do + lcaHashes <- + synhashDefnsWith + hashTerm + ( \name -> \case + ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) + ReferenceDerived ref -> + case sequence (lcaDeclToConstructors Map.! name) of + -- If we don't have a name for every constructor, that's okay, just use a dummy syntactic hash here. + -- This is safe; Alice/Bob can't have such a decl (it violates a merge precondition), so there's no risk + -- that we accidentally get an equal hash and classify a real update as unchanged. + Nothing -> pure (Hash mempty) + Just names -> do + decl <- loadDeclWithGoodConstructorNames names ref + pure (synhashDerivedDecl ppe name decl) + ) + defns.lca + hashes <- sequence (synhashDefns <$> declNameLookups <*> ThreeWay.forgetLca defns) + pure (diffNamespaceDefns lcaHashes <$> hashes) where synhashDefns :: DeclNameLookup -> @@ -55,16 +79,20 @@ nameBasedNamespaceDiff db declNameLookups defns = do -- FIXME: use cache so we only synhash each thing once synhashDefnsWith hashTerm hashType where - hashTerm :: Referent -> Transaction Hash - hashTerm = - Synhash.hashTerm db.loadV1Term ppe - hashType :: Name -> TypeReference -> Transaction Hash - hashType name = - Synhash.hashDecl - (fmap (DeclNameLookup.setConstructorNames declNameLookup name) . db.loadV1Decl) - ppe - name + hashType name = \case + ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) + ReferenceDerived ref -> do + decl <- loadDeclWithGoodConstructorNames (DeclNameLookup.expectConstructorNames declNameLookup name) ref + pure (synhashDerivedDecl ppe name decl) + + loadDeclWithGoodConstructorNames :: [Name] -> TypeReferenceId -> Transaction (Decl Symbol Ann) + loadDeclWithGoodConstructorNames names = + fmap (DataDeclaration.setConstructorNames (map Name.toVar names)) . db.loadV1Decl + + hashTerm :: Referent -> Transaction Hash + hashTerm = + synhashTerm db.loadV1Term ppe ppe :: PrettyPrintEnv ppe = diff --git a/unison-merge/src/Unison/Merge/Synhash.hs b/unison-merge/src/Unison/Merge/Synhash.hs index 56c69d4591..29559690bf 100644 --- a/unison-merge/src/Unison/Merge/Synhash.hs +++ b/unison-merge/src/Unison/Merge/Synhash.hs @@ -24,9 +24,10 @@ -- "foo" would have the same syntactic hash. This indicates (to our merge algorithm) that this was an auto-propagated -- update. module Unison.Merge.Synhash - ( hashType, - hashTerm, - hashDecl, + ( synhashType, + synhashTerm, + synhashBuiltinDecl, + synhashDerivedDecl, ) where @@ -72,8 +73,8 @@ isDeclTag, isTermTag :: H.Token Hash isDeclTag = H.Tag 0 isTermTag = H.Tag 1 -hashBuiltinDecl :: Text -> Hash -hashBuiltinDecl name = +synhashBuiltinDecl :: Text -> Hash +synhashBuiltinDecl name = H.accumulate [isBuiltinTag, isDeclTag, H.Text name] hashBuiltinTerm :: Text -> Hash @@ -104,23 +105,6 @@ hashConstructorNameToken declName conName = ) in H.Text (Name.toText strippedConName) --- | Syntactically hash a decl, using reference names rather than hashes. Two decls will have the same syntactic hash if --- they they are the same sort of decl (both are data decls or both are effect decls), the unique type guid is the same, --- the constructors appear in the same order and have the same names, and the constructors' types have the same --- syntactic hashes. -hashDecl :: - (Monad m, Var v) => - (TypeReferenceId -> m (Decl v a)) -> - PrettyPrintEnv -> - Name -> - TypeReference -> - m Hash -hashDecl loadDecl ppe name = \case - ReferenceBuiltin builtin -> pure (hashBuiltinDecl builtin) - ReferenceDerived ref -> do - decl <- loadDecl ref - pure (hashDerivedDecl ppe name decl) - hashDerivedTerm :: Var v => PrettyPrintEnv -> Term v a -> Hash hashDerivedTerm ppe t = H.accumulate $ isNotBuiltinTag : hashTermTokens ppe t @@ -148,8 +132,12 @@ hashDeclTokens :: Var v => PrettyPrintEnv -> Name -> Decl v a -> [Token] hashDeclTokens ppe name decl = hashConstructorType (DD.constructorType decl) : hashDataDeclTokens ppe name (DD.asDataDecl decl) -hashDerivedDecl :: Var v => PrettyPrintEnv -> Name -> Decl v a -> Hash -hashDerivedDecl ppe name decl = +-- | Syntactically hash a decl, using reference names rather than hashes. Two decls will have the same syntactic hash if +-- they they are the same sort of decl (both are data decls or both are effect decls), the unique type guid is the same, +-- the constructors appear in the same order and have the same names, and the constructors' types have the same +-- syntactic hashes. +synhashDerivedDecl :: Var v => PrettyPrintEnv -> Name -> Decl v a -> Hash +synhashDerivedDecl ppe name decl = H.accumulate $ isNotBuiltinTag : hashDeclTokens ppe name decl hashHQNameToken :: HashQualified Name -> Token @@ -218,8 +206,14 @@ hashReferentTokens ppe referent = -- | Syntactically hash a term, using reference names rather than hashes. -- Two terms will have the same syntactic hash if they would -- print the the same way under the given pretty-print env. -hashTerm :: forall m v a. (Monad m, Var v) => (TypeReferenceId -> m (Term v a)) -> PrettyPrintEnv -> V1.Referent -> m Hash -hashTerm loadTerm ppe = \case +synhashTerm :: + forall m v a. + (Monad m, Var v) => + (TypeReferenceId -> m (Term v a)) -> + PrettyPrintEnv -> + V1.Referent -> + m Hash +synhashTerm loadTerm ppe = \case V1.Referent.Con ref CT.Data -> pure (hashDerivedTerm ppe (Term.constructor @v () ref)) V1.Referent.Con ref CT.Effect -> pure (hashDerivedTerm ppe (Term.request @v () ref)) V1.Referent.Ref (ReferenceBuiltin builtin) -> pure (hashBuiltinTerm builtin) @@ -269,8 +263,8 @@ hashTermFTokens ppe = \case -- | Syntactically hash a type, using reference names rather than hashes. -- Two types will have the same syntactic hash if they would -- print the the same way under the given pretty-print env. -hashType :: Var v => PrettyPrintEnv -> Type v a -> Hash -hashType ppe t = +synhashType :: Var v => PrettyPrintEnv -> Type v a -> Hash +synhashType ppe t = H.accumulate $ hashTypeTokens ppe t hashTypeTokens :: forall v a. Var v => PrettyPrintEnv -> Type v a -> [Token] diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index d74605f1cb..e6475de63d 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -1300,3 +1300,70 @@ project/alice> merge /bob ```ucm:hide .> project.delete project ``` + +## LCA precondition violations + +The LCA is not subject to most precondition violations, which is good, because the user can't easily manipulate it! + +Here's an example. We'll delete a constructor name from the LCA and still be able to merge Alice and Bob's stuff +together. + +```ucm:hide +.> project.create-empty project +project/main> builtins.mergeio +``` + +LCA: + +```unison +structural type Foo = Bar Nat | Baz Nat Nat +``` + +```ucm +project/main> add +project/main> delete.term Foo.Baz +``` + +Alice's branch: + +```ucm +project/main> branch alice +project/alice> delete.type Foo +project/alice> delete.term Foo.Bar +``` + +```unison +alice : Nat +alice = 100 +``` + +```ucm +project/alice> add +``` + +Bob's branch: + +```ucm +project/main> branch bob +project/bob> delete.type Foo +project/bob> delete.term Foo.Bar +``` + +```unison +bob : Nat +bob = 101 +``` + +```ucm +project/bob> add +``` + +Now we merge: + +```ucm +project/alice> merge /bob +``` + +```ucm:hide +.> project.delete project +``` diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 6b50339eec..ba3ab0d031 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1144,3 +1144,139 @@ project/alice> merge /bob there. Please remove it before merging. ``` +## LCA precondition violations + +The LCA is not subject to most precondition violations, which is good, because the user can't easily manipulate it! + +Here's an example. We'll delete a constructor name from the LCA and still be able to merge Alice and Bob's stuff +together. + +LCA: + +```unison +structural type Foo = Bar Nat | Baz Nat Nat +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + structural type Foo + +``` +```ucm +project/main> add + + ⍟ I've added these definitions: + + structural type Foo + +project/main> delete.term Foo.Baz + + Done. + +``` +Alice's branch: + +```ucm +project/main> branch alice + + Done. I've created the alice branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /alice`. + +project/alice> delete.type Foo + + Done. + +project/alice> delete.term Foo.Bar + + Done. + +``` +```unison +alice : Nat +alice = 100 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + alice : Nat + +``` +```ucm +project/alice> add + + ⍟ I've added these definitions: + + alice : Nat + +``` +Bob's branch: + +```ucm +project/main> branch bob + + Done. I've created the bob branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /bob`. + +project/bob> delete.type Foo + + Done. + +project/bob> delete.term Foo.Bar + + Done. + +``` +```unison +bob : Nat +bob = 101 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bob : Nat + +``` +```ucm +project/bob> add + + ⍟ I've added these definitions: + + bob : Nat + +``` +Now we merge: + +```ucm +project/alice> merge /bob + + I merged project/bob into project/alice. + +``` From 7d7047967a127ec9888105058850559d57afb0bc Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 24 May 2024 22:20:53 -0600 Subject: [PATCH 039/631] Add a transcript to replicate #3939 --- unison-src/transcripts-using-base/fix3939.md | 12 ++++ .../transcripts-using-base/fix3939.output.md | 56 +++++++++++++++++++ 2 files changed, 68 insertions(+) create mode 100644 unison-src/transcripts-using-base/fix3939.md create mode 100644 unison-src/transcripts-using-base/fix3939.output.md diff --git a/unison-src/transcripts-using-base/fix3939.md b/unison-src/transcripts-using-base/fix3939.md new file mode 100644 index 0000000000..7ec695e6c7 --- /dev/null +++ b/unison-src/transcripts-using-base/fix3939.md @@ -0,0 +1,12 @@ +```unison +{{ +A simple doc. +}} +meh = 9 +``` + +```ucm +.> add +.> find meh +.> docs 1 +``` diff --git a/unison-src/transcripts-using-base/fix3939.output.md b/unison-src/transcripts-using-base/fix3939.output.md new file mode 100644 index 0000000000..dd9cfe4a9f --- /dev/null +++ b/unison-src/transcripts-using-base/fix3939.output.md @@ -0,0 +1,56 @@ +```unison +{{ +A simple doc. +}} +meh = 9 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + meh : Nat + meh.doc : Doc2 + +``` +```ucm +.> add + + ⍟ I've added these definitions: + + meh : Nat + meh.doc : Doc2 + +.> find meh + + 1. meh : Nat + 2. meh.doc : Doc2 + + +.> docs 1 + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + meh.doc#3n6of1k7qmgib9jda9ov1obetubfmladketn40gqifp4pfdea8it6ofa920l1topi2pd32vlsbfu3q41fkbt8coa38akg9eetto09j8 + +``` + + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + meh.doc#3n6of1k7qmgib9jda9ov1obetubfmladketn40gqifp4pfdea8it6ofa920l1topi2pd32vlsbfu3q41fkbt8coa38akg9eetto09j8 + From b985bb1728dd2bb5b22ba2cbef04e64bf77a1ebc Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 24 May 2024 23:07:47 -0600 Subject: [PATCH 040/631] Change `docs` command to expect `Name` Previously, when given a numbered arg, from some commands (e.g., `find`), it would fail to find the docs because the hash associated with the definition was applied to the `doc`, which then would be incorrect. This now discards hashes up-front, so it can add the `doc` suffix to the name. Fixes #3939. --- .../src/Unison/Codebase/Editor/HandleInput.hs | 10 ++-------- unison-cli/src/Unison/Codebase/Editor/Input.hs | 2 +- .../src/Unison/CommandLine/InputPatterns.hs | 2 +- .../transcripts-using-base/fix3939.output.md | 18 +----------------- 4 files changed, 5 insertions(+), 27 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index f5f06bde10..71185d49cd 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -1758,7 +1758,7 @@ displayI outputLoc hq = do let ns = UF.addNamesFromTypeCheckedUnisonFile unisonFile names doDisplay outputLoc ns tm -docsI :: Path.HQSplit' -> Cli () +docsI :: Name -> Cli () docsI src = do findInScratchfileByName where @@ -1766,14 +1766,8 @@ docsI src = do (fileByName) First check the file for `foo.doc`, and if found do `display foo.doc` (codebaseByName) Lastly check for `foo.doc` in the codebase and if found do `display foo.doc` -} - hq :: HQ.HashQualified Name - hq = - let hq' :: HQ'.HashQualified Name - hq' = Path.unsafeToName' <$> Name.convert src - in Name.convert hq' - dotDoc :: HQ.HashQualified Name - dotDoc = hq <&> \n -> Name.joinDot n (Name.fromSegment "doc") + dotDoc = Name.convert . Name.joinDot src $ Name.fromSegment "doc" findInScratchfileByName :: Cli () findInScratchfileByName = do diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 56acd83e92..b24401330e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -174,7 +174,7 @@ data Input | -- Display provided definitions. DisplayI OutputLocation (NonEmpty (HQ.HashQualified Name)) | -- Display docs for provided terms. - DocsI (NonEmpty Path.HQSplit') + DocsI (NonEmpty Name) | -- other FindI Bool FindScope [String] -- FindI isVerbose findScope query | FindShallowI Path' diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 9a5d0a364c..0fa6e436d2 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -992,7 +992,7 @@ docs = "`docs` without arguments invokes a search to select which definition to view documentation for, which requires that `fzf` can be found within your PATH." ] ) - $ maybe (Left $ I.help docs) (fmap Input.DocsI . traverse handleHashQualifiedSplit'Arg) . NE.nonEmpty + $ maybe (Left $ I.help docs) (fmap Input.DocsI . traverse handleNameArg) . NE.nonEmpty api :: InputPattern api = diff --git a/unison-src/transcripts-using-base/fix3939.output.md b/unison-src/transcripts-using-base/fix3939.output.md index dd9cfe4a9f..99197263c4 100644 --- a/unison-src/transcripts-using-base/fix3939.output.md +++ b/unison-src/transcripts-using-base/fix3939.output.md @@ -35,22 +35,6 @@ meh = 9 .> docs 1 - ⚠️ - - The following names were not found in the codebase. Check your spelling. - meh.doc#3n6of1k7qmgib9jda9ov1obetubfmladketn40gqifp4pfdea8it6ofa920l1topi2pd32vlsbfu3q41fkbt8coa38akg9eetto09j8 + A simple doc. ``` - - - -🛑 - -The transcript failed due to an error in the stanza above. The error is: - - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - meh.doc#3n6of1k7qmgib9jda9ov1obetubfmladketn40gqifp4pfdea8it6ofa920l1topi2pd32vlsbfu3q41fkbt8coa38akg9eetto09j8 - From 8b46f810845a14a063ec3f2db9873191d8d282b1 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 29 May 2024 09:46:49 -0600 Subject: [PATCH 041/631] Replicate failure from #4898 --- unison-src/transcripts/fix4898.md | 17 +++++++ unison-src/transcripts/fix4898.output.md | 58 ++++++++++++++++++++++++ 2 files changed, 75 insertions(+) create mode 100644 unison-src/transcripts/fix4898.md create mode 100644 unison-src/transcripts/fix4898.output.md diff --git a/unison-src/transcripts/fix4898.md b/unison-src/transcripts/fix4898.md new file mode 100644 index 0000000000..9bc68041b2 --- /dev/null +++ b/unison-src/transcripts/fix4898.md @@ -0,0 +1,17 @@ +```ucm +.> builtins.merge +``` + +```unison +double : Int -> Int +double x = x + x + +redouble : Int -> Int +redouble x = double x + double x +``` + +```ucm +.> add +.> dependents double +.> delete.term 1 +``` diff --git a/unison-src/transcripts/fix4898.output.md b/unison-src/transcripts/fix4898.output.md new file mode 100644 index 0000000000..e52dc65533 --- /dev/null +++ b/unison-src/transcripts/fix4898.output.md @@ -0,0 +1,58 @@ +```ucm +.> builtins.merge + + Done. + +``` +```unison +double : Int -> Int +double x = x + x + +redouble : Int -> Int +redouble x = double x + double x +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + double : Int -> Int + redouble : Int -> Int + +``` +```ucm +.> add + + ⍟ I've added these definitions: + + double : Int -> Int + redouble : Int -> Int + +.> dependents double + + Dependents of: double + + Terms: + + 1. redouble + + Tip: Try `view 1` to see the source of any numbered item in + the above list. + +.> delete.term 1 + +``` + + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + +Expected a name, but the numbered arg resulted in #1gupumeruksjs4sb5mg8jcb891dmbufmqrfblfss1sevbl62fr7oud24mpo03jm2qlbdt6ntordsmfj1jovhfsp3mij461odaahfh2g, which is a reference. From 78816fdc3a3d2c328de3cf842345fb0329e11ef4 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 29 May 2024 10:31:04 -0600 Subject: [PATCH 042/631] Remove `Reference` from `StructuredArgument` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Almost everywhere we produce a `Reference` for numbered args, we also have a `HashQualified Name` handy, which is much more consumable by commands. The only case we don’t have an `HQ` is in the `todo` command output, so that now explicitly builds a `HQ.HashOnly`. This also fixes an issue with `StructuredArgument` handling where `alias.term` and `alias.type` wouldn’t make an alias to a `HQ.HashOnly` `StructuredArgument`. Fixes #4898. --- .../src/Unison/Codebase/Editor/HandleInput.hs | 23 +++++----- .../Editor/HandleInput/FindAndReplace.hs | 13 +++--- .../Codebase/Editor/StructuredArgument.hs | 2 - .../src/Unison/CommandLine/InputPatterns.hs | 43 ++++++++++--------- unison-cli/tests/Unison/Test/Cli/Monad.hs | 8 ++-- unison-src/transcripts/fix4898.output.md | 10 +---- 6 files changed, 47 insertions(+), 52 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index f5f06bde10..f787ab22d4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -1285,12 +1285,10 @@ handleDependencies hq = do let types = [(PPE.typeName suffixifiedPPE r, r) | LabeledDependency.TypeReference r <- toList dependencies] let terms = [(PPE.termName suffixifiedPPE r, r) | LabeledDependency.TermReferent r <- toList dependencies] pure (types, terms) - let types = nubOrdOn snd . Name.sortByText (HQ.toText . fst) $ (join $ fst <$> results) - let terms = nubOrdOn snd . Name.sortByText (HQ.toText . fst) $ (join $ snd <$> results) - Cli.setNumberedArgs $ - map (SA.Ref . snd) types - <> map (SA.Ref . Referent.toReference . snd) terms - Cli.respond $ ListDependencies suffixifiedPPE lds (fst <$> types) (fst <$> terms) + let types = fmap fst . nubOrdOn snd . Name.sortByText (HQ.toText . fst) . join $ fst <$> results + let terms = fmap fst . nubOrdOn snd . Name.sortByText (HQ.toText . fst) . join $ snd <$> results + Cli.setNumberedArgs . map SA.HashQualified $ types <> terms + Cli.respond $ ListDependencies suffixifiedPPE lds types terms handleDependents :: HQ.HashQualified Name -> Cli () handleDependents hq = do @@ -1307,7 +1305,7 @@ handleDependents hq = do results <- for (toList lds) \ld -> do -- The full set of dependent references, any number of which may not have names in the current namespace. dependents <- - let tp r = Codebase.dependents Queries.ExcludeOwnComponent r + let tp = Codebase.dependents Queries.ExcludeOwnComponent tm = \case Referent.Ref r -> Codebase.dependents Queries.ExcludeOwnComponent r Referent.Con (ConstructorReference r _cid) _ct -> @@ -1323,11 +1321,11 @@ handleDependents hq = do Just shortName <- pure $ PPE.terms ppe (Referent.Ref r) <|> PPE.types ppe r pure (isTerm, HQ'.toHQ shortName, r) pure results - let sort = nubOrdOn snd . Name.sortByText (HQ.toText . fst) + let sort = fmap fst . nubOrdOn snd . Name.sortByText (HQ.toText . fst) let types = sort [(n, r) | (False, n, r) <- join results] let terms = sort [(n, r) | (True, n, r) <- join results] - Cli.setNumberedArgs . map (SA.Ref . view _2) $ types <> terms - Cli.respond (ListDependents ppe lds (fst <$> types) (fst <$> terms)) + Cli.setNumberedArgs . map SA.HashQualified $ types <> terms + Cli.respond (ListDependents ppe lds types terms) -- | Handle a @ShowDefinitionI@ input command, i.e. `view` or `edit`. handleShowDefinition :: OutputLocation -> ShowDefinitionScope -> NonEmpty (HQ.HashQualified Name) -> Cli () @@ -1439,8 +1437,9 @@ doShowTodoOutput patch scopePath = do if TO.noConflicts todo && TO.noEdits todo then Cli.respond NoConflictsOrEdits else do - Cli.setNumberedArgs - (SA.Ref . view _2 <$> fst (TO.todoFrontierDependents todo)) + Cli.setNumberedArgs $ + SA.HashQualified . HQ.HashOnly . Reference.toShortHash . view _2 + <$> fst (TO.todoFrontierDependents todo) pped <- Cli.currentPrettyPrintEnvDecl Cli.respondNumbered $ TodoOutput pped todo diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs index f96ae85b21..45fb100a44 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs @@ -82,15 +82,14 @@ handleStructuredFindI rule = do Referent.Ref _ <- pure r Just shortName <- [PPE.terms (PPED.suffixifiedPPE ppe) r] pure (HQ'.toHQ shortName, r) - let ok t@(_, Referent.Ref (Reference.DerivedId r)) = do + let ok (hq, Referent.Ref (Reference.DerivedId r)) = do oe <- Cli.runTransaction (Codebase.getTerm codebase r) - pure $ (t, maybe False (\e -> any ($ e) rules) oe) - ok t = pure (t, False) + pure $ (hq, maybe False (\e -> any ($ e) rules) oe) + ok (hq, _) = pure (hq, False) results0 <- traverse ok results - let results = Alphabetical.sortAlphabeticallyOn fst [(hq, r) | ((hq, r), True) <- results0] - let toNumArgs = SA.Ref . Referent.toReference . view _2 - Cli.setNumberedArgs $ map toNumArgs results - Cli.respond (ListStructuredFind (fst <$> results)) + let results = Alphabetical.sortAlphabetically [hq | (hq, True) <- results0] + Cli.setNumberedArgs $ map SA.HashQualified results + Cli.respond (ListStructuredFind results) lookupRewrite :: (HQ.HashQualified Name -> Output) -> diff --git a/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs index 935d6ccd27..eda42c6107 100644 --- a/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs +++ b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs @@ -10,7 +10,6 @@ import Unison.HashQualified' qualified as HQ' import Unison.Name (Name) import Unison.Parser.Ann (Ann) import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName) -import Unison.Reference (Reference) import Unison.Server.Backend (ShallowListEntry) import Unison.Server.SearchResult (SearchResult) import Unison.Symbol (Symbol) @@ -22,7 +21,6 @@ data StructuredArgument | HashQualified (HQ.HashQualified Name) | Project ProjectName | ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - | Ref Reference | Namespace CausalHash | NameWithBranchPrefix AbsBranchId Name | HashQualifiedWithBranchPrefix AbsBranchId (HQ'.HashQualified Name) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 9a5d0a364c..777105dfb0 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -203,7 +203,6 @@ import Unison.Project branchWithOptionalProjectParser, ) import Unison.Project.Util (ProjectContext (..), projectContextFromPath) -import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.Server.Backend (ShallowListEntry (..)) import Unison.Server.Backend qualified as Backend @@ -227,8 +226,6 @@ formatStructuredArgument schLength = \case SA.Project projectName -> into @Text projectName SA.ProjectBranch (ProjectAndBranch mproj branch) -> maybe (Text.cons '/' . into @Text) (\project -> into @Text . ProjectAndBranch project) mproj branch - -- also: ShortHash.toText . Reference.toShortHash - SA.Ref reference -> Reference.toText reference -- also: ("#" <>) . Hash.toBase32HexText . unCausalHash SA.Namespace causalHash -> ("#" <>) . SCH.toText $ maybe SCH.fromFullHash SCH.fromHash schLength causalHash SA.NameWithBranchPrefix absBranchId name -> prefixBranchId absBranchId name @@ -291,17 +288,23 @@ unsupportedStructuredArgument :: Text -> I.Argument -> Either (P.Pretty CT.Color unsupportedStructuredArgument expected = either pure (const . Left . P.text $ "can’t use a numbered argument for " <> expected) -expectedButActually :: Text -> Text -> Text -> Text +expectedButActually :: Text -> StructuredArgument -> Text -> P.Pretty CT.ColorText expectedButActually expected actualValue actualType = - "Expected " <> expected <> ", but the numbered arg resulted in " <> actualValue <> ", which is " <> actualType <> "." + P.text $ + "Expected " + <> expected + <> ", but the numbered arg resulted in " + <> formatStructuredArgument Nothing actualValue + <> ", which is " + <> actualType + <> "." wrongStructuredArgument :: Text -> StructuredArgument -> P.Pretty CT.ColorText wrongStructuredArgument expected actual = - P.text $ expectedButActually + expectedButActually expected - (formatStructuredArgument Nothing actual) + actual case actual of - SA.Ref _ -> "a reference" SA.Name _ -> "a name" SA.AbsolutePath _ -> "an absolute path" SA.Namespace _ -> "a namespace" @@ -381,7 +384,6 @@ handleHashQualifiedNameArg = SA.Name name -> pure $ HQ.NameOnly name SA.NameWithBranchPrefix mprefix name -> pure . HQ.NameOnly $ foldr (\prefix -> Name.makeAbsolute . Path.prefixName prefix) name mprefix - SA.Ref ref -> pure . HQ.HashOnly $ Reference.toShortHash ref SA.HashQualified hqname -> pure hqname SA.HashQualifiedWithBranchPrefix mprefix hqname -> pure . HQ'.toHQ $ foldr (\prefix -> fmap $ Name.makeAbsolute . Path.prefixName prefix) hqname mprefix @@ -526,15 +528,15 @@ handleBranchRelativePathArg = pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg -hqNameToSplit' :: HQ.HashQualified Name -> Either (P.Pretty CT.ColorText) Path.HQSplit' +hqNameToSplit' :: HQ.HashQualified Name -> Either ShortHash Path.HQSplit' hqNameToSplit' = \case - HQ.HashOnly _ -> Left $ P.text "Only have a hash" + HQ.HashOnly hash -> Left hash HQ.NameOnly name -> pure . fmap HQ'.NameOnly $ Path.splitFromName' name HQ.HashQualified name hash -> pure . fmap (`HQ'.HashQualified` hash) $ Path.splitFromName' name -hqNameToSplit :: HQ.HashQualified Name -> Either (P.Pretty CT.ColorText) Path.HQSplit +hqNameToSplit :: HQ.HashQualified Name -> Either ShortHash Path.HQSplit hqNameToSplit = \case - HQ.HashOnly _ -> Left $ P.text "Only have a hash" + HQ.HashOnly hash -> Left hash HQ.NameOnly name -> pure . fmap HQ'.NameOnly $ Path.splitFromName name HQ.HashQualified name hash -> pure . fmap (`HQ'.HashQualified` hash) $ Path.splitFromName name @@ -553,11 +555,12 @@ handleHashQualifiedSplit'Arg = either (first P.text . Path.parseHQSplit') \case - SA.HashQualified name -> hqNameToSplit' name + hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit' name SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit' hqname SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . hq'NameToSplit' $ Name.makeAbsolute . Path.prefixName prefix <$> hqname - SA.SearchResult mpath result -> hqNameToSplit' $ searchResultToHQ mpath result + sr@(SA.SearchResult mpath result) -> + first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit' $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg handleHashQualifiedSplitArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.HQSplit @@ -565,11 +568,12 @@ handleHashQualifiedSplitArg = either (first P.text . Path.parseHQSplit) \case - SA.HashQualified name -> hqNameToSplit name + hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit name SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit hqname SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . hq'NameToSplit $ Name.makeAbsolute . Path.prefixName prefix <$> hqname - SA.SearchResult mpath result -> hqNameToSplit $ searchResultToHQ mpath result + sr@(SA.SearchResult mpath result) -> + first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg handleShortCausalHashArg :: I.Argument -> Either (P.Pretty CT.ColorText) ShortCausalHash @@ -586,12 +590,11 @@ handleShortHashOrHQSplit'Arg = either (first P.text . Path.parseShortHashOrHQSplit') \case - SA.Ref ref -> pure $ Left $ Reference.toShortHash ref - SA.HashQualified name -> pure <$> hqNameToSplit' name + SA.HashQualified name -> pure $ hqNameToSplit' name SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure . pure $ hq'NameToSplit' hqname SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . pure $ hq'NameToSplit' (Name.makeAbsolute . Path.prefixName prefix <$> hqname) - SA.SearchResult mpath result -> fmap pure . hqNameToSplit' $ searchResultToHQ mpath result + SA.SearchResult mpath result -> pure . hqNameToSplit' $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a hash or name" otherNumArg handleRelativeNameSegmentArg :: I.Argument -> Either (P.Pretty CT.ColorText) NameSegment diff --git a/unison-cli/tests/Unison/Test/Cli/Monad.hs b/unison-cli/tests/Unison/Test/Cli/Monad.hs index 0edb1dc3de..712b6c083b 100644 --- a/unison-cli/tests/Unison/Test/Cli/Monad.hs +++ b/unison-cli/tests/Unison/Test/Cli/Monad.hs @@ -7,7 +7,7 @@ import Control.Lens import EasyTest import Unison.Cli.Monad qualified as Cli import Unison.Codebase.Editor.StructuredArgument qualified as SA -import Unison.Reference qualified as Reference +import Unison.Syntax.Name qualified as Name test :: Test () test = @@ -18,13 +18,15 @@ test = Cli.runCli dummyEnv dummyLoopState do Cli.label \goto -> do Cli.label \_ -> do - Cli.setNumberedArgs [SA.Ref $ Reference.ReferenceBuiltin "foo"] + Cli.setNumberedArgs [SA.Name $ Name.unsafeParseText "foo"] goto (1 :: Int) pure 2 -- test that 'goto' short-circuits, as expected expectEqual' (Cli.Success 1) r -- test that calling 'goto' doesn't lose state changes made along the way - expectEqual' [SA.Ref $ Reference.ReferenceBuiltin "foo"] (state ^. #numberedArgs) + expectEqual' + [SA.Name $ Name.unsafeParseText "foo"] + (state ^. #numberedArgs) ok ] diff --git a/unison-src/transcripts/fix4898.output.md b/unison-src/transcripts/fix4898.output.md index e52dc65533..dceafc4cb3 100644 --- a/unison-src/transcripts/fix4898.output.md +++ b/unison-src/transcripts/fix4898.output.md @@ -47,12 +47,6 @@ redouble x = double x + double x .> delete.term 1 -``` - - - -🛑 - -The transcript failed due to an error in the stanza above. The error is: + Done. -Expected a name, but the numbered arg resulted in #1gupumeruksjs4sb5mg8jcb891dmbufmqrfblfss1sevbl62fr7oud24mpo03jm2qlbdt6ntordsmfj1jovhfsp3mij461odaahfh2g, which is a reference. +``` From 06c4b695f63d89ac6c832010dd5c0a6d29c56e69 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 22 May 2024 23:51:13 -0600 Subject: [PATCH 043/631] Type the `main` arg to `execute` This avoids throwing away the type information from `NumberedArgs` and just generally gets text handling out of the domain logic. --- .../src/Unison/Codebase/Execute.hs | 11 ++--- .../src/Unison/Codebase/MainTerm.hs | 43 ++++++++----------- unison-cli/src/ArgParse.hs | 24 +++++++---- .../src/Unison/Codebase/Editor/HandleInput.hs | 4 +- .../Unison/Codebase/Editor/HandleInput/Run.hs | 12 +++--- .../Editor/HandleInput/TermResolution.hs | 6 +-- .../Codebase/Editor/HandleInput/Tests.hs | 8 ++-- .../src/Unison/Codebase/Editor/Input.hs | 4 +- .../src/Unison/Codebase/Editor/Output.hs | 4 +- .../src/Unison/CommandLine/InputPatterns.hs | 10 +++-- .../src/Unison/CommandLine/OutputMessages.hs | 8 ++-- 11 files changed, 69 insertions(+), 65 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Execute.hs b/parser-typechecker/src/Unison/Codebase/Execute.hs index 4d8a5317a9..e7f1ef0762 100644 --- a/parser-typechecker/src/Unison/Codebase/Execute.hs +++ b/parser-typechecker/src/Unison/Codebase/Execute.hs @@ -14,17 +14,19 @@ import Unison.Codebase.MainTerm (getMainTerm) import Unison.Codebase.MainTerm qualified as MainTerm import Unison.Codebase.Runtime (Runtime) import Unison.Codebase.Runtime qualified as Runtime +import Unison.HashQualified qualified as HQ +import Unison.Name (Name) import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) -import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE import Unison.Symbol (Symbol) +import Unison.Syntax.HashQualified qualified as HQ (toText) import Unison.Util.Pretty qualified as P execute :: Codebase.Codebase IO Symbol Ann -> Runtime Symbol -> - Text -> + HQ.HashQualified Name -> IO (Either Runtime.Error ()) execute codebase runtime mainName = (`finally` Runtime.terminate runtime) . runExceptT $ do @@ -34,9 +36,8 @@ execute codebase runtime mainName = let mainType = Runtime.mainType runtime mt <- liftIO $ Codebase.runTransaction codebase $ getMainTerm loadTypeOfTerm parseNames mainName mainType case mt of - MainTerm.NotAFunctionName s -> throwError ("Not a function name: " <> P.text s) - MainTerm.NotFound s -> throwError ("Not found: " <> P.text s) - MainTerm.BadType s _ -> throwError (P.text s <> " is not of type '{IO} ()") + MainTerm.NotFound s -> throwError ("Not found: " <> P.text (HQ.toText s)) + MainTerm.BadType s _ -> throwError (P.text (HQ.toText s) <> " is not of type '{IO} ()") MainTerm.Success _ tm _ -> do let codeLookup = Codebase.toCodeLookup codebase ppe = PPE.empty diff --git a/parser-typechecker/src/Unison/Codebase/MainTerm.hs b/parser-typechecker/src/Unison/Codebase/MainTerm.hs index 159030aa7c..9f99ae5599 100644 --- a/parser-typechecker/src/Unison/Codebase/MainTerm.hs +++ b/parser-typechecker/src/Unison/Codebase/MainTerm.hs @@ -16,7 +16,6 @@ import Unison.Parser.Ann qualified as Parser.Ann import Unison.Prelude import Unison.Reference (Reference) import Unison.Referent qualified as Referent -import Unison.Syntax.HashQualified qualified as HQ (parseText) import Unison.Term (Term) import Unison.Term qualified as Term import Unison.Type (Type) @@ -26,37 +25,33 @@ import Unison.Var (Var) import Unison.Var qualified as Var data MainTerm v - = NotAFunctionName Text - | NotFound Text - | BadType Text (Maybe (Type v Ann)) + = NotFound (HQ.HashQualified Name) + | BadType (HQ.HashQualified Name) (Maybe (Type v Ann)) | Success (HQ.HashQualified Name) (Term v Ann) (Type v Ann) getMainTerm :: (Monad m, Var v) => (Reference -> m (Maybe (Type v Ann))) -> Names.Names -> - Text -> + HQ.HashQualified Name -> Type.Type v Ann -> m (MainTerm v) -getMainTerm loadTypeOfTerm parseNames mainName mainType = - case HQ.parseText mainName of - Nothing -> pure (NotAFunctionName mainName) - Just hq -> do - let refs = Names.lookupHQTerm Names.IncludeSuffixes hq parseNames - let a = Parser.Ann.External - case toList refs of - [] -> pure (NotFound mainName) - [Referent.Ref ref] -> do - typ <- loadTypeOfTerm ref - case typ of - Just typ -> - if Typechecker.fitsScheme typ mainType - then do - let tm = DD.forceTerm a a (Term.ref a ref) - return (Success hq tm typ) - else pure (BadType mainName $ Just typ) - _ -> pure (BadType mainName Nothing) - _ -> pure (error "multiple matching refs") -- TODO: make a real exception +getMainTerm loadTypeOfTerm parseNames mainName mainType = do + let refs = Names.lookupHQTerm Names.IncludeSuffixes mainName parseNames + let a = Parser.Ann.External + case toList refs of + [] -> pure (NotFound mainName) + [Referent.Ref ref] -> do + typ <- loadTypeOfTerm ref + case typ of + Just typ -> + if Typechecker.fitsScheme typ mainType + then do + let tm = DD.forceTerm a a (Term.ref a ref) + return (Success mainName tm typ) + else pure (BadType mainName $ Just typ) + _ -> pure (BadType mainName Nothing) + _ -> pure (error "multiple matching refs") -- TODO: make a real exception -- forall x. '{ io2.IO, Exception } x builtinMain :: (Var v) => a -> Type.Type v a diff --git a/unison-cli/src/ArgParse.hs b/unison-cli/src/ArgParse.hs index 84f2ae538c..5e7032942a 100644 --- a/unison-cli/src/ArgParse.hs +++ b/unison-cli/src/ArgParse.hs @@ -17,6 +17,7 @@ import Options.Applicative ParserPrefs, ReadM, action, + argument, auto, columns, command, @@ -32,6 +33,7 @@ import Options.Applicative info, infoOption, long, + maybeReader, metavar, option, parserFailure, @@ -53,21 +55,21 @@ import System.Environment (lookupEnv) import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path import Unison.CommandLine.Types (ShouldWatchFiles (..)) +import Unison.HashQualified (HashQualified) import Unison.LSP (LspFormattingConfig (..)) +import Unison.Name (Name) import Unison.Prelude import Unison.PrettyTerminal qualified as PT import Unison.Server.CodebaseServer (CodebaseServerOpts (..)) import Unison.Server.CodebaseServer qualified as Server +import Unison.Syntax.HashQualified qualified as HQ import Unison.Util.Pretty (Width (..)) --- The name of a symbol to execute. -type SymbolName = Text - -- | Valid ways to provide source code to the run command data RunSource - = RunFromPipe SymbolName - | RunFromSymbol SymbolName - | RunFromFile FilePath SymbolName + = RunFromPipe (HashQualified Name) + | RunFromSymbol (HashQualified Name) + | RunFromFile FilePath (HashQualified Name) | RunCompiled FilePath deriving (Show, Eq) @@ -368,22 +370,26 @@ versionParser = pure PrintVersion runArgumentParser :: Parser [String] runArgumentParser = many (strArgument (metavar "RUN-ARGS")) +runHQParser :: Parser (HashQualified Name) +runHQParser = + argument (maybeReader (HQ.parseText . Text.pack)) (metavar "SYMBOL") + runSymbolParser :: Parser Command runSymbolParser = - Run . RunFromSymbol <$> strArgument (metavar "SYMBOL") <*> runArgumentParser + Run . RunFromSymbol <$> runHQParser <*> runArgumentParser runFileParser :: Parser Command runFileParser = Run <$> ( RunFromFile <$> fileArgument "path/to/file" - <*> strArgument (metavar "SYMBOL") + <*> runHQParser ) <*> runArgumentParser runPipeParser :: Parser Command runPipeParser = - Run . RunFromPipe <$> strArgument (metavar "SYMBOL") <*> runArgumentParser + Run . RunFromPipe <$> runHQParser <*> runArgumentParser runCompiledParser :: Parser Command runCompiledParser = diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index f5f06bde10..187019a677 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -1061,7 +1061,7 @@ inputDescription input = pure ("update.old" <> p) Update2I -> pure ("update") UndoI {} -> pure "undo" - ExecuteI s args -> pure ("execute " <> Text.unwords (s : fmap Text.pack args)) + ExecuteI s args -> pure ("execute " <> Text.unwords (HQ.toText s : fmap Text.pack args)) IOTestI hq -> pure ("io.test " <> HQ.toText hq) IOTestAllI -> pure "io.test.all" UpdateBuiltinsI -> pure "builtins.update" @@ -1071,7 +1071,7 @@ inputDescription input = MergeIOBuiltinsI (Just path) -> ("builtins.mergeio " <>) <$> p path MakeStandaloneI out nm -> pure ("compile " <> Text.pack out <> " " <> HQ.toText nm) ExecuteSchemeI nm args -> - pure $ "run.native " <> Text.unwords (nm : fmap Text.pack args) + pure $ "run.native " <> Text.unwords (HQ.toText nm : fmap Text.pack args) CompileSchemeI fi nm -> pure ("compile.native " <> HQ.toText nm <> " " <> fi) CreateAuthorI id name -> pure ("create.author " <> NameSegment.toEscapedText id <> " " <> name) ClearI {} -> pure "clear" diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs index 5bbc119078..d2c6ed7aa9 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs @@ -20,6 +20,8 @@ import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.MainTerm qualified as MainTerm import Unison.Codebase.Runtime qualified as Runtime import Unison.Hash qualified as Hash +import Unison.HashQualified qualified as HQ +import Unison.Name (Name) import Unison.Parser.Ann (Ann (External)) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE @@ -40,7 +42,7 @@ import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF import Unison.Var qualified as Var -handleRun :: Bool -> Text -> [String] -> Cli () +handleRun :: Bool -> HQ.HashQualified Name -> [String] -> Cli () handleRun native main args = do (unisonFile, mainResType) <- do (sym, term, typ, otyp) <- getTerm main @@ -75,7 +77,7 @@ data GetTermResult -- | Look up runnable term with the given name in the codebase or -- latest typechecked unison file. Return its symbol, term, type, and -- the type of the evaluated term. -getTerm :: Text -> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann) +getTerm :: HQ.HashQualified Name -> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann) getTerm main = getTerm' main >>= \case NoTermWithThatName -> do @@ -90,7 +92,7 @@ getTerm main = Cli.returnEarly $ Output.BadMainFunction "run" main ty suffixifiedPPE [mainType] GetTermSuccess x -> pure x -getTerm' :: Text -> Cli GetTermResult +getTerm' :: HQ.HashQualified Name -> Cli GetTermResult getTerm' mainName = let getFromCodebase = do Cli.Env {codebase, runtime} <- ask @@ -99,7 +101,6 @@ getTerm' mainName = mainToFile =<< MainTerm.getMainTerm loadTypeOfTerm names mainName (Runtime.mainType runtime) where - mainToFile (MainTerm.NotAFunctionName _) = pure NoTermWithThatName mainToFile (MainTerm.NotFound _) = pure NoTermWithThatName mainToFile (MainTerm.BadType _ ty) = pure $ maybe NoTermWithThatName TermHasBadType ty mainToFile (MainTerm.Success hq tm typ) = @@ -108,7 +109,8 @@ getTerm' mainName = pure (GetTermSuccess (v, tm, typ, otyp)) getFromFile uf = do let components = join $ UF.topLevelComponents uf - let mainComponent = filter ((\v -> Var.name v == mainName) . view _1) components + -- __TODO__: We shouldn’t need to serialize mainName` for this check + let mainComponent = filter ((\v -> Var.name v == HQ.toText mainName) . view _1) components case mainComponent of [(v, _, tm, ty)] -> checkType ty \otyp -> diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs index 7e12e623e9..bb6dddabd6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs @@ -31,7 +31,6 @@ import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.Reference (Reference) import Unison.Referent (Referent, pattern Con, pattern Ref) import Unison.Symbol (Symbol) -import Unison.Syntax.HashQualified qualified as HQ (toText) import Unison.Type (Type) import Unison.Typechecker qualified as Typechecker @@ -118,9 +117,8 @@ resolveMainRef main = do pped <- Cli.prettyPrintEnvDeclFromNames names let suffixifiedPPE = PPED.suffixifiedPPE pped let mainType = Runtime.mainType runtime - smain = HQ.toText main lookupTermRefWithType codebase main >>= \case [(rf, ty)] | Typechecker.fitsScheme ty mainType -> pure (rf, suffixifiedPPE) - | otherwise -> Cli.returnEarly (BadMainFunction "main" smain ty suffixifiedPPE [mainType]) - _ -> Cli.returnEarly (NoMainFunction smain suffixifiedPPE [mainType]) + | otherwise -> Cli.returnEarly (BadMainFunction "main" main ty suffixifiedPPE [mainType]) + _ -> Cli.returnEarly (NoMainFunction main suffixifiedPPE [mainType]) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs index 901a0b3e28..3eb3658004 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs @@ -28,6 +28,8 @@ import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils import Unison.Codebase.Editor.Input (TestInput (..)) import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.Output qualified as Output +import Unison.Codebase.Path (Path) +import Unison.Codebase.Path qualified as Path import Unison.Codebase.Runtime qualified as Runtime import Unison.ConstructorReference (GConstructorReference (..)) import Unison.HashQualified qualified as HQ @@ -38,6 +40,7 @@ import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.Reference (TermReferenceId) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.ShortHash qualified as SH @@ -53,9 +56,6 @@ import Unison.Util.Monoid (foldMapM) import Unison.Util.Relation qualified as R import Unison.Util.Set qualified as Set import Unison.WatchKind qualified as WK -import Unison.Codebase.Path (Path) -import Unison.Reference (TermReferenceId) -import qualified Unison.Codebase.Path as Path -- | Handle a @test@ command. -- Run pure tests in the current subnamespace. @@ -137,7 +137,7 @@ handleIOTest main = do (fails, oks) <- refs & foldMapM \(ref, typ) -> do when (not $ isIOTest typ) do - Cli.returnEarly (BadMainFunction "io.test" (HQ.toText main) typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime)) + Cli.returnEarly (BadMainFunction "io.test" main typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime)) runIOTest suffixifiedPPE ref Cli.respond $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 56acd83e92..e4cb7a3dd8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -156,7 +156,7 @@ data Input -- Second `Maybe Int` is cap on diff elements shown, if any HistoryI (Maybe Int) (Maybe Int) BranchId | -- execute an IO thunk with args - ExecuteI Text [String] + ExecuteI (HQ.HashQualified Name) [String] | -- save the result of a previous Execute SaveExecuteResultI Name | -- execute an IO [Result] @@ -166,7 +166,7 @@ data Input | -- make a standalone binary file MakeStandaloneI String (HQ.HashQualified Name) | -- execute an IO thunk using scheme - ExecuteSchemeI Text [String] + ExecuteSchemeI (HQ.HashQualified Name) [String] | -- compile to a scheme file CompileSchemeI Text (HQ.HashQualified Name) | TestI TestInput diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 3efdb8a71f..24f3ae0448 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -157,13 +157,13 @@ data Output | InvalidSourceName String | SourceLoadFailed String | -- No main function, the [Type v Ann] are the allowed types - NoMainFunction Text PPE.PrettyPrintEnv [Type Symbol Ann] + NoMainFunction (HQ.HashQualified Name) PPE.PrettyPrintEnv [Type Symbol Ann] | -- | Function found, but has improper type -- Note: the constructor name is misleading here; we weren't necessarily looking for a "main". BadMainFunction Text -- ^ what we were trying to do (e.g. "run", "io.test") - Text + (HQ.HashQualified Name) -- ^ name of function (Type Symbol Ann) -- ^ bad type of function diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 9a5d0a364c..6559301f8e 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2708,8 +2708,9 @@ execute = ) $ \case main : args -> - Input.ExecuteI (Text.pack $ unifyArgument main) - <$> traverse (unsupportedStructuredArgument "a command-line argument") args + Input.ExecuteI + <$> handleHashQualifiedNameArg main + <*> traverse (unsupportedStructuredArgument "a command-line argument") args _ -> Left $ showPatternHelp execute saveExecuteResult :: InputPattern @@ -2799,8 +2800,9 @@ runScheme = ) $ \case main : args -> - Input.ExecuteSchemeI (Text.pack $ unifyArgument main) - <$> traverse (unsupportedStructuredArgument "a command-line argument") args + Input.ExecuteSchemeI + <$> handleHashQualifiedNameArg main + <*> traverse (unsupportedStructuredArgument "a command-line argument") args _ -> Left $ showPatternHelp runScheme compileScheme :: InputPattern diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 6b142389b8..5155578581 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -739,21 +739,21 @@ notifyUser dir = \case P.lines [ P.wrap $ "I looked for a function" - <> P.backticked (P.text main) + <> P.backticked (P.text $ HQ.toText main) <> "in the most recently typechecked file and codebase but couldn't find one. It has to have the type:", "", - P.indentN 2 $ P.lines [P.text main <> " : " <> TypePrinter.pretty ppe t | t <- ts] + P.indentN 2 $ P.lines [P.text (HQ.toText main) <> " : " <> TypePrinter.pretty ppe t | t <- ts] ] BadMainFunction what main ty ppe ts -> pure . P.callout "😶" $ P.lines [ P.string "I found this function:", "", - P.indentN 2 $ P.text main <> " : " <> TypePrinter.pretty ppe ty, + P.indentN 2 $ P.text (HQ.toText main) <> " : " <> TypePrinter.pretty ppe ty, "", P.wrap $ P.string "but in order for me to" <> P.backticked (P.text what) <> "it needs to be a subtype of:", "", - P.indentN 2 $ P.lines [P.text main <> " : " <> TypePrinter.pretty ppe t | t <- ts] + P.indentN 2 $ P.lines [P.text (HQ.toText main) <> " : " <> TypePrinter.pretty ppe t | t <- ts] ] NoUnisonFile -> do dir' <- canonicalizePath dir From 6384038ee078c37d41e1010e2eb64f3315d2e5ce Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 30 May 2024 14:29:27 -0700 Subject: [PATCH 044/631] Don't expose Branch0 internals, (and add add lens utils to prelude) --- lib/unison-prelude/src/Unison/Prelude.hs | 9 + .../src/Unison/Builtin/Decls.hs | 6 +- .../src/Unison/Codebase/Branch.hs | 212 ++-------------- .../src/Unison/Codebase/Branch/BranchDiff.hs | 16 +- .../src/Unison/Codebase/Branch/Merge.hs | 29 +-- .../src/Unison/Codebase/Branch/Names.hs | 5 +- .../src/Unison/Codebase/Branch/Type.hs | 233 ++++++++++++++++-- .../src/Unison/Codebase/BranchDiff.hs | 2 +- .../src/Unison/Codebase/BranchUtil.hs | 9 +- .../Codebase/SqliteCodebase/Conversions.hs | 10 +- .../src/Unison/Hashing/V2/Convert.hs | 9 +- .../src/Unison/KindInference/Error.hs | 2 +- .../src/Unison/KindInference/Generate.hs | 4 - .../src/Unison/KindInference/Solve.hs | 25 +- .../src/Unison/PatternMatchCoverage/Solve.hs | 1 - .../src/Unison/PrettyPrintEnv/MonadPretty.hs | 4 +- parser-typechecker/src/Unison/PrintError.hs | 1 - .../src/Unison/Runtime/IOSource.hs | 2 +- .../src/Unison/Runtime/Pattern.hs | 12 +- .../src/Unison/Syntax/TermPrinter.hs | 2 +- .../src/Unison/Typechecker/Context.hs | 2 +- .../tests/Unison/Test/UnisonSources.hs | 1 - unison-cli/src/Unison/Cli/MonadUtils.hs | 2 +- unison-cli/src/Unison/Cli/Share/Projects.hs | 1 - .../src/Unison/Codebase/Editor/HandleInput.hs | 31 ++- .../Codebase/Editor/HandleInput/Branch.hs | 1 - .../Editor/HandleInput/BranchRename.hs | 1 - .../Codebase/Editor/HandleInput/Branches.hs | 2 +- .../Editor/HandleInput/DeleteBranch.hs | 1 - .../Editor/HandleInput/DeleteProject.hs | 1 - .../Codebase/Editor/HandleInput/InstallLib.hs | 4 +- .../Codebase/Editor/HandleInput/Load.hs | 2 +- .../Codebase/Editor/HandleInput/Merge2.hs | 2 +- .../Codebase/Editor/HandleInput/MoveTerm.hs | 2 +- .../Codebase/Editor/HandleInput/MoveType.hs | 2 +- .../HandleInput/NamespaceDependencies.hs | 1 - .../Editor/HandleInput/NamespaceDiffUtils.hs | 2 +- .../Editor/HandleInput/ProjectClone.hs | 2 +- .../Editor/HandleInput/ProjectCreate.hs | 1 - .../Editor/HandleInput/ProjectRename.hs | 1 - .../Editor/HandleInput/ProjectSwitch.hs | 1 - .../Codebase/Editor/HandleInput/Push.hs | 2 +- .../Editor/HandleInput/ReleaseDraft.hs | 1 - .../Unison/Codebase/Editor/HandleInput/Run.hs | 2 +- .../Codebase/Editor/HandleInput/Update.hs | 4 +- .../Codebase/Editor/HandleInput/Update2.hs | 3 +- .../Codebase/Editor/HandleInput/Upgrade.hs | 1 - .../src/Unison/Codebase/Editor/Propagate.hs | 10 +- .../src/Unison/Codebase/TranscriptParser.hs | 2 +- .../Unison/CommandLine/BranchRelativePath.hs | 1 - .../src/Unison/CommandLine/DisplayValues.hs | 1 - .../src/Unison/CommandLine/InputPatterns.hs | 4 +- unison-cli/src/Unison/CommandLine/Main.hs | 2 +- unison-core/src/Unison/DataDeclaration.hs | 2 +- unison-core/src/Unison/Name.hs | 2 +- unison-core/src/Unison/Term.hs | 2 +- .../src/Unison/Hashing/V2/DataDeclaration.hs | 2 +- unison-merge/src/Unison/Merge/CombineDiffs.hs | 1 - .../src/Unison/Merge/DeclCoherencyCheck.hs | 2 +- .../src/Unison/Merge/DeclNameLookup.hs | 1 - .../Unison/Merge/PartitionCombinedDiffs.hs | 2 +- unison-merge/src/Unison/Merge/TwoWay.hs | 2 +- unison-merge/src/Unison/Merge/Unconflicts.hs | 1 - .../src/Unison/Server/CodebaseServer.hs | 1 - unison-share-api/src/Unison/Server/Doc.hs | 1 - 65 files changed, 361 insertions(+), 347 deletions(-) diff --git a/lib/unison-prelude/src/Unison/Prelude.hs b/lib/unison-prelude/src/Unison/Prelude.hs index 998df0dd4c..0ddd4aee64 100644 --- a/lib/unison-prelude/src/Unison/Prelude.hs +++ b/lib/unison-prelude/src/Unison/Prelude.hs @@ -38,12 +38,21 @@ module Unison.Prelude throwEitherMWith, throwExceptT, throwExceptTWith, + + -- * Basic lensy stuff we use all over + (^.), + (.~), + (%~), + view, + set, + over, ) where import Control.Applicative as X import Control.Category as X ((>>>)) import Control.Exception as X (Exception, IOException, SomeException) +import Control.Lens (over, set, view, (%~), (.~), (^.)) import Control.Monad as X import Control.Monad.Extra as X (ifM, mapMaybeM, unlessM, whenM) import Control.Monad.IO.Class as X (MonadIO (liftIO)) diff --git a/parser-typechecker/src/Unison/Builtin/Decls.hs b/parser-typechecker/src/Unison/Builtin/Decls.hs index 47bbc3f168..b48bc44830 100644 --- a/parser-typechecker/src/Unison/Builtin/Decls.hs +++ b/parser-typechecker/src/Unison/Builtin/Decls.hs @@ -1,11 +1,10 @@ module Unison.Builtin.Decls where -import Control.Lens (over, _3) +import Control.Lens (_3) import Data.List (elemIndex, find) import Data.Map qualified as Map import Data.Maybe qualified as Maybe -import Data.Sequence (Seq) -import Data.Text (Text, unpack) +import Data.Text (unpack) import Unison.ABT qualified as ABT import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType qualified as CT @@ -14,6 +13,7 @@ import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.Hashing.V2.Convert (hashDataDecls, typeToReference) import Unison.Pattern qualified as Pattern +import Unison.Prelude import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) diff --git a/parser-typechecker/src/Unison/Codebase/Branch.hs b/parser-typechecker/src/Unison/Codebase/Branch.hs index b9a0e625a9..f57c585ed2 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch.hs @@ -5,7 +5,7 @@ module Unison.Codebase.Branch ( -- * Branch types Branch (..), UnwrappedBranch, - Branch0 (..), + Branch0, Raw, Star, NamespaceHash, @@ -25,6 +25,7 @@ module Unison.Codebase.Branch -- * Branch tests isEmpty, + isEmpty0, isOne, before, lca, @@ -83,6 +84,10 @@ module Unison.Codebase.Branch edits, -- ** Term/type queries + deepTerms, + deepTypes, + deepEdits, + deepPaths, deepReferents, deepTermReferences, deepTypeReferences, @@ -91,13 +96,8 @@ module Unison.Codebase.Branch where import Control.Lens hiding (children, cons, transform, uncons) -import Control.Monad.State (State) -import Control.Monad.State qualified as State -import Data.List.NonEmpty qualified as NonEmpty import Data.Map qualified as Map import Data.Semialign qualified as Align -import Data.Sequence qualified as Seq -import Data.Set qualified as Set import Data.These (These (..)) import U.Codebase.Branch.Type (NamespaceStats (..)) import U.Codebase.HashTags (CausalHash, PatchHash (..)) @@ -108,15 +108,23 @@ import Unison.Codebase.Branch.Type NamespaceHash, Star, UnwrappedBranch, + branch0, + children, + deepEdits, + deepPaths, + deepTerms, + deepTypes, edits, head, headHash, history, - namespaceHash, + isEmpty0, + nonEmptyChildren, + terms, + types, ) import Unison.Codebase.Causal (Causal) import Unison.Codebase.Causal qualified as Causal -import Unison.Codebase.Metadata qualified as Metadata import Unison.Codebase.Patch (Patch) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path (Path (..)) @@ -132,7 +140,6 @@ import Unison.Reference (TermReference, TypeReference) import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Util.List qualified as List -import Unison.Util.Monoid qualified as Monoid import Unison.Util.Relation qualified as R import Unison.Util.Relation qualified as Relation import Unison.Util.Set qualified as Set @@ -198,179 +205,13 @@ deepTermReferences = deepTypeReferences :: Branch0 m -> Set TypeReference deepTypeReferences = R.dom . deepTypes -terms :: Lens' (Branch0 m) (Star Referent NameSegment) -terms = - lens - _terms - \branch terms -> - branch {_terms = terms} - & deriveDeepTerms - -types :: Lens' (Branch0 m) (Star TypeReference NameSegment) -types = - lens - _types - \branch types -> - branch {_types = types} - & deriveDeepTypes - -children :: Lens' (Branch0 m) (Map NameSegment (Branch m)) -children = lens _children (\Branch0 {..} x -> branch0 _terms _types x _edits) - -nonEmptyChildren :: Branch0 m -> Map NameSegment (Branch m) -nonEmptyChildren b = - b - & _children - & Map.filter (not . isEmpty0 . head) - namespaceStats :: Branch0 m -> NamespaceStats -namespaceStats Branch0 {deepTerms, deepTypes, deepEdits} = +namespaceStats b = NamespaceStats - { numContainedTerms = Relation.size deepTerms, - numContainedTypes = Relation.size deepTypes, - numContainedPatches = Map.size deepEdits - } - --- creates a Branch0 from the primary fields and derives the others. -branch0 :: - forall m. - Metadata.Star Referent NameSegment -> - Metadata.Star TypeReference NameSegment -> - Map NameSegment (Branch m) -> - Map NameSegment (PatchHash, m Patch) -> - Branch0 m -branch0 terms types children edits = - Branch0 - { _terms = terms, - _types = types, - _children = children, - _edits = edits, - isEmpty0 = - R.null (Star2.d1 terms) - && R.null (Star2.d1 types) - && Map.null edits - && all (isEmpty0 . head) children, - -- These are all overwritten immediately - deepTerms = R.empty, - deepTypes = R.empty, - deepPaths = Set.empty, - deepEdits = Map.empty + { numContainedTerms = Relation.size $ deepTerms b, + numContainedTypes = Relation.size $ deepTypes b, + numContainedPatches = Map.size $ deepEdits b } - & deriveDeepTerms - & deriveDeepTypes - & deriveDeepPaths - & deriveDeepEdits - --- | Derive the 'deepTerms' field of a branch. -deriveDeepTerms :: Branch0 m -> Branch0 m -deriveDeepTerms branch = - branch {deepTerms = R.fromList (makeDeepTerms branch)} - where - makeDeepTerms :: Branch0 m -> [(Referent, Name)] - makeDeepTerms branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty - where - -- `reversePrefix` might be ["Nat", "base", "lib"], and `b0` the `Nat` sub-namespace. - -- Then `R.toList` might produce the NameSegment "+", and we put the two together to - -- construct the name `Name Relative ("+" :| ["Nat","base","lib"])`. - go :: - forall m. - Seq (DeepChildAcc m) -> - [(Referent, Name)] -> - DeepState m [(Referent, Name)] - go Seq.Empty acc = pure acc - go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do - let terms :: [(Referent, Name)] - terms = - map - (second (Name.fromReverseSegments . (NonEmpty.:| reversePrefix))) - (R.toList (Star2.d1 (_terms b0))) - children <- deepChildrenHelper e - go (work <> children) (terms <> acc) - --- | Derive the 'deepTypes' field of a branch. -deriveDeepTypes :: forall m. Branch0 m -> Branch0 m -deriveDeepTypes branch = - branch {deepTypes = R.fromList (makeDeepTypes branch)} - where - makeDeepTypes :: Branch0 m -> [(TypeReference, Name)] - makeDeepTypes branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty - where - go :: - Seq (DeepChildAcc m) -> - [(TypeReference, Name)] -> - DeepState m [(TypeReference, Name)] - go Seq.Empty acc = pure acc - go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do - let types :: [(TypeReference, Name)] - types = map (second (Name.fromReverseSegments . (NonEmpty.:| reversePrefix))) (R.toList (Star2.d1 (_types b0))) - children <- deepChildrenHelper e - go (work <> children) (types <> acc) - --- | Derive the 'deepPaths' field of a branch. -deriveDeepPaths :: forall m. Branch0 m -> Branch0 m -deriveDeepPaths branch = - branch {deepPaths = makeDeepPaths branch} - where - makeDeepPaths :: Branch0 m -> Set Path - makeDeepPaths branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty - where - go :: Seq (DeepChildAcc m) -> Set Path -> DeepState m (Set Path) - go Seq.Empty acc = pure acc - go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do - let paths :: Set Path - paths = - if isEmpty0 b0 - then Set.empty - else (Set.singleton . Path . Seq.fromList . reverse) reversePrefix - children <- deepChildrenHelper e - go (work <> children) (paths <> acc) - --- | Derive the 'deepEdits' field of a branch. -deriveDeepEdits :: forall m. Branch0 m -> Branch0 m -deriveDeepEdits branch = - branch {deepEdits = makeDeepEdits branch} - where - makeDeepEdits :: Branch0 m -> Map Name PatchHash - makeDeepEdits branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty - where - go :: (Seq (DeepChildAcc m)) -> Map Name PatchHash -> DeepState m (Map Name PatchHash) - go Seq.Empty acc = pure acc - go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do - let edits :: Map Name PatchHash - edits = - Map.mapKeysMonotonic - (Name.fromReverseSegments . (NonEmpty.:| reversePrefix)) - (fst <$> _edits b0) - children <- deepChildrenHelper e - go (work <> children) (edits <> acc) - --- | State used by deepChildrenHelper to determine whether to descend into a child branch. --- Contains the set of visited namespace hashes. -type DeepState m = State (Set (NamespaceHash m)) - --- | Represents a unit of remaining work in traversing children for computing `deep*`. --- (reverse prefix to a branch, the number of `lib` segments in the reverse prefix, and the branch itself) -type DeepChildAcc m = ([NameSegment], Int, Branch0 m) - --- | Helper for knowing whether to descend into a child branch or not. --- Accepts child namespaces with previously unseen hashes, and any nested under 1 or fewer `lib` segments. -deepChildrenHelper :: forall m. DeepChildAcc m -> DeepState m (Seq (DeepChildAcc m)) -deepChildrenHelper (reversePrefix, libDepth, b0) = do - let go :: (NameSegment, Branch m) -> DeepState m (Seq (DeepChildAcc m)) - go (ns, b) = do - let h = namespaceHash b - result <- do - let isShallowDependency = libDepth <= 1 - isUnseenNamespace <- State.gets (Set.notMember h) - pure - if isShallowDependency || isUnseenNamespace - then - let libDepth' = if ns == NameSegment.libSegment then libDepth + 1 else libDepth - in Seq.singleton (ns : reversePrefix, libDepth', head b) - else Seq.empty - State.modify' (Set.insert h) - pure result - Monoid.foldMapM go (Map.toList (nonEmptyChildren b0)) -- | Update the head of the current causal. -- This re-hashes the current causal head after modifications. @@ -445,18 +286,7 @@ one :: Branch0 m -> Branch m one = Branch . Causal.one empty0 :: Branch0 m -empty0 = - Branch0 - { _terms = mempty, - _types = mempty, - _children = Map.empty, - _edits = Map.empty, - isEmpty0 = True, - deepTerms = Relation.empty, - deepTypes = Relation.empty, - deepPaths = Set.empty, - deepEdits = Map.empty - } +empty0 = branch0 mempty mempty mempty mempty -- | Checks whether a branch is empty AND has no history. isEmpty :: Branch m -> Bool diff --git a/parser-typechecker/src/Unison/Codebase/Branch/BranchDiff.hs b/parser-typechecker/src/Unison/Codebase/Branch/BranchDiff.hs index 63bc680dd1..c1fd10e33c 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch/BranchDiff.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch/BranchDiff.hs @@ -1,9 +1,11 @@ module Unison.Codebase.Branch.BranchDiff where +import Control.Lens import Data.Map (Map) import Data.Map qualified as Map import Data.Map.Merge.Lazy qualified as MapMerge -import Unison.Codebase.Branch.Type (Branch0 (_edits, _terms, _types)) +import Unison.Codebase.Branch (Branch0) +import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Metadata qualified as Metadata import Unison.Codebase.Patch qualified as Patch import Unison.NameSegment (NameSegment) @@ -27,8 +29,8 @@ data BranchDiff = BranchDiff diff0 :: (Monad m) => Branch0 m -> Branch0 m -> m BranchDiff diff0 old new = do - newEdits <- sequenceA $ snd <$> _edits new - oldEdits <- sequenceA $ snd <$> _edits old + newEdits <- sequenceA $ snd <$> new ^. Branch.edits + oldEdits <- sequenceA $ snd <$> old ^. Branch.edits let diffEdits = MapMerge.merge (MapMerge.mapMissing $ \_ p -> Patch.diff p mempty) @@ -38,10 +40,10 @@ diff0 old new = do oldEdits pure $ BranchDiff - { addedTerms = Star2.difference (_terms new) (_terms old), - removedTerms = Star2.difference (_terms old) (_terms new), - addedTypes = Star2.difference (_types new) (_types old), - removedTypes = Star2.difference (_types old) (_types new), + { addedTerms = Star2.difference (new ^. Branch.terms) (old ^. Branch.terms), + removedTerms = Star2.difference (old ^. Branch.terms) (new ^. Branch.terms), + addedTypes = Star2.difference (new ^. Branch.types) (old ^. Branch.types), + removedTypes = Star2.difference (old ^. Branch.types) (new ^. Branch.types), changedPatches = diffEdits } diff --git a/parser-typechecker/src/Unison/Codebase/Branch/Merge.hs b/parser-typechecker/src/Unison/Codebase/Branch/Merge.hs index 0cbb243c80..8db9a9cfde 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch/Merge.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch/Merge.hs @@ -15,7 +15,7 @@ import Data.Map.Merge.Lazy qualified as Map import U.Codebase.HashTags (PatchHash (..)) import Unison.Codebase.Branch ( Branch (..), - Branch0 (_children, _edits, _terms, _types), + Branch0, branch0, cons, discardHistory0, @@ -24,6 +24,7 @@ import Unison.Codebase.Branch isEmpty, isEmpty0, ) +import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.BranchDiff (BranchDiff (BranchDiff)) import Unison.Codebase.Branch.BranchDiff qualified as BDiff import Unison.Codebase.Causal qualified as Causal @@ -67,12 +68,12 @@ merge'' lca mode (Branch x) (Branch y) = (Map.traverseMaybeMissing $ combineMissing ca) (Map.traverseMaybeMissing $ combineMissing ca) (Map.zipWithAMatched $ const (merge'' lca mode)) - (_children l) - (_children r) - pure $ branch0 (_terms head0) (_types head0) children (_edits head0) + (l ^. Branch.children) + (r ^. Branch.children) + pure $ branch0 (head0 ^. Branch.terms) (head0 ^. Branch.types) children (head0 ^. Branch.edits) combineMissing ca k cur = - case Map.lookup k (_children ca) of + case Map.lookup k (ca ^. Branch.children) of Nothing -> pure $ Just cur Just old -> do nw <- merge'' lca mode (cons empty0 old) cur @@ -84,16 +85,16 @@ merge'' lca mode (Branch x) (Branch y) = apply b0 (BranchDiff addedTerms removedTerms addedTypes removedTypes changedPatches) = do patches <- sequenceA $ - Map.differenceWith patchMerge (pure @m <$> _edits b0) changedPatches - let newPatches = makePatch <$> Map.difference changedPatches (_edits b0) + Map.differenceWith patchMerge (pure @m <$> b0 ^. Branch.edits) changedPatches + let newPatches = makePatch <$> Map.difference changedPatches (b0 ^. Branch.edits) makePatch Patch.PatchDiff {..} = let p = Patch.Patch _addedTermEdits _addedTypeEdits in (PatchHash (H.hashPatch p), pure p) pure $ branch0 - (Star2.difference (_terms b0) removedTerms <> addedTerms) - (Star2.difference (_types b0) removedTypes <> addedTypes) - (_children b0) + (Star2.difference (b0 ^. Branch.terms) removedTerms <> addedTerms) + (Star2.difference (b0 ^. Branch.types) removedTypes <> addedTypes) + (b0 ^. Branch.children) (patches <> newPatches) patchMerge mhp Patch.PatchDiff {..} = Just $ do (_, mp) <- mhp @@ -118,12 +119,12 @@ merge0 :: Branch0 m -> m (Branch0 m) merge0 lca mode b1 b2 = do - c3 <- unionWithM (merge'' lca mode) (_children b1) (_children b2) - e3 <- unionWithM g (_edits b1) (_edits b2) + c3 <- unionWithM (merge'' lca mode) (b1 ^. Branch.children) (b2 ^. Branch.children) + e3 <- unionWithM g (b1 ^. Branch.edits) (b2 ^. Branch.edits) pure $ branch0 - (_terms b1 <> _terms b2) - (_types b1 <> _types b2) + (b1 ^. Branch.terms <> b2 ^. Branch.terms) + (b1 ^. Branch.types <> b2 ^. Branch.types) c3 e3 where diff --git a/parser-typechecker/src/Unison/Codebase/Branch/Names.hs b/parser-typechecker/src/Unison/Codebase/Branch/Names.hs index d8157d63e2..6291baef59 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch/Names.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch/Names.hs @@ -6,6 +6,7 @@ module Unison.Codebase.Branch.Names where import Unison.Codebase.Branch +import Unison.Codebase.Branch.Type qualified as Branch import Unison.Names (Names (..)) import Unison.NamesWithHistory qualified as Names import Unison.PrettyPrintEnv.Names qualified as PPE @@ -24,8 +25,8 @@ toPrettyPrintEnvDecl hashLength b = toNames :: Branch0 m -> Names toNames b = Names - (R.swap . deepTerms $ b) - (R.swap . deepTypes $ b) + (R.swap . Branch.deepTerms $ b) + (R.swap . Branch.deepTypes $ b) namesDiff :: Branch m -> Branch m -> Names.Diff namesDiff b1 b2 = Names.diff (toNames (head b1)) (toNames (head b2)) diff --git a/parser-typechecker/src/Unison/Codebase/Branch/Type.hs b/parser-typechecker/src/Unison/Codebase/Branch/Type.hs index 93a41cd3a6..148707f568 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch/Type.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch/Type.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} module Unison.Codebase.Branch.Type @@ -6,30 +7,50 @@ module Unison.Codebase.Branch.Type headHash, namespaceHash, Branch (..), - Branch0 (..), + Branch0, + branch0, + terms, + types, + children, + nonEmptyChildren, history, edits, + isEmpty0, + deepTerms, + deepTypes, + deepPaths, + deepEdits, Star, UnwrappedBranch, ) where -import Control.Lens -import Data.Map (Map) -import Data.Set (Set) -import U.Codebase.HashTags (CausalHash, PatchHash) +import Control.Lens hiding (children, cons, transform, uncons) +import Control.Monad.State (State) +import Control.Monad.State qualified as State +import Data.List.NonEmpty qualified as NonEmpty +import Data.Map qualified as Map +import Data.Sequence qualified as Seq +import Data.Set qualified as Set +import U.Codebase.HashTags (CausalHash, PatchHash (..)) import Unison.Codebase.Causal.Type (Causal) import Unison.Codebase.Causal.Type qualified as Causal import Unison.Codebase.Metadata qualified as Metadata import Unison.Codebase.Patch (Patch) -import Unison.Codebase.Path (Path) +import Unison.Codebase.Path (Path (..)) import Unison.Hash qualified as Hash import Unison.Name (Name) +import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) -import Unison.Reference (Reference) +import Unison.NameSegment qualified as NameSegment +import Unison.Prelude hiding (empty) +import Unison.Reference (Reference, TypeReference) import Unison.Referent (Referent) +import Unison.Util.Monoid qualified as Monoid import Unison.Util.Relation (Relation) -import Prelude hiding (head) +import Unison.Util.Relation qualified as R +import Unison.Util.Star2 qualified as Star2 +import Prelude hiding (head, read, subtract) -- | A node in the Unison namespace hierarchy -- along with its history. @@ -59,7 +80,10 @@ namespaceHash (Branch c) = Causal.valueHash c -- '_edits' are the 'Patch's stored at this node in the code. -- -- The remaining fields are derived from the four above. --- Please don't set them manually; use Branch.empty0 or Branch.branch0 to construct them. +-- None of the record fields are exported to avoid accidental tweaking without updating the +-- associated derived fields. +-- +-- Use either the lensy accessors or the field getters. data Branch0 m = Branch0 { _terms :: Star Referent NameSegment, _types :: Star Reference NameSegment, @@ -69,12 +93,12 @@ data Branch0 m = Branch0 _edits :: Map NameSegment (PatchHash, m Patch), -- | True if a branch and its children have no definitions or edits in them. -- (Computed recursively, and small enough to justify storing here to avoid computing more than once.) - isEmpty0 :: Bool, + _isEmpty0 :: Bool, -- names for this branch and its children - deepTerms :: Relation Referent Name, - deepTypes :: Relation Reference Name, - deepPaths :: Set Path, - deepEdits :: Map Name PatchHash + _deepTerms :: Relation Referent Name, + _deepTypes :: Relation Reference Name, + _deepPaths :: Set Path, + _deepEdits :: Map Name PatchHash } instance Eq (Branch0 m) where @@ -89,3 +113,184 @@ history = iso _history Branch edits :: Lens' (Branch0 m) (Map NameSegment (PatchHash, m Patch)) edits = lens _edits (\b0 e -> b0 {_edits = e}) + +terms :: Lens' (Branch0 m) (Star Referent NameSegment) +terms = + lens + _terms + \branch terms -> + branch {_terms = terms} + & deriveDeepTerms + +types :: Lens' (Branch0 m) (Star TypeReference NameSegment) +types = + lens + _types + \branch types -> + branch {_types = types} + & deriveDeepTypes + +isEmpty0 :: Branch0 m -> Bool +isEmpty0 = _isEmpty0 + +deepTerms :: Branch0 m -> Relation Referent Name +deepTerms = _deepTerms + +deepTypes :: Branch0 m -> Relation TypeReference Name +deepTypes = _deepTypes + +deepPaths :: Branch0 m -> Set Path +deepPaths = _deepPaths + +deepEdits :: Branch0 m -> Map Name PatchHash +deepEdits = _deepEdits + +children :: Lens' (Branch0 m) (Map NameSegment (Branch m)) +children = lens _children (\Branch0 {_terms, _types, _edits} x -> branch0 _terms _types x _edits) + +nonEmptyChildren :: Branch0 m -> Map NameSegment (Branch m) +nonEmptyChildren b = + b + & _children + & Map.filter (not . isEmpty0 . head) + +-- creates a Branch0 from the primary fields and derives the others. +branch0 :: + forall m. + Metadata.Star Referent NameSegment -> + Metadata.Star TypeReference NameSegment -> + Map NameSegment (Branch m) -> + Map NameSegment (PatchHash, m Patch) -> + Branch0 m +branch0 terms types children edits = + Branch0 + { _terms = terms, + _types = types, + _children = children, + _edits = edits, + _isEmpty0 = + R.null (Star2.d1 terms) + && R.null (Star2.d1 types) + && Map.null edits + && all (isEmpty0 . head) children, + -- These are all overwritten immediately + _deepTerms = R.empty, + _deepTypes = R.empty, + _deepPaths = Set.empty, + _deepEdits = Map.empty + } + & deriveDeepTerms + & deriveDeepTypes + & deriveDeepPaths + & deriveDeepEdits + +-- | Derive the 'deepTerms' field of a branch. +deriveDeepTerms :: Branch0 m -> Branch0 m +deriveDeepTerms branch = + branch {_deepTerms = R.fromList (makeDeepTerms branch)} + where + makeDeepTerms :: Branch0 m -> [(Referent, Name)] + makeDeepTerms branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty + where + -- `reversePrefix` might be ["Nat", "base", "lib"], and `b0` the `Nat` sub-namespace. + -- Then `R.toList` might produce the NameSegment "+", and we put the two together to + -- construct the name `Name Relative ("+" :| ["Nat","base","lib"])`. + go :: + forall m. + Seq (DeepChildAcc m) -> + [(Referent, Name)] -> + DeepState m [(Referent, Name)] + go Seq.Empty acc = pure acc + go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do + let terms :: [(Referent, Name)] + terms = + map + (second (Name.fromReverseSegments . (NonEmpty.:| reversePrefix))) + (R.toList (Star2.d1 (_terms b0))) + children <- deepChildrenHelper e + go (work <> children) (terms <> acc) + +-- | Derive the 'deepTypes' field of a branch. +deriveDeepTypes :: forall m. Branch0 m -> Branch0 m +deriveDeepTypes branch = + branch {_deepTypes = R.fromList (makeDeepTypes branch)} + where + makeDeepTypes :: Branch0 m -> [(TypeReference, Name)] + makeDeepTypes branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty + where + go :: + Seq (DeepChildAcc m) -> + [(TypeReference, Name)] -> + DeepState m [(TypeReference, Name)] + go Seq.Empty acc = pure acc + go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do + let types :: [(TypeReference, Name)] + types = map (second (Name.fromReverseSegments . (NonEmpty.:| reversePrefix))) (R.toList (Star2.d1 (_types b0))) + children <- deepChildrenHelper e + go (work <> children) (types <> acc) + +-- | Derive the 'deepPaths' field of a branch. +deriveDeepPaths :: forall m. Branch0 m -> Branch0 m +deriveDeepPaths branch = + branch {_deepPaths = makeDeepPaths branch} + where + makeDeepPaths :: Branch0 m -> Set Path + makeDeepPaths branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty + where + go :: Seq (DeepChildAcc m) -> Set Path -> DeepState m (Set Path) + go Seq.Empty acc = pure acc + go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do + let paths :: Set Path + paths = + if isEmpty0 b0 + then Set.empty + else (Set.singleton . Path . Seq.fromList . reverse) reversePrefix + children <- deepChildrenHelper e + go (work <> children) (paths <> acc) + +-- | Derive the 'deepEdits' field of a branch. +deriveDeepEdits :: forall m. Branch0 m -> Branch0 m +deriveDeepEdits branch = + branch {_deepEdits = makeDeepEdits branch} + where + makeDeepEdits :: Branch0 m -> Map Name PatchHash + makeDeepEdits branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty + where + go :: (Seq (DeepChildAcc m)) -> Map Name PatchHash -> DeepState m (Map Name PatchHash) + go Seq.Empty acc = pure acc + go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do + let edits :: Map Name PatchHash + edits = + Map.mapKeysMonotonic + (Name.fromReverseSegments . (NonEmpty.:| reversePrefix)) + (fst <$> _edits b0) + children <- deepChildrenHelper e + go (work <> children) (edits <> acc) + +-- | State used by deepChildrenHelper to determine whether to descend into a child branch. +-- Contains the set of visited namespace hashes. +type DeepState m = State (Set (NamespaceHash m)) + +-- | Represents a unit of remaining work in traversing children for computing `deep*`. +-- (reverse prefix to a branch, the number of `lib` segments in the reverse prefix, and the branch itself) +type DeepChildAcc m = ([NameSegment], Int, Branch0 m) + +-- | Helper for knowing whether to descend into a child branch or not. +-- Accepts child namespaces with previously unseen hashes, and any nested under 1 or fewer `lib` segments. +deepChildrenHelper :: forall m. DeepChildAcc m -> DeepState m (Seq (DeepChildAcc m)) +deepChildrenHelper (reversePrefix, libDepth, b0) = do + let go :: (NameSegment, Branch m) -> DeepState m (Seq (DeepChildAcc m)) + go (ns, b) = do + let h = namespaceHash b + result <- do + let isShallowDependency = libDepth <= 1 + isUnseenNamespace <- State.gets (Set.notMember h) + pure + if isShallowDependency || isUnseenNamespace + then + let libDepth' = if ns == NameSegment.libSegment then libDepth + 1 else libDepth + in Seq.singleton (ns : reversePrefix, libDepth', head b) + else Seq.empty + State.modify' (Set.insert h) + pure result + Monoid.foldMapM go (Map.toList (nonEmptyChildren b0)) diff --git a/parser-typechecker/src/Unison/Codebase/BranchDiff.hs b/parser-typechecker/src/Unison/Codebase/BranchDiff.hs index c846a17757..b0d4c825bb 100644 --- a/parser-typechecker/src/Unison/Codebase/BranchDiff.hs +++ b/parser-typechecker/src/Unison/Codebase/BranchDiff.hs @@ -3,7 +3,7 @@ module Unison.Codebase.BranchDiff where import Data.Map qualified as Map import Data.Set qualified as Set import U.Codebase.HashTags (PatchHash) -import Unison.Codebase.Branch (Branch0 (..)) +import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Patch (Patch, PatchDiff) import Unison.Codebase.Patch qualified as Patch diff --git a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs index 37c714ed7f..d0025cd87e 100644 --- a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs +++ b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs @@ -18,6 +18,7 @@ module Unison.Codebase.BranchUtil ) where +import Control.Lens import Data.Map qualified as Map import Data.Set qualified as Set import Unison.Codebase.Branch (Branch, Branch0) @@ -51,7 +52,7 @@ getTerm (p, hq) b = case hq of HashQualified n sh -> filter sh $ Star2.lookupD1 n terms where filter sh = Set.filter (SH.isPrefixOf sh . Referent.toShortHash) - terms = Branch._terms (Branch.getAt0 p b) + terms = (Branch.getAt0 p b) ^. Branch.terms getType :: Path.HQSplit -> Branch0 m -> Set Reference.TypeReference getType (p, hq) b = case hq of @@ -59,13 +60,13 @@ getType (p, hq) b = case hq of HashQualified n sh -> filter sh $ Star2.lookupD1 n types where filter sh = Set.filter (SH.isPrefixOf sh . Reference.toShortHash) - types = Branch._types (Branch.getAt0 p b) + types = (Branch.getAt0 p b) ^. Branch.types getBranch :: Path.Split -> Branch0 m -> Maybe (Branch m) getBranch (p, seg) b = case Path.toList p of - [] -> Map.lookup seg (Branch._children b) + [] -> Map.lookup seg (b ^. Branch.children) h : p -> - (Branch.head <$> Map.lookup h (Branch._children b)) + (Branch.head <$> Map.lookup h (b ^. Branch.children)) >>= getBranch (Path.fromList p, seg) makeAddTermName :: Path.Split -> Referent -> (Path, Branch0 m -> Branch0 m) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Conversions.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Conversions.hs index be84816cfa..7237c0bd8e 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Conversions.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Conversions.hs @@ -1,5 +1,6 @@ module Unison.Codebase.SqliteCodebase.Conversions where +import Control.Lens import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text (pack) @@ -20,6 +21,7 @@ import U.Codebase.TypeEdit qualified as V2.TypeEdit import U.Codebase.WatchKind qualified as V2 import U.Codebase.WatchKind qualified as V2.WatchKind import U.Core.ABT qualified as ABT +import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch qualified as V1.Branch import Unison.Codebase.Causal.Type qualified as V1.Causal import Unison.Codebase.Metadata qualified as V1.Metadata @@ -425,10 +427,10 @@ causalbranch1to2 (V1.Branch.Branch c) = branch1to2 b = pure $ V2.Branch.Branch - (doTerms (V1.Branch._terms b)) - (doTypes (V1.Branch._types b)) - (doPatches (V1.Branch._edits b)) - (doChildren (V1.Branch._children b)) + (doTerms (b ^. Branch.terms)) + (doTypes (b ^. Branch.types)) + (doPatches (b ^. Branch.edits)) + (doChildren (b ^. Branch.children)) where -- is there a more readable way to structure these that's also linear? doTerms :: V1.Branch.Star V1.Referent.Referent NameSegment -> Map NameSegment (Map V2.Referent.Referent (m V2.Branch.MdValues)) diff --git a/parser-typechecker/src/Unison/Hashing/V2/Convert.hs b/parser-typechecker/src/Unison/Hashing/V2/Convert.hs index 7958f3bec2..fd6b68896c 100644 --- a/parser-typechecker/src/Unison/Hashing/V2/Convert.hs +++ b/parser-typechecker/src/Unison/Hashing/V2/Convert.hs @@ -15,17 +15,11 @@ module Unison.Hashing.V2.Convert where import Control.Applicative -import Control.Lens (over, _3) +import Control.Lens (_3) import Control.Lens qualified as Lens import Control.Monad.Trans.Writer.CPS (Writer) import Control.Monad.Trans.Writer.CPS qualified as Writer -import Data.Bifunctor (bimap) -import Data.Foldable (toList) -import Data.Function ((&)) -import Data.Functor ((<&>)) -import Data.Map (Map) import Data.Map qualified as Map -import Data.Set (Set) import Data.Set qualified as Set import U.Codebase.HashTags (CausalHash (..), PatchHash (..)) import Unison.ABT qualified as ABT @@ -43,6 +37,7 @@ import Unison.Kind qualified as Memory.Kind import Unison.NameSegment qualified as Memory.NameSegment import Unison.Names.ResolutionResult (ResolutionResult) import Unison.Pattern qualified as Memory.Pattern +import Unison.Prelude import Unison.Reference qualified as Memory.Reference import Unison.Referent qualified as Memory.Referent import Unison.Syntax.Name qualified as Name (unsafeParseVar) diff --git a/parser-typechecker/src/Unison/KindInference/Error.hs b/parser-typechecker/src/Unison/KindInference/Error.hs index b015f8d282..2e977e0493 100644 --- a/parser-typechecker/src/Unison/KindInference/Error.hs +++ b/parser-typechecker/src/Unison/KindInference/Error.hs @@ -6,7 +6,6 @@ module Unison.KindInference.Error ) where -import Control.Lens ((^.)) import Unison.ABT qualified as ABT import Unison.KindInference.Constraint.Context (ConstraintContext (..)) import Unison.KindInference.Constraint.Provenance (Provenance (..)) @@ -18,6 +17,7 @@ import Unison.KindInference.Solve.Monad Solve (..), ) import Unison.KindInference.UVar (UVar (..)) +import Unison.Prelude import Unison.Type (Type) import Unison.Var (Var) diff --git a/parser-typechecker/src/Unison/KindInference/Generate.hs b/parser-typechecker/src/Unison/KindInference/Generate.hs index dd47a0a613..b235108745 100644 --- a/parser-typechecker/src/Unison/KindInference/Generate.hs +++ b/parser-typechecker/src/Unison/KindInference/Generate.hs @@ -8,7 +8,6 @@ module Unison.KindInference.Generate ) where -import Control.Lens ((^.)) import Data.Foldable (foldlM) import Data.Set qualified as Set import U.Core.ABT qualified as ABT @@ -30,7 +29,6 @@ import Unison.Term qualified as Term import Unison.Type qualified as Type import Unison.Var (Type (User), Var (typed), freshIn) - -------------------------------------------------------------------------------- -- Constraints arising from Types -------------------------------------------------------------------------------- @@ -108,7 +106,6 @@ typeConstraintTree resultVar term@ABT.Term {annotation, out} = do effConstraints <- typeConstraintTree effKind eff pure $ ParentConstraint (IsAbility effKind (Provenance EffectsList $ ABT.annotation eff)) effConstraints - handleIntroOuter :: Var v => v -> loc -> (GeneratedConstraint v loc -> Gen v loc r) -> Gen v loc r handleIntroOuter v loc k = do let typ = Type.var loc v @@ -141,7 +138,6 @@ termConstraintTree = fmap Node . dfAnns processAnn cons nil . hackyStripAnns cons mlhs mrhs = (++) <$> mlhs <*> mrhs nil = pure [] - -- | Helper for @termConstraints@ that instantiates the outermost -- foralls and keeps the type in scope (in the type map) while -- checking lexically nested type annotations. diff --git a/parser-typechecker/src/Unison/KindInference/Solve.hs b/parser-typechecker/src/Unison/KindInference/Solve.hs index 09acd3979b..1bf58960f5 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve.hs @@ -10,7 +10,7 @@ module Unison.KindInference.Solve ) where -import Control.Lens (Prism', prism', review, (%~)) +import Control.Lens (Prism', prism', review) import Control.Monad.Reader (asks) import Control.Monad.Reader qualified as M import Control.Monad.State.Strict qualified as M @@ -127,19 +127,19 @@ reduce cs0 = dbg "reduce" cs0 (go False []) -- Signal that we solved something on this pass (by passing -- @True@) and continue Right () -> go True acc cs - - -- | tracing helper + + -- \| tracing helper dbg :: forall a. - -- | A hanging prefix or header + -- \| A hanging prefix or header P.Pretty P.ColorText -> - -- | The constraints to print + -- \| The constraints to print [GeneratedConstraint v loc] -> ([GeneratedConstraint v loc] -> Solve v loc a) -> Solve v loc a dbg = traceApp \ppe cs -> prettyConstraints ppe (map (review _Generated) cs) - -- | Like @dbg@, but for a single constraint + -- \| Like @dbg@, but for a single constraint dbgSingle :: forall a. P.Pretty P.ColorText -> @@ -148,7 +148,7 @@ reduce cs0 = dbg "reduce" cs0 (go False []) Solve v loc a dbgSingle = traceApp \ppe c -> prettyConstraintD' ppe (review _Generated c) - -- | A helper for @dbg*@ + -- \| A helper for @dbg*@ traceApp :: forall a b. (PrettyPrintEnv -> a -> P.Pretty P.ColorText) -> @@ -231,21 +231,21 @@ addConstraint' = \case _ -> Nothing Unsolved.Unify l a b -> Right <$> union l a b where - -- | A helper for solving various @Is*@ constraints. In each case + -- \| A helper for solving various @Is*@ constraints. In each case -- we want to lookup any existing constraints on the constrained -- variable. If none exist then we simply add the new constraint, -- as it can't conflict with anything. If there is an existing -- constraint we defer to the passed in function. handleConstraint :: - -- | The variable mentioned in the input constraint + -- \| The variable mentioned in the input constraint UVar v loc -> - -- | The new constraint + -- \| The new constraint Solved.Constraint (UVar v loc) v loc -> - -- | How to handle the an existing constraint + -- \| How to handle the an existing constraint ( Solved.Constraint (UVar v loc) v loc -> Maybe (Solved.Constraint (UVar v loc) v loc, [UnsolvedConstraint v loc]) ) -> - -- | An error or a list of implied constraints + -- \| An error or a list of implied constraints Solve v loc (Either (ConstraintConflict v loc) [UnsolvedConstraint v loc]) handleConstraint s solvedConstraint phi = do st@SolveState {constraints} <- M.get @@ -322,7 +322,6 @@ initialState env = let ((), finalState) = run env emptyState initializeState in finalState - initializeState :: forall v loc. (BuiltinAnnotation loc, Ord loc, Show loc, Var v) => Solve v loc () initializeState = assertGen do builtinConstraints diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs index 59ffa3d865..5c10aa36ee 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs @@ -9,7 +9,6 @@ module Unison.PatternMatchCoverage.Solve ) where -import Control.Lens (view) import Control.Monad.State import Control.Monad.Trans.Compose import Control.Monad.Trans.Maybe diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs b/parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs index 83931693c2..6dffefd90d 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs @@ -2,10 +2,10 @@ module Unison.PrettyPrintEnv.MonadPretty where -import Control.Lens (over, set, view, views, _1, _2) +import Control.Lens (views, _1, _2) import Control.Monad.Reader (MonadReader, Reader, local, runReader) import Data.Set qualified as Set -import Unison.Prelude (Set) +import Unison.Prelude import Unison.PrettyPrintEnv (PrettyPrintEnv) import Unison.Var (Var) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index b96b60a153..5885e1daff 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -14,7 +14,6 @@ module Unison.PrintError ) where -import Control.Lens ((%~)) import Control.Lens.Tuple (_1, _2, _3) import Data.Foldable qualified as Foldable import Data.Function (on) diff --git a/parser-typechecker/src/Unison/Runtime/IOSource.hs b/parser-typechecker/src/Unison/Runtime/IOSource.hs index c1d97ac714..4848851f89 100644 --- a/parser-typechecker/src/Unison/Runtime/IOSource.hs +++ b/parser-typechecker/src/Unison/Runtime/IOSource.hs @@ -3,7 +3,7 @@ module Unison.Runtime.IOSource where -import Control.Lens (view, _2) +import Control.Lens (_2) import Control.Monad.Morph (hoist) import Data.List (elemIndex, genericIndex) import Data.Map qualified as Map diff --git a/parser-typechecker/src/Unison/Runtime/Pattern.hs b/parser-typechecker/src/Unison/Runtime/Pattern.hs index 1efe932066..610a456d3a 100644 --- a/parser-typechecker/src/Unison/Runtime/Pattern.hs +++ b/parser-typechecker/src/Unison/Runtime/Pattern.hs @@ -12,20 +12,15 @@ module Unison.Runtime.Pattern ) where -import Control.Lens ((<&>), (^.)) import Control.Monad.State (State, evalState, modify, runState, state) import Data.List (transpose) import Data.Map.Strict - ( Map, - fromListWith, + ( fromListWith, insertWith, - toList, ) import Data.Map.Strict qualified as Map -import Data.Maybe (catMaybes, listToMaybe) -import Data.Set (Set, member) +import Data.Set (member) import Data.Set qualified as Set -import Data.Word (Word64) import Unison.ABT ( absChain', renames, @@ -38,6 +33,7 @@ import Unison.ConstructorReference qualified as ConstructorReference import Unison.DataDeclaration (declFields) import Unison.Pattern import Unison.Pattern qualified as P +import Unison.Prelude hiding (guard) import Unison.Reference (Reference, Reference' (Builtin, DerivedId)) import Unison.Runtime.ANF (internalBug) import Unison.Term hiding (Term, matchPattern) @@ -417,7 +413,7 @@ splitMatrixBuiltin :: [(P.Pattern (), [(v, PType)], PatternMatrix v)] splitMatrixBuiltin v (PM rs) = fmap (\(a, (b, c)) -> (a, b, c)) - . toList + . Map.toList . fmap buildMatrix . fromListWith (flip (++)) . expandIrrefutable diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index d54388b6d4..bc33c43ca2 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -13,7 +13,7 @@ module Unison.Syntax.TermPrinter ) where -import Control.Lens (unsnoc, (^.)) +import Control.Lens (unsnoc) import Control.Monad.State (evalState) import Control.Monad.State qualified as State import Data.Char (isPrint) diff --git a/parser-typechecker/src/Unison/Typechecker/Context.hs b/parser-typechecker/src/Unison/Typechecker/Context.hs index f249c0abd8..8b6a5939b9 100644 --- a/parser-typechecker/src/Unison/Typechecker/Context.hs +++ b/parser-typechecker/src/Unison/Typechecker/Context.hs @@ -42,7 +42,7 @@ module Unison.Typechecker.Context ) where -import Control.Lens (over, view, _2) +import Control.Lens (_2) import Control.Monad.Fail qualified as MonadFail import Control.Monad.Fix (MonadFix (..)) import Control.Monad.State diff --git a/parser-typechecker/tests/Unison/Test/UnisonSources.hs b/parser-typechecker/tests/Unison/Test/UnisonSources.hs index b89dfd551f..e618ac8fb9 100644 --- a/parser-typechecker/tests/Unison/Test/UnisonSources.hs +++ b/parser-typechecker/tests/Unison/Test/UnisonSources.hs @@ -1,7 +1,6 @@ module Unison.Test.UnisonSources where import Control.Exception (throwIO) -import Control.Lens (view) import Control.Lens.Tuple (_5) import Data.Map qualified as Map import Data.Text (unpack) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index c9f40cf10e..5aa583ee4c 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -94,7 +94,7 @@ import U.Codebase.HashTags (CausalHash (..)) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch (Branch (..), Branch0 (..)) +import Unison.Codebase.Branch (Branch (..), Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Input qualified as Input diff --git a/unison-cli/src/Unison/Cli/Share/Projects.hs b/unison-cli/src/Unison/Cli/Share/Projects.hs index f2808343e3..961ed69858 100644 --- a/unison-cli/src/Unison/Cli/Share/Projects.hs +++ b/unison-cli/src/Unison/Cli/Share/Projects.hs @@ -31,7 +31,6 @@ module Unison.Cli.Share.Projects ) where -import Control.Lens ((^.)) import Control.Monad.Reader (ask) import Data.Proxy import Network.HTTP.Client qualified as Http.Client diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 088062ce24..c81483f038 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -42,7 +42,7 @@ import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch (Branch (..), Branch0 (..)) +import Unison.Codebase.Branch (Branch (..), Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Merge qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch @@ -886,21 +886,20 @@ loop e = do Causal.Cons h _bh b tail -> goBranch h b [fst tail] (tail : queue) Causal.Merge h _bh b (Map.toList -> tails) -> goBranch h b (map fst tails) (tails ++ queue) goBranch :: forall m. (Monad m) => CausalHash -> Branch0 m -> [CausalHash] -> [(CausalHash, m (Branch.UnwrappedBranch m))] -> StateT (Set CausalHash) m () - goBranch h b (Set.fromList -> causalParents) queue = case b of - Branch0 terms0 types0 children0 patches0 _ _ _ _ _ -> - let ignoreMetadata :: (Ord r, Ord n) => Metadata.Star r n -> r -> (r, Set n) - ignoreMetadata s r = - (r, R.lookupDom r $ Star2.d1 s) - terms = Map.fromList . map (ignoreMetadata terms0) . Foldable.toList $ Star2.fact terms0 - types = Map.fromList . map (ignoreMetadata types0) . Foldable.toList $ Star2.fact types0 - patches = fmap fst patches0 - children = fmap Branch.headHash children0 - in do - let d = Output.DN.DumpNamespace terms types patches children causalParents - -- the alternate implementation that doesn't rely on `traceM` blows up - traceM $ P.toPlain 200 (prettyDump (h, d)) - set h - goCausal (map getCausal (Foldable.toList children0) ++ queue) + goBranch h b (Set.fromList -> causalParents) queue = + let ignoreMetadata :: (Ord r, Ord n) => Metadata.Star r n -> r -> (r, Set n) + ignoreMetadata s r = + (r, R.lookupDom r $ Star2.d1 s) + terms = Map.fromList . map (ignoreMetadata (b ^. Branch.terms)) . Foldable.toList $ Star2.fact (b ^. Branch.terms) + types = Map.fromList . map (ignoreMetadata (b ^. Branch.types)) . Foldable.toList $ Star2.fact (b ^. Branch.types) + patches = fmap fst (b ^. Branch.edits) + children = fmap Branch.headHash (b ^. Branch.children) + in do + let d = Output.DN.DumpNamespace terms types patches children causalParents + -- the alternate implementation that doesn't rely on `traceM` blows up + traceM $ P.toPlain 200 (prettyDump (h, d)) + set h + goCausal (map getCausal (Foldable.toList (b ^. Branch.children)) ++ queue) prettyDump (h, Output.DN.DumpNamespace terms types patches children causalParents) = P.lit "Namespace " <> P.shown h diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 4e740830cb..70519cf68d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -7,7 +7,6 @@ module Unison.Codebase.Editor.HandleInput.Branch ) where -import Control.Lens ((^.)) import Data.These (These (..)) import Data.UUID.V4 qualified as UUID import U.Codebase.Sqlite.DbId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs index bdf20d61be..cc73936683 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs @@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.BranchRename ) where -import Control.Lens ((^.)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs index 024ef29f26..ba7bf5c885 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs @@ -4,7 +4,7 @@ module Unison.Codebase.Editor.HandleInput.Branches ) where -import Control.Lens (mapped, over, (^.), _2) +import Control.Lens (mapped, _2) import Data.Map.Strict qualified as Map import Network.URI (URI) import U.Codebase.Sqlite.Queries qualified as Queries diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs index b6865748f1..cf9cebf211 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs @@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.DeleteBranch ) where -import Control.Lens (over, (^.)) import Data.Map.Strict qualified as Map import Data.These (These (..)) import U.Codebase.Sqlite.Queries qualified as Queries diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs index 0004204670..3ff51cf818 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs @@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.DeleteProject ) where -import Control.Lens (view, (^.)) import Data.Function (on) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs index 11d51197c5..a62882b9f2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs @@ -79,9 +79,9 @@ handleInstallLib (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName) pure $ fresh (\i -> NameSegment.unsafeParseText . (<> "__" <> tShow i) . NameSegment.toUnescapedText) - ( case Map.lookup NameSegment.libSegment currentBranchObject._children of + ( case Map.lookup NameSegment.libSegment (currentBranchObject ^. Branch.children) of Nothing -> Set.empty - Just libdeps -> Map.keysSet (Branch._children (Branch.head libdeps)) + Just libdeps -> Map.keysSet ((Branch.head libdeps) ^. Branch.children) ) (makeDependencyName libdepProjectName libdepBranchName) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs index 12d121c487..a9259fc969 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs @@ -6,7 +6,7 @@ module Unison.Codebase.Editor.HandleInput.Load ) where -import Control.Lens ((.=), (.~)) +import Control.Lens ((.=)) import Control.Monad.Reader (ask) import Control.Monad.State.Strict qualified as State import Data.Map.Strict qualified as Map diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index d6685f1059..54a73fae2b 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -10,7 +10,7 @@ module Unison.Codebase.Editor.HandleInput.Merge2 ) where -import Control.Lens (mapped, over, set, view, _1) +import Control.Lens (mapped, _1) import Control.Monad.Reader (ask) import Control.Monad.Writer (Writer) import Control.Monad.Writer qualified as Writer diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs index fc57ff768f..374e58ac56 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs @@ -1,6 +1,6 @@ module Unison.Codebase.Editor.HandleInput.MoveTerm (doMoveTerm, moveTermSteps) where -import Control.Lens (over, _2) +import Control.Lens (_2) import Data.Set qualified as Set import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs index b9da6747be..95f3ba09b5 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs @@ -1,6 +1,6 @@ module Unison.Codebase.Editor.HandleInput.MoveType (doMoveType, moveTypeSteps) where -import Control.Lens (over, _2) +import Control.Lens (_2) import Data.Set qualified as Set import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs index f812df39ba..068a28832b 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs @@ -3,7 +3,6 @@ module Unison.Codebase.Editor.HandleInput.NamespaceDependencies ) where -import Control.Lens (over) import Control.Monad.Reader (ask) import Control.Monad.Trans.Maybe import Data.Map qualified as Map diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs index 0986f1d590..0416672e3e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs @@ -13,7 +13,7 @@ import Unison.Cli.NamesUtils qualified as Cli import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch (Branch0 (..)) +import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.BranchDiff qualified as BranchDiff import Unison.Codebase.Editor.Output.BranchDiff qualified as OBranchDiff diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs index a459b343bf..5d15bf659c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs @@ -4,7 +4,7 @@ module Unison.Codebase.Editor.HandleInput.ProjectClone ) where -import Control.Lens (over, (^.), _2) +import Control.Lens (_2) import Control.Monad.Reader (ask) import Data.These (These (..)) import Data.UUID.V4 qualified as UUID diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs index 99a90be6f8..30dd0aad12 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs @@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.ProjectCreate ) where -import Control.Lens (over, (^.)) import Control.Monad.Reader (ask) import Data.Map.Strict qualified as Map import Data.Text qualified as Text diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs index 9f315aebef..f7d960d2df 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs @@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.ProjectRename ) where -import Control.Lens ((^.)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs index 87329e00d4..cbae83652e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs @@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.ProjectSwitch ) where -import Control.Lens ((^.)) import Data.These (These (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs index 3c68d0ebf9..d099f21798 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs @@ -6,7 +6,7 @@ module Unison.Codebase.Editor.HandleInput.Push where import Control.Concurrent.STM (atomically, modifyTVar', newTVarIO, readTVar, readTVarIO) -import Control.Lens (over, view, (.~), (^.), _1, _2) +import Control.Lens (_1, _2) import Control.Monad.Reader (ask) import Data.Set.NonEmpty qualified as Set.NonEmpty import Data.Text as Text diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs index e6c9151428..13caf9b1ac 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs @@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.ReleaseDraft ) where -import Control.Lens ((^.)) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs index 5bbc119078..fce9ae4a73 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs @@ -3,7 +3,7 @@ module Unison.Codebase.Editor.HandleInput.Run ) where -import Control.Lens (view, (.=), _1) +import Control.Lens ((.=), _1) import Control.Monad.Reader (ask) import Data.Map.Strict qualified as Map import Data.Set qualified as Set diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs index 23c9fb4736..b6bb301056 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs @@ -20,7 +20,7 @@ import Unison.Cli.NamesUtils qualified as Cli import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch (Branch0 (..)) +import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Input @@ -501,7 +501,7 @@ getSlurpResultForUpdate requestedNames slurpCheckNames = do -- fresh2 = fresh1 + 2 -- fresh3 = fresh2 + 3 terms = - Map.fromList $ Map.elems refToGeneratedNameAndTerm <&> \(v,term) -> (v, (External, term)), + Map.fromList $ Map.elems refToGeneratedNameAndTerm <&> \(v, term) -> (v, (External, term)), -- In the context of this update, whatever watches were in the latest typechecked Unison file are -- irrelevant, so we don't need to copy them over. watches = Map.empty diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 72ed90dacd..c164f8d6d2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -18,7 +18,6 @@ module Unison.Codebase.Editor.HandleInput.Update2 ) where -import Control.Lens (over, (%~), (.~)) import Control.Lens qualified as Lens import Control.Monad.RWS (ask) import Data.Bifoldable (bifoldMap) @@ -43,8 +42,8 @@ import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) import Unison.Cli.UniqueTypeGuidLookup qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch.Names qualified as Branch -import Unison.Codebase.Branch.Type (Branch0) import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Output (Output) import Unison.Codebase.Editor.Output qualified as Output diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index aab5144e18..6785cd7f68 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -3,7 +3,6 @@ module Unison.Codebase.Editor.HandleInput.Upgrade ) where -import Control.Lens ((^.)) import Control.Monad.Reader (ask) import Data.Char qualified as Char import Data.List.NonEmpty (pattern (:|)) diff --git a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs index addb8d5de9..f1bf65962c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs @@ -18,7 +18,7 @@ import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.TypeCheck qualified as Cli (computeTypecheckingEnvironment) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch (Branch0 (..)) +import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.Output @@ -620,14 +620,14 @@ applyPropagate patch Edits {termReplacements, typeReplacements, constructorRepla Map Reference Reference -> Branch0 m -> Branch0 m - updateLevel termEdits typeEdits Branch0 {..} = - Branch.branch0 terms types _children _edits + updateLevel termEdits typeEdits b = + Branch.branch0 terms types (b ^. Branch.children) (b ^. Branch.edits) where isPropagatedReferent (Referent.Con _ _) = True isPropagatedReferent (Referent.Ref r) = isPropagated r terms0 :: Metadata.Star Referent NameSegment - terms0 = Star2.replaceFacts replaceConstructor constructorReplacements _terms + terms0 = Star2.replaceFacts replaceConstructor constructorReplacements (b ^. Branch.terms) terms :: Branch.Star Referent NameSegment terms = updateMetadatas $ @@ -635,7 +635,7 @@ applyPropagate patch Edits {termReplacements, typeReplacements, constructorRepla types :: Branch.Star Reference NameSegment types = updateMetadatas $ - Star2.replaceFacts replaceType typeEdits _types + Star2.replaceFacts replaceType typeEdits (b ^. Branch.types) updateMetadatas :: (Ord r) => diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/TranscriptParser.hs index 27627960ef..9746c39f91 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/unison-cli/src/Unison/Codebase/TranscriptParser.hs @@ -18,7 +18,7 @@ module Unison.Codebase.TranscriptParser ) where -import Control.Lens (use, (?~), (^.)) +import Control.Lens (use, (?~)) import Crypto.Random qualified as Random import Data.Aeson qualified as Aeson import Data.Aeson.Encode.Pretty qualified as Aeson diff --git a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs index 6b63811bba..a999edbbe0 100644 --- a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs +++ b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs @@ -8,7 +8,6 @@ module Unison.CommandLine.BranchRelativePath ) where -import Control.Lens (view) import Data.Set qualified as Set import Data.Text qualified as Text import Data.These (These (..)) diff --git a/unison-cli/src/Unison/CommandLine/DisplayValues.hs b/unison-cli/src/Unison/CommandLine/DisplayValues.hs index 5ccf7398ea..b7b7d3bf65 100644 --- a/unison-cli/src/Unison/CommandLine/DisplayValues.hs +++ b/unison-cli/src/Unison/CommandLine/DisplayValues.hs @@ -3,7 +3,6 @@ module Unison.CommandLine.DisplayValues where -import Control.Lens ((^.)) import Data.Map qualified as Map import Unison.ABT qualified as ABT import Unison.Builtin qualified as Builtin diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 6615506446..1473b05055 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -135,7 +135,7 @@ module Unison.CommandLine.InputPatterns ) where -import Control.Lens (preview, review, (^.)) +import Control.Lens (preview, review) import Control.Lens.Cons qualified as Cons import Data.List (intercalate) import Data.List.Extra qualified as List @@ -183,7 +183,7 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment -import Unison.Prelude +import Unison.Prelude hiding (view) import Unison.Project ( ProjectAndBranch (..), ProjectAndBranchNames (..), diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index de0d7e12fb..cda7f9e416 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -6,7 +6,7 @@ where import Compat (withInterruptHandler) import Control.Concurrent.Async qualified as Async import Control.Exception (catch, displayException, finally, mask) -import Control.Lens (preview, (?~), (^.)) +import Control.Lens (preview, (?~)) import Crypto.Random qualified as Random import Data.Configurator.Types (Config) import Data.IORef diff --git a/unison-core/src/Unison/DataDeclaration.hs b/unison-core/src/Unison/DataDeclaration.hs index 9467880ca2..e66599c43b 100644 --- a/unison-core/src/Unison/DataDeclaration.hs +++ b/unison-core/src/Unison/DataDeclaration.hs @@ -36,7 +36,7 @@ module Unison.DataDeclaration ) where -import Control.Lens (Iso', Lens', imap, iso, lens, over, _3) +import Control.Lens (Iso', Lens', imap, iso, lens, _3) import Control.Monad.State (evalState) import Data.Map qualified as Map import Data.Set qualified as Set diff --git a/unison-core/src/Unison/Name.hs b/unison-core/src/Unison/Name.hs index 3c91b09a78..7d83516dd1 100644 --- a/unison-core/src/Unison/Name.hs +++ b/unison-core/src/Unison/Name.hs @@ -56,7 +56,7 @@ module Unison.Name ) where -import Control.Lens (mapped, over, _1, _2) +import Control.Lens (mapped, _1, _2) import Data.List qualified as List import Data.List.Extra qualified as List import Data.List.NonEmpty (NonEmpty ((:|))) diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index dbf2a8d866..acde4533fb 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -3,7 +3,7 @@ module Unison.Term where -import Control.Lens (Lens', Prism', lens, view, _2) +import Control.Lens (Lens', Prism', lens, _2) import Control.Monad.State (evalState) import Control.Monad.State qualified as State import Control.Monad.Writer.Strict qualified as Writer diff --git a/unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs b/unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs index e5b70d6bf6..7d1d67ce41 100644 --- a/unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs +++ b/unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs @@ -7,7 +7,7 @@ module Unison.Hashing.V2.DataDeclaration ) where -import Control.Lens (over, _3) +import Control.Lens (_3) import Data.Map qualified as Map import Unison.ABT qualified as ABT import Unison.Hash (Hash) diff --git a/unison-merge/src/Unison/Merge/CombineDiffs.hs b/unison-merge/src/Unison/Merge/CombineDiffs.hs index f1ede23144..c983eba79f 100644 --- a/unison-merge/src/Unison/Merge/CombineDiffs.hs +++ b/unison-merge/src/Unison/Merge/CombineDiffs.hs @@ -5,7 +5,6 @@ module Unison.Merge.CombineDiffs ) where -import Control.Lens (view) import Data.Semialign (alignWith) import Data.These (These (..)) import Unison.Merge.DiffOp (DiffOp (..)) diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index b763d4e55a..c1fb581706 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -85,7 +85,7 @@ module Unison.Merge.DeclCoherencyCheck ) where -import Control.Lens (view, (%=), (.=)) +import Control.Lens ((%=), (.=)) import Control.Monad.Except (ExceptT) import Control.Monad.Except qualified as Except import Control.Monad.State.Strict (StateT) diff --git a/unison-merge/src/Unison/Merge/DeclNameLookup.hs b/unison-merge/src/Unison/Merge/DeclNameLookup.hs index c3e663172b..10a5a922da 100644 --- a/unison-merge/src/Unison/Merge/DeclNameLookup.hs +++ b/unison-merge/src/Unison/Merge/DeclNameLookup.hs @@ -6,7 +6,6 @@ module Unison.Merge.DeclNameLookup ) where -import Control.Lens (over) import Data.Map.Strict qualified as Map import Data.Semigroup.Generic (GenericSemigroupMonoid (..)) import Unison.DataDeclaration (Decl) diff --git a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs index 475b28f5c7..05787791f5 100644 --- a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs +++ b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs @@ -3,7 +3,7 @@ module Unison.Merge.PartitionCombinedDiffs ) where -import Control.Lens (Lens', over, view, (%~), (.~)) +import Control.Lens (Lens') import Data.Bitraversable (bitraverse) import Data.Map.Strict qualified as Map import Unison.Merge.CombineDiffs (CombinedDiffOp (..)) diff --git a/unison-merge/src/Unison/Merge/TwoWay.hs b/unison-merge/src/Unison/Merge/TwoWay.hs index e2b001f5b2..05640a3786 100644 --- a/unison-merge/src/Unison/Merge/TwoWay.hs +++ b/unison-merge/src/Unison/Merge/TwoWay.hs @@ -12,7 +12,7 @@ module Unison.Merge.TwoWay ) where -import Control.Lens (Lens', view) +import Control.Lens (Lens') import Data.Semialign (Semialign, alignWith) import Data.Semigroup.Generic (GenericSemigroupMonoid (..)) import Data.These (These (These)) diff --git a/unison-merge/src/Unison/Merge/Unconflicts.hs b/unison-merge/src/Unison/Merge/Unconflicts.hs index 21c6887795..e5411189a1 100644 --- a/unison-merge/src/Unison/Merge/Unconflicts.hs +++ b/unison-merge/src/Unison/Merge/Unconflicts.hs @@ -7,7 +7,6 @@ module Unison.Merge.Unconflicts ) where -import Control.Lens (view) import Data.Map.Strict qualified as Map import Unison.Merge.TwoWay (TwoWay) import Unison.Merge.TwoWayI (TwoWayI (..)) diff --git a/unison-share-api/src/Unison/Server/CodebaseServer.hs b/unison-share-api/src/Unison/Server/CodebaseServer.hs index eb2332dc7a..7ceef3c0fe 100644 --- a/unison-share-api/src/Unison/Server/CodebaseServer.hs +++ b/unison-share-api/src/Unison/Server/CodebaseServer.hs @@ -8,7 +8,6 @@ module Unison.Server.CodebaseServer where import Control.Concurrent (newEmptyMVar, putMVar, readMVar) import Control.Concurrent.Async (race) import Control.Exception (ErrorCall (..), throwIO) -import Control.Lens ((.~)) import Control.Monad.Reader import Control.Monad.Trans.Except import Data.Aeson () diff --git a/unison-share-api/src/Unison/Server/Doc.hs b/unison-share-api/src/Unison/Server/Doc.hs index 8fa9a98ae4..cd4c811ad3 100644 --- a/unison-share-api/src/Unison/Server/Doc.hs +++ b/unison-share-api/src/Unison/Server/Doc.hs @@ -8,7 +8,6 @@ module Unison.Server.Doc where -import Control.Lens (view, (^.)) import Control.Monad import Data.Aeson (ToJSON) import Data.Foldable From 0dcbc126a1084be813a7491165abfd6ce7a519a0 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 30 May 2024 15:21:47 -0700 Subject: [PATCH 045/631] Update all uses of internal branch0 fields --- .../src/Unison/Codebase/Branch.hs | 57 +++++++++---------- .../src/Unison/Codebase/Branch/Type.hs | 27 +++++++-- .../SqliteCodebase/Branch/Dependencies.hs | 13 ++--- .../src/Unison/Hashing/V2/Convert.hs | 8 +-- 4 files changed, 58 insertions(+), 47 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Branch.hs b/parser-typechecker/src/Unison/Codebase/Branch.hs index f57c585ed2..2e981501c9 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch.hs @@ -104,7 +104,7 @@ import U.Codebase.HashTags (CausalHash, PatchHash (..)) import Unison.Codebase.Branch.Raw (Raw) import Unison.Codebase.Branch.Type ( Branch (..), - Branch0 (..), + Branch0, NamespaceHash, Star, UnwrappedBranch, @@ -160,30 +160,29 @@ instance Hashing.ContentAddressable (Branch0 m) where -- | Remove any lib subtrees reachable within the branch. -- Note: This DOES affect the hash. withoutLib :: Branch0 m -> Branch0 m -withoutLib Branch0 {..} = - let newChildren = - _children - & imapMaybe - ( \nameSegment child -> - if nameSegment == NameSegment.libSegment - then Nothing - else Just (child & head_ %~ withoutLib) - ) - in branch0 _terms _types newChildren _edits +withoutLib b = + b + & children + %~ imapMaybe + ( \nameSegment child -> + if nameSegment == NameSegment.libSegment + then Nothing + else Just (child & head_ %~ withoutLib) + ) -- | Remove any transitive libs reachable within the branch. -- Note: This DOES affect the hash. withoutTransitiveLibs :: Branch0 m -> Branch0 m -withoutTransitiveLibs Branch0 {..} = +withoutTransitiveLibs b0 = let newChildren = - _children + (b0 ^. children) & imapMaybe ( \nameSegment child -> if nameSegment == NameSegment.libSegment then Just (child & head_ %~ withoutLib) else Just (child & head_ %~ withoutTransitiveLibs) ) - in branch0 _terms _types newChildren _edits + in b0 & children .~ newChildren -- | @deleteLibdep name branch@ deletes the libdep named @name@ from @branch@, if it exists. deleteLibdep :: NameSegment -> Branch0 m -> Branch0 m @@ -224,9 +223,9 @@ deepEdits' = go id where -- can change this to an actual prefix once Name is a [NameSegment] go :: (Name -> Name) -> Branch0 m -> Map Name (PatchHash, m Patch) - go addPrefix Branch0 {_children, _edits} = - Map.mapKeys (addPrefix . Name.fromSegment) _edits - <> foldMap f (Map.toList _children) + go addPrefix b0 = + Map.mapKeys (addPrefix . Name.fromSegment) (b0 ^. edits) + <> foldMap f (Map.toList (b0 ^. children)) where f :: (NameSegment, Branch m) -> Map Name (PatchHash, m Patch) f (c, b) = go (addPrefix . Name.cons c) (head b) @@ -252,7 +251,7 @@ toList0 = go Path.empty where go p b = (p, b) - : ( Map.toList (_children b) + : ( Map.toList (b ^. children) >>= ( \(seg, cb) -> go (Path.snoc p seg) (head cb) ) @@ -265,7 +264,7 @@ getAt :: Maybe (Branch m) getAt path root = case Path.uncons path of Nothing -> if isEmpty root then Nothing else Just root - Just (seg, path) -> case Map.lookup seg (_children $ head root) of + Just (seg, path) -> case Map.lookup seg (head root ^. children) of Just b -> getAt path b Nothing -> Nothing @@ -275,7 +274,7 @@ getAt' p b = fromMaybe empty $ getAt p b getAt0 :: Path -> Branch0 m -> Branch0 m getAt0 p b = case Path.uncons p of Nothing -> b - Just (seg, path) -> case Map.lookup seg (_children b) of + Just (seg, path) -> case Map.lookup seg (b ^. children) of Just c -> getAt0 path (head c) Nothing -> empty0 @@ -376,27 +375,27 @@ stepManyAtM actions startBranch = do -- starting at the leaves, apply `f` to every level of the branch. stepEverywhere :: (Applicative m) => (Branch0 m -> Branch0 m) -> (Branch0 m -> Branch0 m) -stepEverywhere f Branch0 {..} = f (branch0 _terms _types children _edits) +stepEverywhere f b0 = f (b0 & children %~ updates) where - children = fmap (step $ stepEverywhere f) _children + updates = fmap (step $ stepEverywhere f) -- Creates a function to fix up the children field._1 -- If the action emptied a child, then remove the mapping, -- otherwise update it. -- Todo: Fix this in hashing & serialization instead of here? getChildBranch :: NameSegment -> Branch0 m -> Branch m -getChildBranch seg b = fromMaybe empty $ Map.lookup seg (_children b) +getChildBranch seg b = fromMaybe empty $ Map.lookup seg (b ^. children) setChildBranch :: NameSegment -> Branch m -> Branch0 m -> Branch0 m setChildBranch seg b = over children (updateChildren seg b) getPatch :: (Applicative m) => NameSegment -> Branch0 m -> m Patch -getPatch seg b = case Map.lookup seg (_edits b) of +getPatch seg b = case Map.lookup seg (b ^. edits) of Nothing -> pure Patch.empty Just (_, p) -> p getMaybePatch :: (Applicative m) => NameSegment -> Branch0 m -> m (Maybe Patch) -getMaybePatch seg b = case Map.lookup seg (_edits b) of +getMaybePatch seg b = case Map.lookup seg (b ^. edits) of Nothing -> pure Nothing Just (_, p) -> Just <$> p @@ -570,10 +569,10 @@ transform f b = case _history b of transform0 :: (Functor m) => (forall a. m a -> n a) -> Branch0 m -> Branch0 n transform0 f b = - b - { _children = transform f <$> _children b, - _edits = second f <$> _edits b - } + branch0 (b ^. terms) (b ^. types) newChildren newEdits + where + newChildren = transform f <$> (b ^. children) + newEdits = second f <$> (b ^. edits) -- | Traverse the head branch of all direct children. -- The index of the traversal is the name of that child branch according to the parent. diff --git a/parser-typechecker/src/Unison/Codebase/Branch/Type.hs b/parser-typechecker/src/Unison/Codebase/Branch/Type.hs index 148707f568..a0692e5ab4 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch/Type.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch/Type.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} module Unison.Codebase.Branch.Type @@ -112,7 +113,13 @@ history :: Iso' (Branch m) (UnwrappedBranch m) history = iso _history Branch edits :: Lens' (Branch0 m) (Map NameSegment (PatchHash, m Patch)) -edits = lens _edits (\b0 e -> b0 {_edits = e}) +edits = + lens + _edits + ( \b0 e -> + b0 {_edits = e} + & deriveIsEmpty + ) terms :: Lens' (Branch0 m) (Star Referent NameSegment) terms = @@ -121,6 +128,7 @@ terms = \branch terms -> branch {_terms = terms} & deriveDeepTerms + & deriveIsEmpty types :: Lens' (Branch0 m) (Star TypeReference NameSegment) types = @@ -129,6 +137,7 @@ types = \branch types -> branch {_types = types} & deriveDeepTypes + & deriveIsEmpty isEmpty0 :: Branch0 m -> Bool isEmpty0 = _isEmpty0 @@ -168,11 +177,7 @@ branch0 terms types children edits = _types = types, _children = children, _edits = edits, - _isEmpty0 = - R.null (Star2.d1 terms) - && R.null (Star2.d1 types) - && Map.null edits - && all (isEmpty0 . head) children, + _isEmpty0 = False, -- These are all overwritten immediately _deepTerms = R.empty, _deepTypes = R.empty, @@ -183,6 +188,16 @@ branch0 terms types children edits = & deriveDeepTypes & deriveDeepPaths & deriveDeepEdits + & deriveIsEmpty + +deriveIsEmpty :: Branch0 m -> Branch0 m +deriveIsEmpty b0 = + let isEmpty' = + R.null (Star2.d1 $ _terms b0) + && R.null (Star2.d1 $ _types b0) + && Map.null (_edits b0) + && all (isEmpty0 . head) (_children b0) + in b0 {_isEmpty0 = isEmpty'} -- | Derive the 'deepTerms' field of a branch. deriveDeepTerms :: Branch0 m -> Branch0 m diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Branch/Dependencies.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Branch/Dependencies.hs index 5d33acc5b2..b4eeb72bad 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Branch/Dependencies.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Branch/Dependencies.hs @@ -5,13 +5,9 @@ module Unison.Codebase.SqliteCodebase.Branch.Dependencies where -import Data.Foldable (toList) -import Data.Map (Map) import Data.Map qualified as Map import Data.Semigroup.Generic (GenericSemigroupMonoid (..)) -import Data.Set (Set) import Data.Set qualified as Set -import GHC.Generics (Generic) import U.Codebase.HashTags (CausalHash, PatchHash) import Unison.Codebase.Branch.Type as Branch import Unison.Codebase.Causal qualified as Causal @@ -19,6 +15,7 @@ import Unison.Codebase.Patch (Patch) import Unison.ConstructorReference (GConstructorReference (..)) import Unison.Hash (Hash) import Unison.NameSegment (NameSegment) +import Unison.Prelude import Unison.Reference (Reference, pattern Derived) import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -58,10 +55,10 @@ fromBranch (Branch c) = case c of fromBranch0 :: (Applicative m) => Branch0 m -> (Branches m, Dependencies) fromBranch0 b = - ( fromChildren (Branch._children b), - fromTermsStar (Branch._terms b) - <> fromTypesStar (Branch._types b) - <> fromEdits (Branch._edits b) + ( fromChildren (b ^. Branch.children), + fromTermsStar (b ^. Branch.terms) + <> fromTypesStar (b ^. Branch.types) + <> fromEdits (b ^. Branch.edits) ) where fromChildren :: (Applicative m) => Map NameSegment (Branch m) -> Branches m diff --git a/parser-typechecker/src/Unison/Hashing/V2/Convert.hs b/parser-typechecker/src/Unison/Hashing/V2/Convert.hs index fd6b68896c..62d067cec4 100644 --- a/parser-typechecker/src/Unison/Hashing/V2/Convert.hs +++ b/parser-typechecker/src/Unison/Hashing/V2/Convert.hs @@ -361,10 +361,10 @@ hashCausal e tails = m2hBranch0 :: Memory.Branch.Branch0 m -> Hashing.Branch m2hBranch0 b = Hashing.Branch - (doTerms (Memory.Branch._terms b)) - (doTypes (Memory.Branch._types b)) - (doPatches (Memory.Branch._edits b)) - (doChildren (Memory.Branch._children b)) + (doTerms (b ^. Memory.Branch.terms)) + (doTypes (b ^. Memory.Branch.types)) + (doPatches (b ^. Memory.Branch.edits)) + (doChildren (b ^. Memory.Branch.children)) where -- is there a more readable way to structure these that's also linear? doTerms :: From 2c8904a3112c6f2159c89e6d580442815c523691 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Fri, 31 May 2024 11:35:03 -0400 Subject: [PATCH 046/631] make `auth.login` visible --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 68ef17b173..5069db9013 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2867,7 +2867,7 @@ authLogin = InputPattern "auth.login" [] - I.Hidden + I.Visible [] ( P.lines [ P.wrap "Obtain an authentication session with Unison Share.", From f2bc1bde2246d93d4b1f6633c2f594d2d1df6b51 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Fri, 31 May 2024 11:59:21 -0400 Subject: [PATCH 047/631] Update .mergify.yml --- .mergify.yml | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/.mergify.yml b/.mergify.yml index 06be4d2a68..5b7829eff3 100644 --- a/.mergify.yml +++ b/.mergify.yml @@ -11,9 +11,12 @@ pull_request_rules: - check-success=run interpreter tests (macOS-12) # - check-success=run interpreter tests (windows-2019) - check-success=generate jit source - - check-success=build jit binary (ubuntu-20.04) - - check-success=build jit binary (macOS-12) - - check-success=build jit binary (windows-2019) + - check-success=build jit binary / build jit binary (ubuntu-20.04) + - check-success=build jit binary / build jit binary (macOS-12) + - check-success=build jit binary / build jit binary (windows-2019) + - check-success=test jit / test jit (ubuntu-20.04) + - check-success=test jit / test jit (macOS-12) + # - check-success=test jit / test jit (windows-2019) - label=ready-to-merge - "#approved-reviews-by>=1" actions: From 899be60f5a87186394a91d45c9ac75a5bbd9cc21 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 31 May 2024 14:34:47 -0400 Subject: [PATCH 048/631] improve merge precondition violation output messages --- .../Codebase/Editor/HandleInput/Merge2.hs | 4 +- .../src/Unison/Codebase/Editor/Output.hs | 2 +- .../src/Unison/CommandLine/OutputMessages.hs | 151 +++++++++++++----- .../src/Unison/Merge/DeclCoherencyCheck.hs | 4 +- unison-src/transcripts/merge.output.md | 74 +++++++-- 5 files changed, 176 insertions(+), 59 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 5c8a7b0147..7e87a1cbc2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -281,8 +281,8 @@ doMerge info = do declNameLookup <- Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) & onLeftM \err -> Cli.returnEarly case err of - IncoherentDeclReason'ConstructorAlias name1 name2 -> - Output.MergeConstructorAlias who name1 name2 + IncoherentDeclReason'ConstructorAlias typeName conName1 conName2 -> + Output.MergeConstructorAlias who typeName conName1 conName2 IncoherentDeclReason'MissingConstructorName name -> Output.MergeMissingConstructorName who name IncoherentDeclReason'NestedDeclAlias shorterName longerName -> Output.MergeNestedDeclAlias who shorterName longerName diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 24f3ae0448..45d252a0d8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -399,7 +399,7 @@ data Output | MergeConflictedTermName !Name !(NESet Referent) | MergeConflictedTypeName !Name !(NESet TypeReference) | MergeConflictInvolvingBuiltin !Name - | MergeConstructorAlias !MergeSourceOrTarget !Name !Name + | MergeConstructorAlias !MergeSourceOrTarget !Name !Name !Name | MergeDefnsInLib !MergeSourceOrTarget | MergeMissingConstructorName !MergeSourceOrTarget !Name | MergeNestedDeclAlias !MergeSourceOrTarget !Name !Name diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 5155578581..66824fccdf 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1344,13 +1344,43 @@ notifyUser dir = \case <> "was already up-to-date with" <> P.group (prettyMergeSource aliceAndBob.bob <> ".") MergeConflictedAliases aliceOrBob name1 name2 -> - pure . P.wrap $ - "On" - <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") - <> prettyName name1 - <> "and" - <> prettyName name2 - <> "are not aliases, but they used to be." + pure $ + P.wrap "Sorry, I wasn't able to perform the merge:" + <> P.newline + <> P.newline + <> P.wrap + ( "On the merge ancestor," + <> prettyName name1 + <> "and" + <> prettyName name2 + <> "were aliases for the same definition, but on" + <> prettyMergeSourceOrTarget aliceOrBob + <> "the names have different definitions currently. I'd need just a single new definition to use in their" + <> "dependents when I merge." + ) + <> P.newline + <> P.newline + <> P.wrap ("Please fix up" <> prettyMergeSourceOrTarget aliceOrBob <> "to resolve this. For example,") + <> P.newline + <> P.newline + <> P.indentN + 2 + ( P.bulleted + [ P.wrap + ( IP.makeExample' IP.update + <> "the definitions to be the same again, so that there's nothing for me to decide." + ), + P.wrap + ( IP.makeExample' IP.moveAll + <> "or" + <> IP.makeExample' IP.delete + <> "all but one of the definitions; I'll use the remaining name when propagating updates." + ) + ] + ) + <> P.newline + <> P.newline + <> P.wrap "and then try merging again." MergeConflictedTermName name _refs -> pure . P.wrap $ "The term name" <> prettyName name <> "is ambiguous. Please resolve the ambiguity before merging." @@ -1358,31 +1388,66 @@ notifyUser dir = \case pure . P.wrap $ "The type name" <> prettyName name <> "is ambiguous. Please resolve the ambiguity before merging." MergeConflictInvolvingBuiltin name -> - pure . P.wrap $ - "There's a merge conflict on" - <> P.group (prettyName name <> ",") - <> "but it's a builtin on one or both branches. We can't yet handle merge conflicts on builtins." - MergeConstructorAlias aliceOrBob name1 name2 -> - pure . P.wrap $ - "On" - <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") - <> prettyName name1 - <> "and" - <> prettyName name2 - <> "are aliases. Every type declaration must have exactly one name for each constructor." + pure . P.lines $ + [ P.wrap "Sorry, I wasn't able to perform the merge:", + "", + P.wrap + ( "There's a merge conflict on" + <> P.group (prettyName name <> ",") + <> "but it's a builtin on one or both branches. I can't yet handle merge conflicts involving builtins." + ), + "", + P.wrap + ( "Please eliminate this conflict by updating one branch or the other, making" + <> prettyName name + <> "the same on both branches, or making neither of them a builtin, and then try the merge again." + ) + ] + MergeConstructorAlias aliceOrBob typeName conName1 conName2 -> + pure . P.lines $ + [ P.wrap "Sorry, I wasn't able to perform the merge:", + "", + P.wrap $ + "On" + <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + <> "the type" + <> prettyName typeName + <> "has a constructor with multiple names, and I can't perform a merge in this situation:", + "", + P.indentN 2 (P.bulleted [prettyName conName1, prettyName conName2]), + "", + P.wrap "Please delete all but one name for each constructor, and then try merging again." + ] MergeDefnsInLib aliceOrBob -> - pure . P.wrap $ - "On" - <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") - <> "there's a type or term directly in the `lib` namespace, but I expected only library dependencies to be in there." - <> "Please remove it before merging." + pure . P.lines $ + [ P.wrap "Sorry, I wasn't able to perform the merge:", + "", + P.wrap $ + "On" + <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + <> "there's a type or term at the top level of the `lib` namespace, where I only expect to find" + <> "subnamespaces representing library dependencies.", + "", + P.wrap "Please move or remove it and then try merging again." + ] MergeMissingConstructorName aliceOrBob name -> - pure . P.wrap $ - "On" - <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") - <> "the type" - <> prettyName name - <> "is missing a name for one of its constructors. Please add one before merging." + pure . P.lines $ + [ P.wrap "Sorry, I wasn't able to perform the merge:", + "", + P.wrap $ + "On" + <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + <> "the type" + <> prettyName name + <> "has some constructors with missing names, and I can't perform a merge in this situation.", + "", + P.wrap $ + "You can use" + <> IP.makeExample IP.view [prettyName name] + <> "and" + <> IP.makeExample IP.aliasTerm ["", prettyName name <> "."] + <> "to give names to each unnamed constructor, and then try the merge again." + ] MergeNestedDeclAlias aliceOrBob shorterName longerName -> pure . P.wrap $ "On" @@ -1391,15 +1456,25 @@ notifyUser dir = \case <> prettyName longerName <> "is an alias of" <> P.group (prettyName shorterName <> ".") - <> "Type aliases cannot be nested. Please make them disjoint before merging." + <> "I'm not able to perform a merge when a type exists nested under an alias of itself. Please separate them or" + <> "delete one copy, and then try merging again." MergeStrayConstructor aliceOrBob name -> - pure . P.wrap $ - "On" - <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") - <> "the constructor" - <> prettyName name - <> "is not in a subnamespace of a name of its type." - <> "Please either delete it or rename it before merging." + pure . P.lines $ + [ P.wrap $ + "Sorry, I wasn't able to perform the merge, because I need all constructor names to be nested somewhere" + <> "beneath the corresponding type name.", + "", + P.wrap $ + "On" + <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + <> "the constructor" + <> prettyName name + <> "is not nested beneath the corresponding type name. Please either use" + <> IP.makeExample' IP.moveAll + <> "to move it, or if it's an extra copy, you can simply" + <> IP.makeExample' IP.delete + <> "it. Then try the merge again." + ] PreviewMergeAlreadyUpToDate src dest -> pure . P.callout "😶" $ P.wrap $ diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index b62b9f44dc..b2780772da 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -120,7 +120,7 @@ data IncoherentDeclReason -- Foo#Foo -- Foo.Bar#Foo#0 -- Foo.Some.Other.Name.For.Bar#Foo#0 - IncoherentDeclReason'ConstructorAlias !Name !Name + IncoherentDeclReason'ConstructorAlias !Name !Name !Name -- type, first constructor, second constructor | IncoherentDeclReason'MissingConstructorName !Name | -- | A second naming of a decl was discovered underneath its name, e.g. -- @@ -161,7 +161,7 @@ checkDeclCoherency loadDeclNumConstructors = Nothing -> Left (IncoherentDeclReason'StrayConstructor name1) Just (typeName, expected) -> case recordConstructorName conId name1 expected of - Left existingName -> Left (IncoherentDeclReason'ConstructorAlias existingName name1) + Left existingName -> Left (IncoherentDeclReason'ConstructorAlias typeName existingName name1) Right expected1 -> Right (typeName, expected1) where name1 = fullName name diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index ba3ab0d031..90412693d7 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -964,8 +964,21 @@ baz = "baz" ```ucm project/alice> merge /bob - On project/alice, bar and foo are not aliases, but they used - to be. + Sorry, I wasn't able to perform the merge: + + On the merge ancestor, bar and foo were aliases for the same + definition, but on project/alice the names have different + definitions currently. I'd need just a single new definition + to use in their dependents when I merge. + + Please fix up project/alice to resolve this. For example, + + * `update` the definitions to be the same again, so that + there's nothing for me to decide. + * `move` or `delete` all but one of the definitions; I'll + use the remaining name when propagating updates. + + and then try merging again. ``` ### Conflict involving builtin @@ -990,9 +1003,15 @@ unique type MyNat = MyNat Nat ```ucm project/alice> merge /bob + Sorry, I wasn't able to perform the merge: + There's a merge conflict on MyNat, but it's a builtin on one - or both branches. We can't yet handle merge conflicts on + or both branches. I can't yet handle merge conflicts involving builtins. + + Please eliminate this conflict by updating one branch or the + other, making MyNat the same on both branches, or making + neither of them a builtin, and then try the merge again. ``` ### Constructor alias @@ -1019,9 +1038,16 @@ bob = 100 ```ucm project/alice> merge /bob - On project/alice, Foo.Bar and Foo.some.other.Alias are - aliases. Every type declaration must have exactly one name for - each constructor. + Sorry, I wasn't able to perform the merge: + + On project/alice, the type Foo has a constructor with multiple + names, and I can't perform a merge in this situation: + + * Foo.Bar + * Foo.some.other.Alias + + Please delete all but one name for each constructor, and then + try merging again. ``` ### Missing constructor name @@ -1048,8 +1074,14 @@ bob = 100 ```ucm project/alice> merge /bob - On project/alice, the type Foo is missing a name for one of - its constructors. Please add one before merging. + Sorry, I wasn't able to perform the merge: + + On project/alice, the type Foo has some constructors with + missing names, and I can't perform a merge in this situation. + + You can use `view Foo` and + `alias.term Foo.` to give names to + each unnamed constructor, and then try the merge again. ``` ### Nested decl alias @@ -1081,9 +1113,10 @@ bob = 100 ```ucm project/alice> merge /bob - On project/alice, the type A.inner.X is an alias of A. Type - aliases cannot be nested. Please make them disjoint before - merging. + On project/alice, the type A.inner.X is an alias of A. I'm not + able to perform a merge when a type exists nested under an + alias of itself. Please separate them or delete one copy, and + then try merging again. ``` ### Stray constructor alias @@ -1115,9 +1148,14 @@ project/bob> add ```ucm project/alice> merge bob + Sorry, I wasn't able to perform the merge, because I need all + constructor names to be nested somewhere beneath the + corresponding type name. + On project/alice, the constructor AliasOutsideFooNamespace is - not in a subnamespace of a name of its type. Please either - delete it or rename it before merging. + not nested beneath the corresponding type name. Please either + use `move` to move it, or if it's an extra copy, you can + simply `delete` it. Then try the merge again. ``` ### Term or type in `lib` @@ -1139,9 +1177,13 @@ bob = 100 ```ucm project/alice> merge /bob - On project/alice, there's a type or term directly in the `lib` - namespace, but I expected only library dependencies to be in - there. Please remove it before merging. + Sorry, I wasn't able to perform the merge: + + On project/alice, there's a type or term at the top level of + the `lib` namespace, where I only expect to find subnamespaces + representing library dependencies. + + Please move or remove it and then try merging again. ``` ## LCA precondition violations From 42a40c7c46c5740d2832056559725b9f14d01d23 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 31 May 2024 14:11:05 -0600 Subject: [PATCH 049/631] Add a `TypeError` for `IsString NameSegment` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit We don’t want someone to come along and add this instance without thinking about it. --- codebase2/core/Unison/NameSegment/Internal.hs | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/codebase2/core/Unison/NameSegment/Internal.hs b/codebase2/core/Unison/NameSegment/Internal.hs index 5c3825d04d..9ecc1ff43b 100644 --- a/codebase2/core/Unison/NameSegment/Internal.hs +++ b/codebase2/core/Unison/NameSegment/Internal.hs @@ -1,11 +1,17 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + -- | This module exposes the underlying representation of `NameSegment`, and -- thus should only be imported by parsers & printers. module Unison.NameSegment.Internal (NameSegment (..)) where +import GHC.TypeLits (ErrorMessage ((:$$:)), TypeError) +import GHC.TypeLits qualified as TypeError (ErrorMessage (Text)) import Unison.Prelude import Unison.Util.Alphabetical (Alphabetical) --- Represents the parts of a name between the `.`s +-- | Represents the parts of a name between the @.@s. newtype NameSegment = NameSegment { -- | Convert a name segment to unescaped text. -- @@ -19,3 +25,14 @@ newtype NameSegment = NameSegment } deriving stock (Eq, Generic, Ord, Show) deriving newtype (Alphabetical) + +instance + TypeError + ( 'TypeError.Text "You cannot implicitly convert a ‘String’ to a ‘NameSegment’. If you need a" + ':$$: 'TypeError.Text "special-cased segment it should exist as a constant in" + ':$$: 'TypeError.Text "“Unison.NameSegment”, otherwise it should be parsed via" + ':$$: 'TypeError.Text "“Unison.Syntax.NameSegment”." + ) => + IsString NameSegment + where + fromString = undefined From ae70852257bd6ccbc5622cc6336b38d9d6e5b5ff Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 31 May 2024 14:11:51 -0600 Subject: [PATCH 050/631] Move sentinel segment names to `Unison.NameSegment` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit They don’t belong in `Unison.Syntax.NameSegment` because they are not part of the syntax – they are names stored in the codebase that need to match regardless of the syntax used. --- codebase2/core/Unison/NameSegment.hs | 70 +++++++++++++++++- .../src/Unison/Codebase/Editor/RemoteRepo.hs | 2 +- .../src/Unison/Syntax/DeclPrinter.hs | 2 +- .../src/Unison/Syntax/FileParser.hs | 2 +- .../src/Unison/Syntax/TermParser.hs | 9 ++- unison-cli/src/Unison/Cli/MonadUtils.hs | 2 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 1 + .../Codebase/Editor/HandleInput/InstallLib.hs | 3 +- .../Codebase/Editor/HandleInput/Merge2.hs | 2 +- .../Editor/HandleInput/ProjectCreate.hs | 2 +- .../Codebase/Editor/HandleInput/Pull.hs | 2 +- .../Codebase/Editor/HandleInput/Update2.hs | 6 +- .../src/Unison/CommandLine/OutputMessages.hs | 1 + unison-cli/src/Unison/LSP/Completion.hs | 4 +- unison-share-api/src/Unison/Server/Backend.hs | 21 ++++-- unison-share-api/src/Unison/Server/Local.hs | 2 +- unison-syntax/src/Unison/Syntax/Lexer.hs | 3 +- .../src/Unison/Syntax/NameSegment.hs | 73 +------------------ 18 files changed, 105 insertions(+), 102 deletions(-) diff --git a/codebase2/core/Unison/NameSegment.hs b/codebase2/core/Unison/NameSegment.hs index bca7db4149..d14f8c86b9 100644 --- a/codebase2/core/Unison/NameSegment.hs +++ b/codebase2/core/Unison/NameSegment.hs @@ -2,14 +2,78 @@ module Unison.NameSegment ( NameSegment, -- * Sentinel name segments + defaultPatchSegment, + docSegment, libSegment, + publicLooseCodeSegment, + baseSegment, + snocSegment, + consSegment, + concatSegment, + watchSegment, + setSegment, + modifySegment, + licenseSegment, + metadataSegment, + authorsSegment, + copyrightHoldersSegment, + guidSegment, + builtinSegment, ) where import Unison.NameSegment.Internal (NameSegment (NameSegment)) --- | --- --- __TODO__: This should live in "Unison.Syntax.NameSegment", but it’s currently used in unison-core. +------------------------------------------------------------------------------------------------------------------------ +-- special segment names + +defaultPatchSegment :: NameSegment +defaultPatchSegment = NameSegment "patch" + +docSegment :: NameSegment +docSegment = NameSegment "doc" + libSegment :: NameSegment libSegment = NameSegment "lib" + +publicLooseCodeSegment :: NameSegment +publicLooseCodeSegment = NameSegment "public" + +baseSegment :: NameSegment +baseSegment = NameSegment "base" + +snocSegment :: NameSegment +snocSegment = NameSegment ":+" + +consSegment :: NameSegment +consSegment = NameSegment "+:" + +concatSegment :: NameSegment +concatSegment = NameSegment "++" + +watchSegment :: NameSegment +watchSegment = NameSegment ">" + +setSegment :: NameSegment +setSegment = NameSegment "set" + +modifySegment :: NameSegment +modifySegment = NameSegment "modify" + +licenseSegment :: NameSegment +licenseSegment = NameSegment "License" + +metadataSegment :: NameSegment +metadataSegment = NameSegment "metadata" + +authorsSegment :: NameSegment +authorsSegment = NameSegment "authors" + +copyrightHoldersSegment :: NameSegment +copyrightHoldersSegment = NameSegment "copyrightHolders" + +guidSegment :: NameSegment +guidSegment = NameSegment "guid" + +builtinSegment :: NameSegment +builtinSegment = NameSegment "builtin" diff --git a/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs b/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs index 61f9ea0c43..00e5ddc55a 100644 --- a/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs +++ b/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs @@ -8,10 +8,10 @@ import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH +import Unison.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Share.Types -import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Util.Monoid qualified as Monoid data ReadRepo diff --git a/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs b/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs index ae5ed64cae..71668e70a5 100644 --- a/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs @@ -20,6 +20,7 @@ import Unison.DataDeclaration.Dependencies qualified as DD import Unison.HashQualified qualified as HQ import Unison.Name (Name) import Unison.Name qualified as Name +import Unison.NameSegment qualified as NameSegment import Unison.Prelude import Unison.PrettyPrintEnv (PrettyPrintEnv) import Unison.PrettyPrintEnv qualified as PPE @@ -30,7 +31,6 @@ import Unison.Referent qualified as Referent import Unison.Syntax.HashQualified qualified as HQ (toText) import Unison.Syntax.Name qualified as Name import Unison.Syntax.NamePrinter (prettyName, styleHashQualified'') -import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.TypePrinter (runPretty) import Unison.Syntax.TypePrinter qualified as TypePrinter import Unison.Syntax.Var qualified as Var (namespaced) diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 48d9e258a6..9d2c7f23f3 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -16,6 +16,7 @@ import Unison.DataDeclaration (DataDeclaration, EffectDeclaration) import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.Records (generateRecordAccessors) import Unison.Name qualified as Name +import Unison.NameSegment qualified as NameSegment import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names import Unison.NamesWithHistory qualified as Names @@ -26,7 +27,6 @@ import Unison.Reference (TypeReferenceId) import Unison.Syntax.DeclParser (declarations) import Unison.Syntax.Lexer qualified as L import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar) -import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser import Unison.Syntax.TermParser qualified as TermParser import Unison.Syntax.Var qualified as Var (namespaced) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index bf0e59a2b7..9a89624e6d 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -34,6 +34,7 @@ import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name +import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names @@ -994,10 +995,10 @@ seqOp :: (Ord v) => P v m Pattern.SeqOp seqOp = Pattern.Snoc <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.snocSegment))) - <|> Pattern.Cons - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment))) - <|> Pattern.Concat - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment))) + <|> Pattern.Cons + <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment))) + <|> Pattern.Concat + <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment))) term4 :: (Monad m, Var v) => TermP v m term4 = f <$> some termLeaf diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 4b52cccaec..ddccf48a2d 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -111,6 +111,7 @@ import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' import Unison.Name qualified as Name +import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Parser.Ann (Ann (..)) import Unison.Prelude @@ -119,7 +120,6 @@ import Unison.Referent (Referent) import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name (toText) -import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Term qualified as Term import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile) import Unison.UnisonFile qualified as UF diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 17a5ba8434..ae34404e1e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -133,6 +133,7 @@ import Unison.LabeledDependency qualified as LabeledDependency import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) +import Unison.NameSegment qualified as NameSegment import Unison.Names (Names (Names)) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs index ae9113c449..ee586d1274 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs @@ -24,6 +24,7 @@ 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 (libSegment) import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.Project @@ -35,7 +36,7 @@ import Unison.Project classifyProjectBranchName, projectNameToUserProjectSlugs, ) -import Unison.Syntax.NameSegment qualified as NameSegment (libSegment, unsafeParseText) +import Unison.Syntax.NameSegment qualified as NameSegment (unsafeParseText) handleInstallLib :: ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease) -> Cli () handleInstallLib (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName) = do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index a9a7fe1750..b15329c603 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -85,6 +85,7 @@ import Unison.Merge.Unconflicts qualified as Unconflicts import Unison.Merge.Updated (Updated (..)) import Unison.Name (Name) import Unison.Name qualified as Name +import Unison.NameSegment qualified as NameSegment import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.NameSegment.Internal qualified as NameSegment import Unison.Names (Names) @@ -104,7 +105,6 @@ import Unison.Sqlite qualified as Sqlite import Unison.Syntax.DeclPrinter (AccessorName) import Unison.Syntax.DeclPrinter qualified as DeclPrinter import Unison.Syntax.Name qualified as Name -import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.TermPrinter qualified as TermPrinter import Unison.Term (Term) import Unison.Type (Type) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs index a1b493f952..eaa8c2419e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs @@ -23,12 +23,12 @@ 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.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Share.API.Hash qualified as Share.API import Unison.Sqlite qualified as Sqlite import Unison.Sync.Common qualified as Sync.Common -import Unison.Syntax.NameSegment qualified as NameSegment import Witch (unsafeFrom) -- | Create a new project. diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index 7cebf20743..b67a03cf90 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -40,9 +40,9 @@ 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.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchNameOrLatestRelease (..), ProjectName) -import Unison.Syntax.NameSegment qualified as NameSegment import Witch (unsafeFrom) handlePull :: PullSourceTarget -> PullMode -> Verbosity.Verbosity -> Cli () diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 63ed7be542..0f58beb176 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -62,6 +62,7 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Name.Forward (ForwardName (..)) import Unison.Name.Forward qualified as ForwardName +import Unison.NameSegment qualified as NameSegment import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Names (Names (Names)) import Unison.Names qualified as Names @@ -81,7 +82,6 @@ import Unison.Result qualified as Result import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name -import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Type (Type) @@ -377,12 +377,12 @@ makeUnisonFile abort codebase doFindCtorNames defns = do overwriteConstructorNames name ed.toDataDecl <&> \ed' -> uf & #effectDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') Right dd -> overwriteConstructorNames name dd <&> \dd' -> uf & #dataDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') -- Constructor names are bogus when pulled from the database, so we set them to what they should be here overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index eda5422601..86e8b2bcf2 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -94,6 +94,7 @@ import Unison.HashQualified' qualified as HQ' import Unison.LabeledDependency as LD import Unison.Name (Name) import Unison.Name qualified as Name +import Unison.NameSegment qualified as NameSegment import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Names (Names (..)) import Unison.Names qualified as Names diff --git a/unison-cli/src/Unison/LSP/Completion.hs b/unison-cli/src/Unison/LSP/Completion.hs index f50aa9c266..129ba8bc54 100644 --- a/unison-cli/src/Unison/LSP/Completion.hs +++ b/unison-cli/src/Unison/LSP/Completion.hs @@ -32,7 +32,8 @@ import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment.Internal (NameSegment) +import Unison.NameSegment (NameSegment) +import Unison.NameSegment qualified as NameSegment import Unison.NameSegment.Internal qualified as NameSegment import Unison.Names (Names (..)) import Unison.Prelude @@ -44,7 +45,6 @@ import Unison.Runtime.IOSource qualified as IOSource import Unison.Syntax.DeclPrinter qualified as DeclPrinter import Unison.Syntax.HashQualified' qualified as HQ' (toText) import Unison.Syntax.Name qualified as Name (nameP, parseText, toText) -import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.TypePrinter qualified as TypePrinter import Unison.Util.Monoid qualified as Monoid import Unison.Util.Pretty qualified as Pretty diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs index 431dbb266a..ac0489be0b 100644 --- a/unison-share-api/src/Unison/Server/Backend.hs +++ b/unison-share-api/src/Unison/Server/Backend.hs @@ -134,6 +134,7 @@ import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) +import Unison.NameSegment qualified as NameSegment (docSegment, libSegment) import Unison.NameSegment.Internal qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names @@ -170,7 +171,7 @@ import Unison.Syntax.DeclPrinter qualified as DeclPrinter import Unison.Syntax.HashQualified' qualified as HQ' (toText) import Unison.Syntax.Name as Name (toText, unsafeParseText) import Unison.Syntax.NamePrinter qualified as NP -import Unison.Syntax.NameSegment qualified as NameSegment (docSegment, libSegment, toEscapedText) +import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText) import Unison.Syntax.TermPrinter qualified as TermPrinter import Unison.Syntax.TypePrinter qualified as TypePrinter import Unison.Term (Term) @@ -201,6 +202,10 @@ data ShallowListEntry v a | ShallowPatchEntry NameSegment deriving (Eq, Ord, Show, Generic) +-- __TODO__: This is only used for sorting, and it seems like it might be better +-- to avoid `Text` and instead +-- 1. compare as `Name` (using `Name.fromSegment`) and +-- 2. make that the `Ord` instance. listEntryName :: ShallowListEntry v a -> Text listEntryName = \case ShallowTermEntry te -> termEntryDisplayName te @@ -212,10 +217,10 @@ data BackendError = NoSuchNamespace Path.Absolute | -- Failed to parse path BadNamespace - -- | error message String - -- | namespace + -- ^ error message String + -- ^ namespace | CouldntExpandBranchHash ShortCausalHash | AmbiguousBranchHash ShortCausalHash (Set ShortCausalHash) | AmbiguousHashForDefinition ShortHash @@ -461,11 +466,11 @@ getTermTag codebase r sig = do V2Referent.Con ref _ -> Just <$> Codebase.runTransaction codebase (Codebase.getDeclType codebase ref) pure $ if - | isDoc -> Doc - | isTest -> Test - | Just CT.Effect <- constructorType -> Constructor Ability - | Just CT.Data <- constructorType -> Constructor Data - | otherwise -> Plain + | isDoc -> Doc + | isTest -> Test + | Just CT.Effect <- constructorType -> Constructor Ability + | Just CT.Data <- constructorType -> Constructor Data + | otherwise -> Plain getTypeTag :: (Var v) => diff --git a/unison-share-api/src/Unison/Server/Local.hs b/unison-share-api/src/Unison/Server/Local.hs index bf86a8a80e..91ba6269f4 100644 --- a/unison-share-api/src/Unison/Server/Local.hs +++ b/unison-share-api/src/Unison/Server/Local.hs @@ -14,10 +14,10 @@ import Unison.Codebase.Path import Unison.Codebase.Path qualified as Path import Unison.HashQualified qualified as HQ import Unison.Name (Name) +import Unison.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Server.Backend import Unison.Sqlite qualified as Sqlite -import Unison.Syntax.NameSegment qualified as NameSegment -- | Given an arbitrary query and perspective, find the name root the query belongs in, -- then return that root and the query relocated to that root. diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 4745e56578..9938e2e41c 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -51,6 +51,7 @@ import Unison.Lexer.Pos (Column, Line, Pos (Pos), column, line) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) +import Unison.NameSegment qualified as NameSegment (docSegment) import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.ShortHash (ShortHash) @@ -59,7 +60,7 @@ import Unison.Syntax.HashQualified' qualified as HQ' (toText) import Unison.Syntax.Lexer.Token (Token (..), posP, tokenP) import Unison.Syntax.Name qualified as Name (isSymboly, nameP, toText, unsafeParseText) import Unison.Syntax.NameSegment (symbolyIdChar, wordyIdChar, wordyIdStartChar) -import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..), docSegment, wordyP) +import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..), wordyP) import Unison.Syntax.ReservedWords (delimiters, typeModifiers, typeOrAbility) import Unison.Syntax.ShortHash qualified as ShortHash (shortHashP) import Unison.Util.Bytes qualified as Bytes diff --git a/unison-syntax/src/Unison/Syntax/NameSegment.hs b/unison-syntax/src/Unison/Syntax/NameSegment.hs index fed4381ec5..923b871137 100644 --- a/unison-syntax/src/Unison/Syntax/NameSegment.hs +++ b/unison-syntax/src/Unison/Syntax/NameSegment.hs @@ -1,25 +1,6 @@ -- | Utilities related to the parsing and printing of name segments using the default syntax. module Unison.Syntax.NameSegment - ( -- * Sentinel name segments - defaultPatchSegment, - docSegment, - libSegment, - publicLooseCodeSegment, - baseSegment, - snocSegment, - consSegment, - concatSegment, - watchSegment, - setSegment, - modifySegment, - licenseSegment, - metadataSegment, - authorsSegment, - copyrightHoldersSegment, - guidSegment, - builtinSegment, - - -- * String conversions + ( -- * String conversions toEscapedText, toEscapedTextBuilder, parseText, @@ -52,64 +33,12 @@ import Text.Megaparsec (ParsecT) import Text.Megaparsec qualified as P import Text.Megaparsec.Char qualified as P import Text.Megaparsec.Internal qualified as P (withParsecT) -import Unison.NameSegment (libSegment) import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.Syntax.Lexer.Token (Token (..), posP) import Unison.Syntax.ReservedWords (keywords, reservedOperators) ------------------------------------------------------------------------------------------------------------------------- --- special segment names - -defaultPatchSegment :: NameSegment -defaultPatchSegment = NameSegment "patch" - -docSegment :: NameSegment -docSegment = NameSegment "doc" - -publicLooseCodeSegment :: NameSegment -publicLooseCodeSegment = NameSegment "public" - -baseSegment :: NameSegment -baseSegment = NameSegment "base" - -snocSegment :: NameSegment -snocSegment = NameSegment ":+" - -consSegment :: NameSegment -consSegment = NameSegment "+:" - -concatSegment :: NameSegment -concatSegment = NameSegment "++" - -watchSegment :: NameSegment -watchSegment = NameSegment ">" - -setSegment :: NameSegment -setSegment = NameSegment "set" - -modifySegment :: NameSegment -modifySegment = NameSegment "modify" - -licenseSegment :: NameSegment -licenseSegment = NameSegment "License" - -metadataSegment :: NameSegment -metadataSegment = NameSegment "metadata" - -authorsSegment :: NameSegment -authorsSegment = NameSegment "authors" - -copyrightHoldersSegment :: NameSegment -copyrightHoldersSegment = NameSegment "copyrightHolders" - -guidSegment :: NameSegment -guidSegment = NameSegment "guid" - -builtinSegment :: NameSegment -builtinSegment = NameSegment "builtin" - ------------------------------------------------------------------------------------------------------------------------ -- String conversions From 557bfe01edbf9bb48279066e8367e3a734391f78 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 31 May 2024 16:12:43 -0400 Subject: [PATCH 051/631] only use iohk cache on linux --- .github/workflows/nix-dev-cache.yaml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.github/workflows/nix-dev-cache.yaml b/.github/workflows/nix-dev-cache.yaml index 915b420908..e4e7aa4987 100644 --- a/.github/workflows/nix-dev-cache.yaml +++ b/.github/workflows/nix-dev-cache.yaml @@ -21,13 +21,17 @@ jobs: os: - ubuntu-20.04 - macOS-12 + - macOS-14 steps: - uses: actions/checkout@v4 - uses: cachix/install-nix-action@v27 + if: runner.os == 'Linux' with: extra_nix_config: | extra-trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= extra-substituters = https://cache.iog.io + - uses: cachix/install-nix-action@v27 + if: runner.os != 'Linux' - uses: cachix/cachix-action@v15 with: name: unison From c2515821c51b047ac9041334e565a041acb1e8d8 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 31 May 2024 14:16:35 -0600 Subject: [PATCH 052/631] Fix formatting that implies wrong precedence I think this was due to an Ormolu version mismatch. Ormolu is happy with this change, so I think it was originally refomatted before I was using Ormolu from the Unison Nix environment. --- .../src/Unison/Codebase/Editor/UriParser.hs | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs index 954d5d85e7..8a38004686 100644 --- a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs +++ b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs @@ -62,12 +62,9 @@ type P = P.Parsec Void Text.Text readRemoteNamespaceParser :: ProjectBranchSpecifier branch -> P (ReadRemoteNamespace (These ProjectName branch)) readRemoteNamespaceParser specifier = P.label "generic repo" $ - ReadRemoteNamespaceGit - <$> readGitRemoteNamespace - <|> ReadShare'ProjectBranch - <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier - <|> ReadShare'LooseCode - <$> readShareLooseCode + ReadRemoteNamespaceGit <$> readGitRemoteNamespace + <|> ReadShare'ProjectBranch <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier + <|> ReadShare'LooseCode <$> readShareLooseCode projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths :: ProjectBranchSpecifier branch -> @@ -95,12 +92,9 @@ writeRemoteNamespace = writeRemoteNamespaceWith :: P a -> P (WriteRemoteNamespace a) writeRemoteNamespaceWith projectBranchParser = - WriteRemoteNamespaceGit - <$> writeGitRemoteNamespace - <|> WriteRemoteProjectBranch - <$> projectBranchParser - <|> WriteRemoteNamespaceShare - <$> writeShareRemoteNamespace + WriteRemoteNamespaceGit <$> writeGitRemoteNamespace + <|> WriteRemoteProjectBranch <$> projectBranchParser + <|> WriteRemoteNamespaceShare <$> writeShareRemoteNamespace -- >>> P.parseMaybe writeShareRemoteNamespace "unisonweb.base._releases.M4" -- Just (WriteShareRemoteNamespace {server = ShareRepo, repo = "unisonweb", path = base._releases.M4}) From f7871c765fb25f4fd78f2858f41624b2ca7ef989 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Sat, 1 Jun 2024 01:52:19 -0600 Subject: [PATCH 053/631] Add a Nix formatter MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This sets the flake’s `formatter` output to [Alejandra](https://kamadorueda.com/alejandra/). --- flake.nix | 2 ++ 1 file changed, 2 insertions(+) diff --git a/flake.nix b/flake.nix index 740109dd10..83e884123d 100644 --- a/flake.nix +++ b/flake.nix @@ -133,5 +133,7 @@ // { default = self.devShells."${system}".only-tools-nixpkgs; }; + + formatter = pkgs.alejandra; }); } From a188bb0e5b71b66faf6637017860f151ad0d3bfb Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 31 May 2024 16:04:37 -0600 Subject: [PATCH 054/631] Run the Nix formatter for the first time --- flake.nix | 220 +++++++++++++++++++----------------- nix/docker.nix | 9 +- nix/haskell-nix-flake.nix | 69 ++++++----- nix/haskell-nix-overlay.nix | 43 ++++--- nix/nixpkgs-overlay.nix | 46 ++++---- nix/unison-overlay.nix | 19 ++-- 6 files changed, 210 insertions(+), 196 deletions(-) diff --git a/flake.nix b/flake.nix index 83e884123d..15c0ac5a44 100644 --- a/flake.nix +++ b/flake.nix @@ -1,7 +1,7 @@ { description = "Unison"; nixConfig = { - extra-substituters = [ "https://unison.cachix.org" ]; + extra-substituters = ["https://unison.cachix.org"]; extra-trusted-public-keys = [ "unison.cachix.org-1:i1DUFkisRPVOyLp/vblDsbsObmyCviq/zs6eRuzth3k=" ]; @@ -16,124 +16,132 @@ flake = false; }; }; - outputs = { self, nixpkgs, flake-utils, haskellNix, flake-compat, nixpkgs-unstable }: + outputs = { + self, + nixpkgs, + flake-utils, + haskellNix, + flake-compat, + nixpkgs-unstable, + }: flake-utils.lib.eachSystem [ "x86_64-linux" "x86_64-darwin" "aarch64-darwin" ] - (system: - let - versions = { - ghc = "928"; - ormolu = "0.5.2.0"; - hls = "2.4.0.0"; - stack = "2.13.1"; - hpack = "0.35.2"; - }; - overlays = [ - haskellNix.overlay - (import ./nix/haskell-nix-overlay.nix) - (import ./nix/unison-overlay.nix) - ]; - pkgs = import nixpkgs { - inherit system overlays; - inherit (haskellNix) config; - }; - haskell-nix-flake = import ./nix/haskell-nix-flake.nix { - inherit pkgs versions; - inherit (nixpkgs-packages) stack hpack; - }; - unstable = import nixpkgs-unstable { - inherit system; - overlays = [ - (import ./nix/unison-overlay.nix) - (import ./nix/nixpkgs-overlay.nix { inherit versions; }) + (system: let + versions = { + ghc = "928"; + ormolu = "0.5.2.0"; + hls = "2.4.0.0"; + stack = "2.13.1"; + hpack = "0.35.2"; + }; + overlays = [ + haskellNix.overlay + (import ./nix/haskell-nix-overlay.nix) + (import ./nix/unison-overlay.nix) + ]; + pkgs = import nixpkgs { + inherit system overlays; + inherit (haskellNix) config; + }; + haskell-nix-flake = import ./nix/haskell-nix-flake.nix { + inherit pkgs versions; + inherit (nixpkgs-packages) stack hpack; + }; + unstable = import nixpkgs-unstable { + inherit system; + overlays = [ + (import ./nix/unison-overlay.nix) + (import ./nix/nixpkgs-overlay.nix {inherit versions;}) + ]; + }; + nixpkgs-packages = let + hpkgs = unstable.haskell.packages.ghcunison; + exe = unstable.haskell.lib.justStaticExecutables; + in { + ghc = unstable.haskell.compiler."ghc${versions.ghc}"; + ormolu = exe hpkgs.ormolu; + hls = unstable.unison-hls; + stack = unstable.unison-stack; + unwrapped-stack = unstable.stack; + hpack = unstable.hpack; + }; + nixpkgs-devShells = { + only-tools-nixpkgs = unstable.mkShell { + name = "only-tools-nixpkgs"; + buildInputs = let + build-tools = with nixpkgs-packages; [ + ghc + ormolu + hls + stack + hpack ]; - }; - nixpkgs-packages = - let - hpkgs = unstable.haskell.packages.ghcunison; - exe = unstable.haskell.lib.justStaticExecutables; - in - { - ghc = unstable.haskell.compiler."ghc${versions.ghc}"; - ormolu = exe hpkgs.ormolu; - hls = unstable.unison-hls; - stack = unstable.unison-stack; - unwrapped-stack = unstable.stack; - hpack = unstable.hpack; + native-packages = + pkgs.lib.optionals pkgs.stdenv.isDarwin + (with unstable.darwin.apple_sdk.frameworks; [Cocoa]); + c-deps = with unstable; [pkg-config zlib glibcLocales]; + in + build-tools ++ c-deps ++ native-packages; + shellHook = '' + export LD_LIBRARY_PATH=${pkgs.zlib}/lib:$LD_LIBRARY_PATH + ''; + }; + }; + + renameAttrs = fn: + nixpkgs.lib.mapAttrs' (name: value: { + inherit value; + name = fn name; + }); + in + assert nixpkgs-packages.ormolu.version == versions.ormolu; + assert nixpkgs-packages.hls.version == versions.hls; + assert nixpkgs-packages.unwrapped-stack.version == versions.stack; + assert nixpkgs-packages.hpack.version == versions.hpack; { + packages = + nixpkgs-packages + // renameAttrs (name: "component-${name}") haskell-nix-flake.packages + // renameAttrs (name: "docker-${name}") (import ./nix/docker.nix { + inherit pkgs; + haskell-nix = haskell-nix-flake.packages; + }) + // { + default = haskell-nix-flake.defaultPackage; + build-tools = pkgs.symlinkJoin { + name = "build-tools"; + paths = self.devShells."${system}".only-tools-nixpkgs.buildInputs; }; - nixpkgs-devShells = { - only-tools-nixpkgs = unstable.mkShell { - name = "only-tools-nixpkgs"; - buildInputs = - let - build-tools = with nixpkgs-packages; [ - ghc - ormolu - hls - stack - hpack + all = pkgs.symlinkJoin { + name = "all"; + paths = let + all-other-packages = builtins.attrValues (builtins.removeAttrs self.packages."${system}" ["all" "build-tools"]); + devshell-inputs = + builtins.concatMap + (devShell: devShell.buildInputs ++ devShell.nativeBuildInputs) + [ + self.devShells."${system}".only-tools-nixpkgs ]; - native-packages = pkgs.lib.optionals pkgs.stdenv.isDarwin - (with unstable.darwin.apple_sdk.frameworks; - [ Cocoa ]); - c-deps = with unstable; - [ pkg-config zlib glibcLocales ]; - in - build-tools ++ c-deps ++ native-packages; - shellHook = '' - export LD_LIBRARY_PATH=${pkgs.zlib}/lib:$LD_LIBRARY_PATH - ''; + in + all-other-packages ++ devshell-inputs; }; }; - renameAttrs = fn: nixpkgs.lib.mapAttrs' (name: value: { - inherit value; - name = fn name;}); - in - assert nixpkgs-packages.ormolu.version == versions.ormolu; - assert nixpkgs-packages.hls.version == versions.hls; - assert nixpkgs-packages.unwrapped-stack.version == versions.stack; - assert nixpkgs-packages.hpack.version == versions.hpack; - { - packages = - nixpkgs-packages - // renameAttrs (name: "component-${name}") haskell-nix-flake.packages - // renameAttrs (name: "docker-${name}") (import ./nix/docker.nix { inherit pkgs; haskell-nix = haskell-nix-flake.packages; }) - // { - default = haskell-nix-flake.defaultPackage; - build-tools = pkgs.symlinkJoin { - name = "build-tools"; - paths = self.devShells."${system}".only-tools-nixpkgs.buildInputs; - }; - all = pkgs.symlinkJoin { - name = "all"; - paths = - let - all-other-packages = builtins.attrValues (builtins.removeAttrs self.packages."${system}" [ "all" "build-tools" ]); - devshell-inputs = builtins.concatMap - (devShell: devShell.buildInputs ++ devShell.nativeBuildInputs) - [ - self.devShells."${system}".only-tools-nixpkgs - ]; - in - all-other-packages ++ devshell-inputs; - }; - }; - - apps = renameAttrs (name: "component-${name}") haskell-nix-flake.apps // { + apps = + renameAttrs (name: "component-${name}") haskell-nix-flake.apps + // { default = self.apps."${system}"."component-unison-cli-main:exe:unison"; }; - devShells = - nixpkgs-devShells - // renameAttrs (name: "cabal-${name}") haskell-nix-flake.devShells - // { - default = self.devShells."${system}".only-tools-nixpkgs; - }; + devShells = + nixpkgs-devShells + // renameAttrs (name: "cabal-${name}") haskell-nix-flake.devShells + // { + default = self.devShells."${system}".only-tools-nixpkgs; + }; - formatter = pkgs.alejandra; - }); + formatter = pkgs.alejandra; + }); } diff --git a/nix/docker.nix b/nix/docker.nix index bfd4751e4f..5543d23dde 100644 --- a/nix/docker.nix +++ b/nix/docker.nix @@ -1,10 +1,11 @@ -{ pkgs, haskell-nix }: - { + pkgs, + haskell-nix, +}: { ucm = pkgs.dockerTools.buildLayeredImage { name = "ucm"; tag = "latest"; - contents = with pkgs; [ cacert fzf ]; - config.Cmd = [ "${haskell-nix."unison-cli-main:exe:unison"}/bin/unison" ]; + contents = with pkgs; [cacert fzf]; + config.Cmd = ["${haskell-nix."unison-cli-main:exe:unison"}/bin/unison"]; }; } diff --git a/nix/haskell-nix-flake.nix b/nix/haskell-nix-flake.nix index 03722dd6f6..de4c853047 100644 --- a/nix/haskell-nix-flake.nix +++ b/nix/haskell-nix-flake.nix @@ -1,27 +1,33 @@ -{ stack, hpack, pkgs, versions }: -let - haskell-nix-flake = pkgs.unison-project.flake { }; +{ + stack, + hpack, + pkgs, + versions, +}: let + haskell-nix-flake = pkgs.unison-project.flake {}; commonShellArgs = args: - args // { + args + // { # workaround: # https://github.com/input-output-hk/haskell.nix/issues/1793 # https://github.com/input-output-hk/haskell.nix/issues/1885 allToolDeps = false; - additional = hpkgs: with hpkgs; [ Cabal stm exceptions ghc ghc-heap ]; - buildInputs = - let - native-packages = pkgs.lib.optionals pkgs.stdenv.isDarwin - (with pkgs.darwin.apple_sdk.frameworks; [ Cocoa ]); - in - (args.buildInputs or [ ]) ++ [ stack hpack pkgs.pkg-config pkgs.zlib pkgs.glibcLocales ] ++ native-packages; + additional = hpkgs: with hpkgs; [Cabal stm exceptions ghc ghc-heap]; + buildInputs = let + native-packages = + pkgs.lib.optionals pkgs.stdenv.isDarwin + (with pkgs.darwin.apple_sdk.frameworks; [Cocoa]); + in + (args.buildInputs or []) ++ [stack hpack pkgs.pkg-config pkgs.zlib pkgs.glibcLocales] ++ native-packages; # workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/11042 shellHook = '' export LD_LIBRARY_PATH=${pkgs.zlib}/lib:$LD_LIBRARY_PATH ''; tools = - (args.tools or { }) // { - cabal = { }; - ormolu = { version = versions.ormolu; }; + (args.tools or {}) + // { + cabal = {}; + ormolu = {version = versions.ormolu;}; haskell-language-server = { version = versions.hls; modules = [ @@ -48,29 +54,30 @@ let localPackages = with pkgs.lib; filterAttrs (k: v: v.isLocal or false) pkgs.unison-project.hsPkgs; localPackageNames = builtins.attrNames localPackages; - devShells = - let - mkDevShell = pkgName: - shellFor { - packages = hpkgs: [ hpkgs."${pkgName}" ]; - withHoogle = true; - }; - localPackageDevShells = - pkgs.lib.genAttrs localPackageNames mkDevShell; - in + devShells = let + mkDevShell = pkgName: + shellFor { + packages = hpkgs: [hpkgs."${pkgName}"]; + withHoogle = true; + }; + localPackageDevShells = + pkgs.lib.genAttrs localPackageNames mkDevShell; + in { only-tools = shellFor { - packages = _: [ ]; + packages = _: []; withHoogle = false; }; local = shellFor { packages = hpkgs: (map (p: hpkgs."${p}") localPackageNames); withHoogle = false; }; - } // localPackageDevShells; + } + // localPackageDevShells; in -haskell-nix-flake // { - defaultPackage = haskell-nix-flake.packages."unison-cli-main:exe:unison"; - inherit (pkgs) unison-project; - inherit devShells localPackageNames; -} + haskell-nix-flake + // { + defaultPackage = haskell-nix-flake.packages."unison-cli-main:exe:unison"; + inherit (pkgs) unison-project; + inherit devShells localPackageNames; + } diff --git a/nix/haskell-nix-overlay.nix b/nix/haskell-nix-overlay.nix index 7f49ecb0f4..d6c3b52927 100644 --- a/nix/haskell-nix-overlay.nix +++ b/nix/haskell-nix-overlay.nix @@ -1,23 +1,20 @@ final: prev: { - unison-project = with prev.lib.strings; - let - cleanSource = pth: - let - src' = prev.lib.cleanSourceWith { - filter = filt; - src = pth; - }; - filt = path: type: - let - bn = baseNameOf path; - isHiddenFile = hasPrefix "." bn; - isFlakeLock = bn == "flake.lock"; - isNix = hasSuffix ".nix" bn; - in - !isHiddenFile && !isFlakeLock && !isNix; - in - src'; + unison-project = with prev.lib.strings; let + cleanSource = pth: let + src' = prev.lib.cleanSourceWith { + filter = filt; + src = pth; + }; + filt = path: type: let + bn = baseNameOf path; + isHiddenFile = hasPrefix "." bn; + isFlakeLock = bn == "flake.lock"; + isNix = hasSuffix ".nix" bn; + in + !isHiddenFile && !isFlakeLock && !isNix; in + src'; + in final.haskell-nix.project' { src = cleanSource ./..; projectFileName = "stack.yaml"; @@ -28,20 +25,18 @@ final: prev: { profilingDetail = "none"; } # remove buggy build tool dependencies - ({ lib, ... }: { + ({lib, ...}: { # this component has the build tool # `unison-cli:unison` and somehow haskell.nix # decides to add some file sharing package # `unison` as a build-tool dependency. packages.unison-cli.components.exes.cli-integration-tests.build-tools = - lib.mkForce [ ]; + lib.mkForce []; }) ]; branchMap = { - "https://github.com/unisonweb/configurator.git"."e47e9e9fe1f576f8c835183b9def52d73c01327a" = - "unison"; - "https://github.com/unisonweb/shellmet.git"."2fd348592c8f51bb4c0ca6ba4bc8e38668913746" = - "topic/avoid-callCommand"; + "https://github.com/unisonweb/configurator.git"."e47e9e9fe1f576f8c835183b9def52d73c01327a" = "unison"; + "https://github.com/unisonweb/shellmet.git"."2fd348592c8f51bb4c0ca6ba4bc8e38668913746" = "topic/avoid-callCommand"; }; }; } diff --git a/nix/nixpkgs-overlay.nix b/nix/nixpkgs-overlay.nix index 2a75e96f4b..033ee5e881 100644 --- a/nix/nixpkgs-overlay.nix +++ b/nix/nixpkgs-overlay.nix @@ -1,20 +1,24 @@ -{ versions }: -final: prev: { +{versions}: final: prev: { unison-hls = final.haskell-language-server.override { # build with our overridden haskellPackages that have our pinned # version of ormolu and hls haskellPackages = final.haskell.packages."ghc${versions.ghc}"; dynamic = true; - supportedGhcVersions = [ versions.ghc ]; + supportedGhcVersions = [versions.ghc]; }; - haskell = prev.haskell // { - packages = prev.haskell.packages // { - ghcunison = prev.haskell.packages."ghc${versions.ghc}".extend (hfinal: hprev: - let inherit (prev.haskell.lib) overrideCabal; in { - # dependency overrides for ormolu 0.5.2.0 - haskell-language-server = - let - p = hfinal.callHackageDirect + haskell = + prev.haskell + // { + packages = + prev.haskell.packages + // { + ghcunison = prev.haskell.packages."ghc${versions.ghc}".extend (hfinal: hprev: let + inherit (prev.haskell.lib) overrideCabal; + in { + # dependency overrides for ormolu 0.5.2.0 + haskell-language-server = let + p = + hfinal.callHackageDirect { pkg = "haskell-language-server"; ver = versions.hls; @@ -28,16 +32,18 @@ final: prev: { }; override = drv: { doCheck = false; - configureFlags = (drv.configureFlags or [ ]) ++ [ - "-f-fourmolu" - "-f-stylishhaskell" - "-f-hlint" - "-f-floskell" - ]; + configureFlags = + (drv.configureFlags or []) + ++ [ + "-f-fourmolu" + "-f-stylishhaskell" + "-f-hlint" + "-f-floskell" + ]; }; in - overrideCabal p override; - }); + overrideCabal p override; + }); + }; }; - }; } diff --git a/nix/unison-overlay.nix b/nix/unison-overlay.nix index 5033011d21..5f7f1a336d 100644 --- a/nix/unison-overlay.nix +++ b/nix/unison-overlay.nix @@ -3,16 +3,13 @@ final: prev: { # the nix provided ghc. unison-stack = prev.symlinkJoin { name = "stack"; - paths = [ final.stack ]; - buildInputs = [ final.makeWrapper ]; - postBuild = - let - flags = [ "--no-nix" "--system-ghc" "--no-install-ghc" ]; - add-flags = - "--add-flags '${prev.lib.concatStringsSep " " flags}'"; - in - '' - wrapProgram "$out/bin/stack" ${add-flags} - ''; + paths = [final.stack]; + buildInputs = [final.makeWrapper]; + postBuild = let + flags = ["--no-nix" "--system-ghc" "--no-install-ghc"]; + add-flags = "--add-flags '${prev.lib.concatStringsSep " " flags}'"; + in '' + wrapProgram "$out/bin/stack" ${add-flags} + ''; }; } From 07d9610ebab848225e6c0360875d42df693d6349 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Sat, 1 Jun 2024 01:58:38 -0600 Subject: [PATCH 055/631] A few minor manual formatting adjustments --- flake.nix | 15 ++++++--------- nix/haskell-nix-flake.nix | 3 +-- nix/haskell-nix-overlay.nix | 3 +-- 3 files changed, 8 insertions(+), 13 deletions(-) diff --git a/flake.nix b/flake.nix index 15c0ac5a44..9f92d6b769 100644 --- a/flake.nix +++ b/flake.nix @@ -1,11 +1,11 @@ { description = "Unison"; + nixConfig = { extra-substituters = ["https://unison.cachix.org"]; - extra-trusted-public-keys = [ - "unison.cachix.org-1:i1DUFkisRPVOyLp/vblDsbsObmyCviq/zs6eRuzth3k=" - ]; + extra-trusted-public-keys = ["unison.cachix.org-1:i1DUFkisRPVOyLp/vblDsbsObmyCviq/zs6eRuzth3k="]; }; + inputs = { haskellNix.url = "github:input-output-hk/haskell.nix"; nixpkgs.follows = "haskellNix/nixpkgs-unstable"; @@ -16,6 +16,7 @@ flake = false; }; }; + outputs = { self, nixpkgs, @@ -131,16 +132,12 @@ apps = renameAttrs (name: "component-${name}") haskell-nix-flake.apps - // { - default = self.apps."${system}"."component-unison-cli-main:exe:unison"; - }; + // {default = self.apps."${system}"."component-unison-cli-main:exe:unison";}; devShells = nixpkgs-devShells // renameAttrs (name: "cabal-${name}") haskell-nix-flake.devShells - // { - default = self.devShells."${system}".only-tools-nixpkgs; - }; + // {default = self.devShells."${system}".only-tools-nixpkgs;}; formatter = pkgs.alejandra; }); diff --git a/nix/haskell-nix-flake.nix b/nix/haskell-nix-flake.nix index de4c853047..f95b52925a 100644 --- a/nix/haskell-nix-flake.nix +++ b/nix/haskell-nix-flake.nix @@ -51,8 +51,7 @@ shellFor = args: pkgs.unison-project.shellFor (commonShellArgs args); - localPackages = with pkgs.lib; - filterAttrs (k: v: v.isLocal or false) pkgs.unison-project.hsPkgs; + localPackages = with pkgs.lib; filterAttrs (k: v: v.isLocal or false) pkgs.unison-project.hsPkgs; localPackageNames = builtins.attrNames localPackages; devShells = let mkDevShell = pkgName: diff --git a/nix/haskell-nix-overlay.nix b/nix/haskell-nix-overlay.nix index d6c3b52927..b98ee874f2 100644 --- a/nix/haskell-nix-overlay.nix +++ b/nix/haskell-nix-overlay.nix @@ -30,8 +30,7 @@ final: prev: { # `unison-cli:unison` and somehow haskell.nix # decides to add some file sharing package # `unison` as a build-tool dependency. - packages.unison-cli.components.exes.cli-integration-tests.build-tools = - lib.mkForce []; + packages.unison-cli.components.exes.cli-integration-tests.build-tools = lib.mkForce []; }) ]; branchMap = { From 635f0c9438c7bbaf9dd8aa0e80a60fe028b8e5aa Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Sat, 1 Jun 2024 02:41:45 -0600 Subject: [PATCH 056/631] Run Cabal test-suites as Nix checks --- flake.nix | 2 ++ nix/haskell-nix-flake.nix | 17 ++++++++++++++++- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/flake.nix b/flake.nix index 9f92d6b769..e970fe786c 100644 --- a/flake.nix +++ b/flake.nix @@ -139,6 +139,8 @@ // renameAttrs (name: "cabal-${name}") haskell-nix-flake.devShells // {default = self.devShells."${system}".only-tools-nixpkgs;}; + checks = renameAttrs (name: "component-${name}") haskell-nix-flake.checks; + formatter = pkgs.alejandra; }); } diff --git a/nix/haskell-nix-flake.nix b/nix/haskell-nix-flake.nix index f95b52925a..c0c992ae01 100644 --- a/nix/haskell-nix-flake.nix +++ b/nix/haskell-nix-flake.nix @@ -73,10 +73,25 @@ }; } // localPackageDevShells; + + checks = + haskell-nix-flake.checks + // { + ## This check has a test that tries to write to $HOME, so we give it a fake one. + "unison-cli:test:cli-tests" = haskell-nix-flake.checks."unison-cli:test:cli-tests".overrideAttrs (old: { + ## The builder here doesn’t `runHook preBuild`, so we just prepend onto `buildPhase`. + buildPhase = + '' + export HOME="$TMP/fake-home" + mkdir -p "$HOME" + '' + + old.buildPhase or ""; + }); + }; in haskell-nix-flake // { defaultPackage = haskell-nix-flake.packages."unison-cli-main:exe:unison"; inherit (pkgs) unison-project; - inherit devShells localPackageNames; + inherit checks devShells localPackageNames; } From f943ba157b66f6d1fd261810659316d676d43ca9 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 31 May 2024 16:19:16 -0600 Subject: [PATCH 057/631] Remove `flake-compat` input MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `flake-compat` is used to produce “old-style” default.nix and shell.nix files from a flake. We have neither and so this input is simply unused. --- flake.lock | 19 +------------------ flake.nix | 5 ----- 2 files changed, 1 insertion(+), 23 deletions(-) diff --git a/flake.lock b/flake.lock index 1b3f4dc42f..d4ece12a51 100644 --- a/flake.lock +++ b/flake.lock @@ -84,22 +84,6 @@ } }, "flake-compat": { - "flake": false, - "locked": { - "lastModified": 1696426674, - "narHash": "sha256-kvjfFW7WAETZlt09AgDn1MrtKzP7t90Vf7vypd3OL1U=", - "owner": "edolstra", - "repo": "flake-compat", - "rev": "0f9255e01c2351cc7d116c072cb317785dd33b33", - "type": "github" - }, - "original": { - "owner": "edolstra", - "repo": "flake-compat", - "type": "github" - } - }, - "flake-compat_2": { "flake": false, "locked": { "lastModified": 1672831974, @@ -211,7 +195,7 @@ "cabal-34": "cabal-34", "cabal-36": "cabal-36", "cardano-shell": "cardano-shell", - "flake-compat": "flake-compat_2", + "flake-compat": "flake-compat", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", "ghc98X": "ghc98X", "ghc99": "ghc99", @@ -609,7 +593,6 @@ }, "root": { "inputs": { - "flake-compat": "flake-compat", "flake-utils": "flake-utils", "haskellNix": "haskellNix", "nixpkgs": [ diff --git a/flake.nix b/flake.nix index 9f92d6b769..e551d5af4a 100644 --- a/flake.nix +++ b/flake.nix @@ -11,10 +11,6 @@ nixpkgs.follows = "haskellNix/nixpkgs-unstable"; nixpkgs-unstable.url = "github:NixOS/nixpkgs/nixos-unstable"; flake-utils.url = "github:numtide/flake-utils"; - flake-compat = { - url = "github:edolstra/flake-compat"; - flake = false; - }; }; outputs = { @@ -22,7 +18,6 @@ nixpkgs, flake-utils, haskellNix, - flake-compat, nixpkgs-unstable, }: flake-utils.lib.eachSystem [ From 7bbea72ba4e3d9c94ef877549eeeb396e436fedb Mon Sep 17 00:00:00 2001 From: Alistair Roche Date: Mon, 3 Jun 2024 08:04:32 +1000 Subject: [PATCH 058/631] Fix one-character typo in `add.run` docstring --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index f2016eeed5..1dadd9c016 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2725,7 +2725,7 @@ saveExecuteResult = I.Visible [("new name", Required, newNameArg)] ( "`add.run name` adds to the codebase the result of the most recent `run` command" - <> "as `name`." + <> " as `name`." ) $ \case [w] -> Input.SaveExecuteResultI <$> handleNameArg w From 95dd7c03c3e5773332a226581a570a1d80101cc8 Mon Sep 17 00:00:00 2001 From: Alistair Roche Date: Mon, 3 Jun 2024 08:14:21 +1000 Subject: [PATCH 059/631] Fix a few more typos in InputPatterns.hs --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 1dadd9c016..a10fa9c4c5 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1423,7 +1423,7 @@ cd = "descends into foo.bar from the current namespace." ), ( makeExample cd [".cat.dog"], - "sets the current namespace to the abolute namespace .cat.dog." + "sets the current namespace to the absolute namespace .cat.dog." ), ( makeExample cd [".."], "moves to the parent of the current namespace. E.g. moves from '.cat.dog' to '.cat'" @@ -2499,7 +2499,7 @@ debugFileHashes = [] I.Visible [] - "View details about the most recent succesfully typechecked file." + "View details about the most recent successfully typechecked file." (const $ Right Input.DebugTypecheckedUnisonFileI) debugDumpNamespace :: InputPattern @@ -2994,7 +2994,7 @@ branchesInputPattern = help = P.wrapColumn2 [ ("`branches`", "lists all branches in the current project"), - ("`branches foo", "lists all branches in the project `foo`") + ("`branches foo`", "lists all branches in the project `foo`") ], parse = \case [] -> Right (Input.BranchesI Nothing) From fd1bea7713a387db35be1afd8a708b1f8ee85a79 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 3 Jun 2024 08:52:40 -0400 Subject: [PATCH 060/631] don't update in commit.merge --- .../src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs index 4f8abd347f..1c9061e5d1 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs @@ -12,7 +12,6 @@ import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Editor.HandleInput.DeleteBranch qualified as DeleteBranch import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge import Unison.Codebase.Editor.HandleInput.ProjectSwitch qualified as ProjectSwitch -import Unison.Codebase.Editor.HandleInput.Update2 qualified as Update import Unison.Codebase.Editor.Output qualified as Output import Unison.Merge.TwoWay (TwoWay (..)) import Unison.Prelude @@ -36,10 +35,6 @@ handleCommitMerge = do let parentProjectAndBranch = ProjectAndBranch mergeProjectAndBranch.project parentBranch - -- Run `update` - - Update.handleUpdate2 - -- Switch to the parent ProjectSwitch.switchToProjectBranch (ProjectUtils.justTheIds parentProjectAndBranch) From 0635baa784a265b56213fd6576f920e762fa6a4d Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 3 Jun 2024 09:45:21 -0400 Subject: [PATCH 061/631] improve upgrade failure message --- .../Codebase/Editor/HandleInput/Upgrade.hs | 11 ++-- .../src/Unison/Codebase/Editor/Output.hs | 2 +- .../src/Unison/CommandLine/OutputMessages.hs | 55 ++++++++++++++++--- .../transcripts/upgrade-sad-path.output.md | 17 ++++++ 4 files changed, 72 insertions(+), 13 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index aab5144e18..6db5d4e7ba 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -12,6 +12,8 @@ import Data.Set qualified as Set import Data.Text qualified as Text import Text.Builder qualified import U.Codebase.Sqlite.DbId (ProjectId) +import U.Codebase.Sqlite.Project qualified +import U.Codebase.Sqlite.ProjectBranch qualified import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli @@ -66,8 +68,8 @@ handleUpgrade oldName newName = do Cli.Env {codebase, writeSource} <- ask (projectAndBranch, _path) <- Cli.expectCurrentProjectBranch - let projectId = projectAndBranch ^. #project . #projectId - let projectPath = Cli.projectBranchPath (ProjectAndBranch projectId (projectAndBranch ^. #branch . #branchId)) + let projectId = projectAndBranch.project.projectId + let projectPath = Cli.projectBranchPath (ProjectAndBranch projectId projectAndBranch.branch.branchId) let oldPath = Path.resolve projectPath (Path.Relative (Path.fromList [NameSegment.libSegment, oldName])) let newPath = Path.resolve projectPath (Path.Relative (Path.fromList [NameSegment.libSegment, newName])) @@ -160,7 +162,7 @@ handleUpgrade oldName newName = do temporaryBranchId <- HandleInput.Branch.doCreateBranch (HandleInput.Branch.CreateFrom'Branch projectAndBranch) - (projectAndBranch ^. #project) + projectAndBranch.project temporaryBranchName textualDescriptionOfUpgrade let temporaryBranchPath = Path.unabsolute (Cli.projectBranchPath (ProjectAndBranch projectId temporaryBranchId)) @@ -170,7 +172,8 @@ handleUpgrade oldName newName = do Nothing -> "scratch.u" Just (file, _) -> file liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) - Cli.returnEarly (Output.UpgradeFailure scratchFilePath oldName newName) + Cli.returnEarly $ + Output.UpgradeFailure projectAndBranch.branch.name temporaryBranchName scratchFilePath oldName newName branchUpdates <- Cli.runTransactionWithRollback \abort -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index d30c8ef94d..a813de65d9 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -395,7 +395,7 @@ data Output | UpdateTypecheckingFailure | UpdateTypecheckingSuccess | UpdateIncompleteConstructorSet UpdateOrUpgrade Name (Map ConstructorId Name) (Maybe Int) - | UpgradeFailure !FilePath !NameSegment !NameSegment + | UpgradeFailure !ProjectBranchName !ProjectBranchName !FilePath !NameSegment !NameSegment | UpgradeSuccess !NameSegment !NameSegment | LooseCodePushDeprecated | MergeFailure !FilePath !MergeSourceAndTarget diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index d5e3918aa3..8c34131681 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2256,14 +2256,53 @@ notifyUser dir = \case <> operationName <> "again." ] - UpgradeFailure path old new -> - pure . P.wrap $ - "I couldn't automatically upgrade" - <> P.text (NameSegment.toEscapedText old) - <> "to" - <> P.group (P.text (NameSegment.toEscapedText new) <> ".") - <> "However, I've added the definitions that need attention to the top of" - <> P.group (prettyFilePath path <> ".") + UpgradeFailure main temp path old new -> + pure $ + P.lines + [ P.wrap $ + "I couldn't automatically upgrade" + <> P.text (NameSegment.toEscapedText old) + <> "to" + <> P.group (P.text (NameSegment.toEscapedText new) <> ".") + <> "However, I've added the definitions that need attention to the top of" + <> P.group (prettyFilePath path <> "."), + "", + P.wrap "When you're done, you cun run", + "", + P.indentN + 2 + ( P.bulleted + [ IP.makeExampleNoBackticks IP.projectSwitch [prettySlashProjectBranchName main], + IP.makeExampleNoBackticks IP.mergeInputPattern [prettySlashProjectBranchName temp], + IP.makeExampleNoBackticks IP.deleteBranch [prettySlashProjectBranchName temp] + ] + ), + "", + "or (equivalently)", + "", + P.indentN + 2 + ( P.bulleted + [ IP.makeExampleNoBackticks IP.upgradeCommitInputPattern [] + ] + ), + "", + P.wrap $ + "to merge your changes back into" + <> P.group (prettyProjectBranchName main <> ".") + <> "Or, if you'd like to abandon the upgrade instead, you can run", + "", + P.indentN + 2 + ( P.bulleted [IP.makeExampleNoBackticks IP.deleteBranch [prettySlashProjectBranchName temp]] + ), + "", + P.wrap $ + "to delete" + <> prettyProjectBranchName temp + <> "and switch back to" + <> P.group (prettyProjectBranchName main <> ".") + ] UpgradeSuccess old new -> pure . P.wrap $ "I upgraded" diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md index e4ed5187b5..9c1cd61b9e 100644 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ b/unison-src/transcripts/upgrade-sad-path.output.md @@ -35,6 +35,23 @@ proj/main> upgrade old new I couldn't automatically upgrade old to new. However, I've added the definitions that need attention to the top of scratch.u. + + When you're done, you cun run + + * switch /main + * merge /upgrade-old-to-new + * delete.branch /upgrade-old-to-new + + or (equivalently) + + * upgrade.commit + + to merge your changes back into main. Or, if you'd like to + abandon the upgrade instead, you can run + + * delete.branch /upgrade-old-to-new + + to delete upgrade-old-to-new and switch back to main. ``` ```unison:added-by-ucm scratch.u From 8b98add0aaafaf346183d8b750d415ce741fc7af Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 3 Jun 2024 10:09:26 -0400 Subject: [PATCH 062/631] fix typo --- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 2 +- unison-src/transcripts/upgrade-sad-path.output.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 8c34131681..5625569afe 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2267,7 +2267,7 @@ notifyUser dir = \case <> "However, I've added the definitions that need attention to the top of" <> P.group (prettyFilePath path <> "."), "", - P.wrap "When you're done, you cun run", + P.wrap "When you're done, you can run", "", P.indentN 2 diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md index 9c1cd61b9e..6f94eeb7a3 100644 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ b/unison-src/transcripts/upgrade-sad-path.output.md @@ -36,7 +36,7 @@ proj/main> upgrade old new added the definitions that need attention to the top of scratch.u. - When you're done, you cun run + When you're done, you can run * switch /main * merge /upgrade-old-to-new From 33c42db170ddbe5a192555c3113e9e31a2556eae Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 09:36:56 -0700 Subject: [PATCH 063/631] Fix weird added file --- Input.hs | 335 ------------------------------------------------------- 1 file changed, 335 deletions(-) delete mode 100644 Input.hs diff --git a/Input.hs b/Input.hs deleted file mode 100644 index 427d901fb4..0000000000 --- a/Input.hs +++ /dev/null @@ -1,335 +0,0 @@ -module Unison.Codebase.Editor.Input - ( Input (..), - BranchSourceI (..), - DiffNamespaceToPatchInput (..), - GistInput (..), - PullSourceTarget (..), - PushRemoteBranchInput (..), - PushSourceTarget (..), - PushSource (..), - TestInput (..), - Event (..), - OutputLocation (..), - PatchPath, - BranchId, - AbsBranchId, - UnresolvedProjectBranch, - parseBranchId, - parseBranchId2, - parseShortCausalHash, - HashOrHQSplit', - Insistence (..), - PullMode (..), - OptionalPatch (..), - FindScope (..), - ShowDefinitionScope (..), - IsGlobal, - DeleteOutput (..), - DeleteTarget (..), - ) -where - -import Data.List.NonEmpty (NonEmpty) -import Data.Text qualified as Text -import Data.These (These) -import Unison.Codebase.Branch.Merge qualified as Branch -import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteGitRepo, WriteRemoteNamespace) -import Unison.Codebase.Path (Path, Path') -import Unison.Codebase.Path qualified as Path -import Unison.Codebase.Path.Parse qualified as Path -import Unison.Codebase.PushBehavior (PushBehavior) -import Unison.Codebase.ShortCausalHash (ShortCausalHash) -import Unison.Codebase.ShortCausalHash qualified as SCH -import Unison.CommandLine.BranchRelativePath (BranchRelativePath, parseBranchRelativePath) -import Unison.HashQualified qualified as HQ -import Unison.Name (Name) -import Unison.NameSegment (NameSegment) -import Unison.Prelude -import Unison.Project (ProjectAndBranch, ProjectAndBranchNames, ProjectBranchName, ProjectBranchNameOrLatestRelease, ProjectName, Semver) -import Unison.ShortHash (ShortHash) -import Unison.Util.Pretty qualified as P - -data Event - = UnisonFileChanged SourceName Source - deriving stock (Show) - -type Source = Text -- "id x = x\nconst a b = a" - -type SourceName = Text -- "foo.u" or "buffer 7" - -type PatchPath = Path.Split' - -data OptionalPatch = NoPatch | DefaultPatch | UsePatch PatchPath - deriving (Eq, Ord, Show) - -type BranchId = Either ShortCausalHash Path' - --- | An unambiguous project branch name, use the current project name if not provided. -type UnresolvedProjectBranch = ProjectAndBranch (Maybe ProjectName) ProjectBranchName - -type AbsBranchId = Either ShortCausalHash Path.Absolute - -type HashOrHQSplit' = Either ShortHash Path.HQSplit' - --- | Should we force the operation or not? -data Insistence = Force | Try - deriving (Show, Eq) - -parseBranchId :: String -> Either Text BranchId -parseBranchId ('#' : s) = case SCH.fromText (Text.pack s) of - Nothing -> Left "Invalid hash, expected a base32hex string." - Just h -> pure $ Left h -parseBranchId s = Right <$> Path.parsePath' s - -parseBranchId2 :: String -> Either (P.Pretty P.ColorText) (Either ShortCausalHash BranchRelativePath) -parseBranchId2 ('#' : s) = case SCH.fromText (Text.pack s) of - Nothing -> Left "Invalid hash, expected a base32hex string." - Just h -> Right (Left h) -parseBranchId2 s = Right <$> parseBranchRelativePath s - -parseShortCausalHash :: String -> Either String ShortCausalHash -parseShortCausalHash ('#' : s) | Just sch <- SCH.fromText (Text.pack s) = Right sch -parseShortCausalHash _ = Left "Invalid hash, expected a base32hex string." - -data PullMode - = PullWithHistory - | PullWithoutHistory - deriving (Eq, Show) - -type IsGlobal = Bool - -data Input - = -- names stuff: - -- directory ops - -- `Link` must describe a repo and a source path within that repo. - -- clone w/o merge, error if would clobber - ForkLocalBranchI (Either ShortCausalHash BranchRelativePath) BranchRelativePath - | -- merge first causal into destination - MergeLocalBranchI UnresolvedProjectBranch (Maybe UnresolvedProjectBranch) Branch.MergeMode - | PreviewMergeLocalBranchI UnresolvedProjectBranch (Maybe UnresolvedProjectBranch) - | DiffNamespaceI BranchId BranchId -- old new - | PullI !PullSourceTarget !PullMode - | PushRemoteBranchI PushRemoteBranchInput - | ResetRootI (Either ShortCausalHash Path') - | ResetI - ( These - (Either ShortCausalHash Path') - (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - ) - (Maybe UnresolvedProjectBranch) - | -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? - -- Does it make sense to fork from not-the-root of a Github repo? - -- used in Welcome module to give directions to user - CreateMessage (P.Pretty P.ColorText) - | -- Change directory. - SwitchBranchI Path' - | UpI - | PopBranchI - | -- > names foo - -- > names foo.bar - -- > names .foo.bar - -- > names .foo.bar#asdflkjsdf - -- > names #sdflkjsdfhsdf - NamesI IsGlobal (HQ.HashQualified Name) - | AliasTermI HashOrHQSplit' Path.Split' - | AliasTypeI HashOrHQSplit' Path.Split' - | AliasManyI [Path.HQSplit] Path' - | MoveAllI Path.Path' Path.Path' - | -- Move = Rename; It's an HQSplit' not an HQSplit', meaning the arg has to have a name. - MoveTermI Path.HQSplit' Path.Split' - | MoveTypeI Path.HQSplit' Path.Split' - | MoveBranchI Path.Path' Path.Path' - | MovePatchI Path.Split' Path.Split' - | CopyPatchI Path.Split' Path.Split' - | -- delete = unname - DeleteI DeleteTarget - | -- edits stuff: - LoadI (Maybe FilePath) - | ClearI - | AddI (Set Name) - | PreviewAddI (Set Name) - | UpdateI OptionalPatch (Set Name) - | Update2I - | PreviewUpdateI (Set Name) - | TodoI (Maybe PatchPath) Path' - | PropagatePatchI PatchPath Path' - | ListEditsI (Maybe PatchPath) - | -- -- create and remove update directives - DeprecateTermI PatchPath Path.HQSplit' - | DeprecateTypeI PatchPath Path.HQSplit' - | ReplaceI (HQ.HashQualified Name) (HQ.HashQualified Name) (Maybe PatchPath) - | RemoveTermReplacementI (HQ.HashQualified Name) (Maybe PatchPath) - | RemoveTypeReplacementI (HQ.HashQualified Name) (Maybe PatchPath) - | UndoI - | -- First `Maybe Int` is cap on number of results, if any - -- Second `Maybe Int` is cap on diff elements shown, if any - HistoryI (Maybe Int) (Maybe Int) BranchId - | -- execute an IO thunk with args - ExecuteI Text [String] - | -- save the result of a previous Execute - SaveExecuteResultI Name - | -- execute an IO [Result] - IOTestI (HQ.HashQualified Name) - | -- execute all in-scope IO tests - IOTestAllI - | -- make a standalone binary file - MakeStandaloneI String (HQ.HashQualified Name) - | -- execute an IO thunk using scheme - ExecuteSchemeI Text [String] - | -- compile to a scheme file - CompileSchemeI Text (HQ.HashQualified Name) - | TestI TestInput - | CreateAuthorI NameSegment {- identifier -} Text {- name -} - | -- Display provided definitions. - DisplayI OutputLocation (NonEmpty (HQ.HashQualified Name)) - | -- Display docs for provided terms. - DocsI (NonEmpty Path.HQSplit') - | -- other - FindI Bool FindScope [String] -- FindI isVerbose findScope query - | FindShallowI Path' - | FindPatchI - | StructuredFindI FindScope (HQ.HashQualified Name) -- sfind findScope query - | StructuredFindReplaceI (HQ.HashQualified Name) -- sfind.replace rewriteQuery - | -- Show provided definitions. - ShowDefinitionI OutputLocation ShowDefinitionScope (NonEmpty (HQ.HashQualified Name)) - | ShowReflogI - | UpdateBuiltinsI - | MergeBuiltinsI (Maybe Path) - | MergeIOBuiltinsI (Maybe Path) - | ListDependenciesI (HQ.HashQualified Name) - | ListDependentsI (HQ.HashQualified Name) - | -- | List all external dependencies of a given namespace, or the current namespace if - -- no path is provided. - NamespaceDependenciesI (Maybe Path') - | DebugTabCompletionI [String] -- The raw arguments provided - | DebugFuzzyOptionsI String [String] -- cmd and arguments - | DebugFormatI - | DebugNumberedArgsI - | DebugTypecheckedUnisonFileI - | DebugDumpNamespacesI - | DebugDumpNamespaceSimpleI - | DebugTermI (Bool {- Verbose mode -}) (HQ.HashQualified Name) - | DebugTypeI (HQ.HashQualified Name) - | DebugLSPFoldRangesI - | DebugClearWatchI - | DebugDoctorI - | DebugNameDiffI ShortCausalHash ShortCausalHash - | QuitI - | ApiI - | UiI Path' - | DocToMarkdownI Name - | DocsToHtmlI Path' FilePath - | GistI GistInput - | AuthLoginI - | VersionI - | DiffNamespaceToPatchI DiffNamespaceToPatchInput - | ProjectCreateI Bool {- try downloading base? -} (Maybe ProjectName) - | ProjectRenameI ProjectName - | ProjectSwitchI ProjectAndBranchNames - | ProjectsI - | BranchI BranchSourceI (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - | BranchRenameI ProjectBranchName - | BranchesI (Maybe ProjectName) - | CloneI ProjectAndBranchNames (Maybe ProjectAndBranchNames) - | ReleaseDraftI Semver - | UpgradeI !NameSegment !NameSegment - | EditNamespaceI [Path.Path] - | -- New merge algorithm: merge the given project branch into the current one. - MergeI (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - | LibInstallI !(ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) - deriving (Eq, Show) - --- | The source of a `branch` command: what to make the new branch from. -data BranchSourceI - = -- | Create a branch from the current context - BranchSourceI'CurrentContext - | -- | Create an empty branch - BranchSourceI'Empty - | -- | Create a branch from this other branch - BranchSourceI'UnresolvedProjectBranch UnresolvedProjectBranch - deriving stock (Eq, Show) - -data DiffNamespaceToPatchInput = DiffNamespaceToPatchInput - { -- The first/earlier namespace. - branchId1 :: BranchId, - -- The second/later namespace. - branchId2 :: BranchId, - -- Where to store the patch that corresponds to the diff between the namespaces. - patch :: Path.Split' - } - deriving stock (Eq, Generic, Show) - --- | @"push.gist repo"@ pushes the contents of the current namespace to @repo@. -data GistInput = GistInput - { repo :: WriteGitRepo - } - deriving stock (Eq, Show) - --- | Pull source and target: either neither is specified, or only a source, or both. -data PullSourceTarget - = PullSourceTarget0 - | PullSourceTarget1 (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease)) - | PullSourceTarget2 (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease)) (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - deriving stock (Eq, Show) - -data PushSource - = PathySource Path' - | ProjySource (These ProjectName ProjectBranchName) - deriving stock (Eq, Show) - --- | Push source and target: either neither is specified, or only a target, or both. -data PushSourceTarget - = PushSourceTarget0 - | PushSourceTarget1 (WriteRemoteNamespace (These ProjectName ProjectBranchName)) - | PushSourceTarget2 PushSource (WriteRemoteNamespace (These ProjectName ProjectBranchName)) - deriving stock (Eq, Show) - -data PushRemoteBranchInput = PushRemoteBranchInput - { sourceTarget :: PushSourceTarget, - pushBehavior :: PushBehavior - } - deriving stock (Eq, Show) - -data TestInput = TestInput - { -- | Should we run tests in the `lib` namespace? - includeLibNamespace :: Bool, - -- | Relative path to run the tests in. Ignore if `includeLibNamespace` is True - that means test everything. - path :: Path, - showFailures :: Bool, - showSuccesses :: Bool - } - deriving stock (Eq, Show) - --- Some commands, like `view`, can dump output to either console or a file. -data OutputLocation - = ConsoleLocation - | LatestFileLocation - | FileLocation FilePath - -- ClipboardLocation - deriving (Eq, Show) - -data FindScope - = FindLocal Path - | FindLocalAndDeps Path - | FindGlobal - deriving stock (Eq, Show) - -data ShowDefinitionScope - = ShowDefinitionLocal - | ShowDefinitionGlobal - deriving stock (Eq, Show) - -data DeleteOutput - = DeleteOutput'Diff - | DeleteOutput'NoDiff - deriving stock (Eq, Show) - -data DeleteTarget - = DeleteTarget'TermOrType DeleteOutput [Path.HQSplit'] - | DeleteTarget'Term DeleteOutput [Path.HQSplit'] - | DeleteTarget'Type DeleteOutput [Path.HQSplit'] - | DeleteTarget'Namespace Insistence Path.Split - | DeleteTarget'Patch Path.Split' - | DeleteTarget'ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - | DeleteTarget'Project ProjectName - deriving stock (Eq, Show) From 0d80992da9e2b5bfa9a1229553591d083dd532d5 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 09:38:45 -0700 Subject: [PATCH 064/631] Remove root branch accessors from codebase --- parser-typechecker/src/Unison/Codebase.hs | 37 ++----------------- .../Codebase/SqliteCodebase/Operations.hs | 8 ---- 2 files changed, 4 insertions(+), 41 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index e422d85d20..1cc958b763 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -48,17 +48,13 @@ module Unison.Codebase SqliteCodebase.Operations.before, getShallowBranchAtPath, getShallowCausalAtPath, - getBranchAtPath, Operations.expectCausalBranchByCausalHash, getShallowCausalAtPathFromRootHash, - getShallowRootBranch, - getShallowRootCausal, getShallowProjectRootBranch, getShallowBranchAtProjectPath, getShallowProjectRootByNames, -- * Root branch - Operations.expectRootCausalHash, SqliteCodebase.Operations.namesAtPath, -- * Patches @@ -113,7 +109,6 @@ where import Data.Map qualified as Map import Data.Set qualified as Set -import U.Codebase.Branch qualified as V2 import U.Codebase.Branch qualified as V2Branch import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash) @@ -182,36 +177,22 @@ getShallowCausalAtPathFromRootHash :: Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) getShallowCausalAtPathFromRootHash rootCausalHash p = do rootCausal <- Operations.expectCausalBranchByCausalHash rootCausalHash - getShallowCausalAtPath p (Just rootCausal) - --- | Get the shallow representation of the root branches without loading the children or --- history. -getShallowRootBranch :: Sqlite.Transaction (V2.Branch Sqlite.Transaction) -getShallowRootBranch = do - getShallowRootCausal >>= V2Causal.value - --- | Get the shallow representation of the root branches without loading the children or --- history. -getShallowRootCausal :: Sqlite.Transaction (V2.CausalBranch Sqlite.Transaction) -getShallowRootCausal = do - hash <- Operations.expectRootCausalHash - Operations.expectCausalBranchByCausalHash hash + getShallowCausalAtPath p rootCausal -- | Recursively descend into causals following the given path, -- Use the root causal if none is provided. getShallowCausalAtPath :: Path -> - Maybe (V2Branch.CausalBranch Sqlite.Transaction) -> + (V2Branch.CausalBranch Sqlite.Transaction) -> Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) -getShallowCausalAtPath path mayCausal = do - causal <- whenNothing mayCausal getShallowRootCausal +getShallowCausalAtPath path causal = do case path of Path.Empty -> pure causal ns Path.:< p -> do b <- V2Causal.value causal case V2Branch.childAt ns b of Nothing -> pure (Cv.causalbranch1to2 Branch.empty) - Just childCausal -> getShallowCausalAtPath p (Just childCausal) + Just childCausal -> getShallowCausalAtPath p childCausal -- | Recursively descend into causals following the given path, -- Use the root causal if none is provided. @@ -249,16 +230,6 @@ getShallowProjectRootByNames (ProjectAndBranch projectName branchName) = runMayb causalHash <- lift $ Q.expectCausalHash causalHashId lift $ Operations.expectCausalBranchByCausalHash causalHash --- | Get a v1 branch from the root following the given path. -getBranchAtPath :: - (MonadIO m) => - Codebase m v a -> - Path.Absolute -> - m (Branch m) -getBranchAtPath codebase path = do - V2Causal.Causal {causalHash} <- runTransaction codebase $ getShallowCausalAtPath (Path.unabsolute path) Nothing - expectBranchForHash codebase causalHash - -- | Like 'getBranchForHash', but for when the hash is known to be in the codebase. expectBranchForHash :: (Monad m) => Codebase m v a -> CausalHash -> m (Branch m) expectBranchForHash codebase hash = diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index 9e70bbf1b3..06ec565664 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -379,14 +379,6 @@ tryFlushDeclBuffer termBuffer declBuffer = h in loop -uncachedLoadRootBranch :: - BranchCache Sqlite.Transaction -> - (C.Reference.Reference -> Sqlite.Transaction CT.ConstructorType) -> - Transaction (Branch Transaction) -uncachedLoadRootBranch branchCache getDeclType = do - causal2 <- Ops.expectRootCausal - Cv.causalbranch2to1 branchCache getDeclType causal2 - -- if this blows up on cromulent hashes, then switch from `hashToHashId` -- to one that returns Maybe. getBranchForHash :: From 216967f8ce998ea8334826bf0cd59556777f5ca9 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 09:38:45 -0700 Subject: [PATCH 065/631] Use onCreate hook to initialize projects --- unison-cli/src/Unison/Main.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index 32e829c0b1..b9be22f80f 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -390,7 +390,7 @@ prepareTranscriptDir verbosity shouldFork mCodePathOption shouldSaveCodebase = d tmp <- case shouldSaveCodebase of SaveCodebase (Just path) -> pure path _ -> Temp.getCanonicalTemporaryDirectory >>= (`Temp.createTempDirectory` "transcript") - let cbInit = SC.init + let cbInit = SC.initWithSetup bootstrapNewCodebase case shouldFork of UseFork -> do -- A forked codebase does not need to Create a codebase, because it already exists @@ -571,7 +571,8 @@ getConfigFilePath mcodepath = ( ".unisonConfig") <$> Codebase.getCodebaseDir getCodebaseOrExit :: Maybe CodebasePathOption -> SC.MigrationStrategy -> ((InitResult, CodebasePath, Codebase IO Symbol Ann) -> IO r) -> IO r getCodebaseOrExit codebasePathOption migrationStrategy action = do initOptions <- argsToCodebaseInitOptions codebasePathOption - result <- CodebaseInit.withOpenOrCreateCodebase SC.init "main" initOptions SC.DoLock migrationStrategy \case + let cbInit = SC.initWithSetup bootstrapNewCodebase + result <- CodebaseInit.withOpenOrCreateCodebase cbInit "main" initOptions SC.DoLock migrationStrategy \case cbInit@(CreatedCodebase, dir, _) -> do pDir <- prettyDir dir PT.putPrettyLn' "" @@ -652,3 +653,6 @@ codebasePathOptionToPath codebasePathOption = case codebasePathOption of CreateCodebaseWhenMissing p -> p DontCreateCodebaseWhenMissing p -> p + +bootstrapNewCodebase :: _ +bootstrapNewCodebase = error "Implement bootstrapNewCodebase." From 1d906b3765c22acdce073eee71c91ef8aa24a7b0 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 09:38:45 -0700 Subject: [PATCH 066/631] Clean up uses of root in Codebase, kill the root branch cache --- .../src/Unison/Codebase/SqliteCodebase.hs | 16 +--------------- .../unison-parser-typechecker.cabal | 1 - 2 files changed, 1 insertion(+), 16 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs index 1d37f8e581..734020509e 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs @@ -18,12 +18,9 @@ import Data.Either.Extra () import Data.IORef import Data.Map qualified as Map import Data.Set qualified as Set -import Data.Time (getCurrentTime) import System.Console.ANSI qualified as ANSI import System.FileLock (SharedExclusive (Exclusive), withTryFileLock) import U.Codebase.HashTags (CausalHash, PatchHash (..)) -import U.Codebase.Reflog qualified as Reflog -import U.Codebase.Sqlite.Operations qualified as Ops import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Sync22 qualified as Sync22 import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle) @@ -37,10 +34,8 @@ import Unison.Codebase.Init qualified as Codebase import Unison.Codebase.Init.CreateCodebaseError qualified as Codebase1 import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (..)) import Unison.Codebase.Init.OpenCodebaseError qualified as Codebase1 -import Unison.Codebase.RootBranchCache import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache) import Unison.Codebase.SqliteCodebase.Branch.Dependencies qualified as BD -import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.Codebase.SqliteCodebase.Migrations qualified as Migrations import Unison.Codebase.SqliteCodebase.Operations qualified as CodebaseOps import Unison.Codebase.SqliteCodebase.Paths @@ -107,7 +102,6 @@ createCodebaseOrError onCreate debugName path lockOption action = do Sqlite.trySetJournalMode conn Sqlite.JournalMode'WAL Sqlite.runTransaction conn do Q.createSchema - void . Ops.saveRootBranch v2HashHandle $ Cv.causalbranch1to2 Branch.empty onCreate sqliteCodebase debugName path Local lockOption DontMigrate action >>= \case @@ -167,7 +161,6 @@ sqliteCodebase :: (Codebase m Symbol Ann -> m r) -> m (Either Codebase1.OpenCodebaseError r) sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action = handleLockOption do - rootBranchCache <- newEmptyRootBranchCacheIO branchCache <- newBranchCache getDeclType <- CodebaseOps.makeCachedTransaction 2048 CodebaseOps.getDeclType -- The v1 codebase interface has operations to read and write individual definitions @@ -238,20 +231,13 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action putTypeDeclarationComponent = CodebaseOps.putTypeDeclarationComponent termBuffer declBuffer - getRootBranch :: m (Branch m) - getRootBranch = - Branch.transform runTransaction - <$> fetchRootBranch - rootBranchCache - (runTransaction (CodebaseOps.uncachedLoadRootBranch branchCache getDeclType)) - -- if this blows up on cromulent hashes, then switch from `hashToHashId` -- to one that returns Maybe. getBranchForHash :: CausalHash -> m (Maybe (Branch m)) getBranchForHash h = fmap (Branch.transform runTransaction) <$> runTransaction (CodebaseOps.getBranchForHash branchCache getDeclType h) - putBranch :: Branch m -> m CausalHash + putBranch :: Branch m -> m () putBranch branch = withRunInIO \runInIO -> runInIO (runTransaction (CodebaseOps.putBranch (Branch.transform (Sqlite.unsafeIO . runInIO) branch))) diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index eb573c3741..f18984313d 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -62,7 +62,6 @@ library Unison.Codebase.Path.Parse Unison.Codebase.ProjectPath Unison.Codebase.PushBehavior - Unison.Codebase.RootBranchCache Unison.Codebase.Runtime Unison.Codebase.Serialization Unison.Codebase.ShortCausalHash From 33610106ca09c16be7b43e193b699f667d118c15 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 09:38:45 -0700 Subject: [PATCH 067/631] Fix up uses of root branch in Backend --- .../src/Unison/Codebase/Execute.hs | 3 +- .../src/Unison/Codebase/RootBranchCache.hs | 110 ------------------ unison-share-api/src/Unison/Server/Backend.hs | 74 +++++------- 3 files changed, 28 insertions(+), 159 deletions(-) delete mode 100644 parser-typechecker/src/Unison/Codebase/RootBranchCache.hs diff --git a/parser-typechecker/src/Unison/Codebase/Execute.hs b/parser-typechecker/src/Unison/Codebase/Execute.hs index 8b86d8afe4..1149c5ee79 100644 --- a/parser-typechecker/src/Unison/Codebase/Execute.hs +++ b/parser-typechecker/src/Unison/Codebase/Execute.hs @@ -12,10 +12,9 @@ import Unison.Codebase.MainTerm (getMainTerm) import Unison.Codebase.MainTerm qualified as MainTerm import Unison.Codebase.Runtime (Runtime) import Unison.Codebase.Runtime qualified as Runtime -import Unison.Names qualified as Names -import Unison.Names (Names) import Unison.HashQualified qualified as HQ import Unison.Name (Name) +import Unison.Names (Names) import Unison.Parser.Ann (Ann) import Unison.PrettyPrintEnv qualified as PPE import Unison.Symbol (Symbol) diff --git a/parser-typechecker/src/Unison/Codebase/RootBranchCache.hs b/parser-typechecker/src/Unison/Codebase/RootBranchCache.hs deleted file mode 100644 index ab092c8031..0000000000 --- a/parser-typechecker/src/Unison/Codebase/RootBranchCache.hs +++ /dev/null @@ -1,110 +0,0 @@ -module Unison.Codebase.RootBranchCache - ( RootBranchCache, - newEmptyRootBranchCache, - newEmptyRootBranchCacheIO, - fetchRootBranch, - withLock, - ) -where - -import Control.Concurrent.STM (newTVarIO) -import Control.Monad (join) -import Control.Monad.IO.Class -import Data.Coerce (coerce) -import Unison.Codebase.Branch.Type (Branch) -import Unison.Sqlite qualified as Sqlite -import UnliftIO (MonadUnliftIO, mask, onException) -import UnliftIO.STM - ( STM, - TVar, - atomically, - newTVar, - readTVar, - retrySTM, - writeTVar, - ) - -data RootBranchCacheVal - = Empty - | -- | Another thread is updating the cache. If this value is observed - -- then the reader should wait until the value is Empty or Full. The - -- api exposed from this module guarantees that a thread cannot exit - -- and leave the cache in this state. - ConcurrentModification - | Full (Branch Sqlite.Transaction) - --- This is isomorphic to @TMVar (Maybe (Branch Sqlite.Transaction))@ -newtype RootBranchCache = RootBranchCache (TVar RootBranchCacheVal) - -newEmptyRootBranchCacheIO :: (MonadIO m) => m RootBranchCache -newEmptyRootBranchCacheIO = liftIO (coerce $ newTVarIO Empty) - -newEmptyRootBranchCache :: STM RootBranchCache -newEmptyRootBranchCache = coerce (newTVar Empty) - -readRbc :: RootBranchCache -> STM RootBranchCacheVal -readRbc (RootBranchCache v) = readTVar v - -writeRbc :: RootBranchCache -> RootBranchCacheVal -> STM () -writeRbc (RootBranchCache v) x = writeTVar v x - --- | Read the root branch cache, wait if the cache is currently being --- updated -readRootBranchCache :: RootBranchCache -> STM (Maybe (Branch Sqlite.Transaction)) -readRootBranchCache v = - readRbc v >>= \case - Empty -> pure Nothing - ConcurrentModification -> retrySTM - Full x -> pure (Just x) - -fetchRootBranch :: forall m. (MonadUnliftIO m) => RootBranchCache -> m (Branch Sqlite.Transaction) -> m (Branch Sqlite.Transaction) -fetchRootBranch rbc getFromDb = mask \restore -> do - join (atomically (fetch restore)) - where - fetch :: (forall x. m x -> m x) -> STM (m (Branch Sqlite.Transaction)) - fetch restore = do - readRbc rbc >>= \case - Empty -> do - writeRbc rbc ConcurrentModification - pure do - rootBranch <- restore getFromDb `onException` atomically (writeRbc rbc Empty) - atomically (writeRbc rbc (Full rootBranch)) - pure rootBranch - ConcurrentModification -> retrySTM - Full x -> pure (pure x) - --- | Take a cache lock so that no other thread can read or write to --- the cache, perform an action with the cached value, then restore --- the cache to Empty or Full -withLock :: - forall m r. - (MonadUnliftIO m) => - RootBranchCache -> - -- | Perform an action with the cached value - ( -- restore masking state - (forall x. m x -> m x) -> - -- value retrieved from cache - Maybe (Branch Sqlite.Transaction) -> - m r - ) -> - -- | compute value to restore to the cache - (r -> Maybe (Branch Sqlite.Transaction)) -> - m r -withLock v f g = mask \restore -> do - mbranch <- atomically (takeLock v) - r <- f restore mbranch `onException` releaseLock mbranch - releaseLock (g r) - pure r - where - releaseLock :: Maybe (Branch Sqlite.Transaction) -> m () - releaseLock mbranch = - let !val = case mbranch of - Nothing -> Empty - Just x -> Full x - in atomically (writeRbc v val) - -takeLock :: RootBranchCache -> STM (Maybe (Branch Sqlite.Transaction)) -takeLock v = do - res <- readRootBranchCache v - writeRbc v ConcurrentModification - pure res diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs index 095924ed74..7c80b87274 100644 --- a/unison-share-api/src/Unison/Server/Backend.hs +++ b/unison-share-api/src/Unison/Server/Backend.hs @@ -38,7 +38,7 @@ module Unison.Server.Backend lsAtPath, lsBranch, mungeSyntaxText, - resolveCausalHashV2, + Codebase.expectCausalBranchByCausalHash, resolveRootBranchHashV2, namesAtPathFromRootBranchHash, termEntryDisplayName, @@ -100,7 +100,6 @@ import U.Codebase.Branch qualified as V2Branch import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (BranchHash, CausalHash (..)) import U.Codebase.Referent qualified as V2Referent -import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Operations qualified as Ops import Unison.ABT qualified as ABT import Unison.Builtin qualified as B @@ -699,14 +698,12 @@ expandShortCausalHash hash = do -- | Efficiently resolve a root hash and path to a shallow branch's causal. getShallowCausalAtPathFromRootHash :: - Maybe CausalHash -> + CausalHash -> Path -> Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) -getShallowCausalAtPathFromRootHash mayRootHash path = do - shallowRoot <- case mayRootHash of - Nothing -> Codebase.getShallowRootCausal - Just h -> Codebase.expectCausalBranchByCausalHash h - Codebase.getShallowCausalAtPath path (Just shallowRoot) +getShallowCausalAtPathFromRootHash rootHash path = do + shallowRoot <- Codebase.expectCausalBranchByCausalHash rootHash + Codebase.getShallowCausalAtPath path shallowRoot formatType' :: (Var v) => PPE.PrettyPrintEnv -> Width -> Type v a -> SyntaxText formatType' ppe w = @@ -986,16 +983,12 @@ namesAtPathFromRootBranchHash :: forall m n v a. (MonadIO m) => Codebase m v a -> - Maybe (V2Branch.CausalBranch n) -> + V2Branch.CausalBranch n -> Path -> Backend m (Names, PPED.PrettyPrintEnvDecl) -namesAtPathFromRootBranchHash codebase mbh path = do +namesAtPathFromRootBranchHash codebase cb path = do shouldUseNamesIndex <- asks useNamesIndex - (rootBranchHash, rootCausalHash) <- case mbh of - Just cb -> pure (V2Causal.valueHash cb, V2Causal.causalHash cb) - Nothing -> lift $ do - cb <- Codebase.runTransaction codebase Operations.expectRootCausal - pure (V2Causal.valueHash cb, V2Causal.causalHash cb) + let (rootBranchHash, rootCausalHash) = (V2Causal.valueHash cb, V2Causal.causalHash cb) haveNameLookupForRoot <- lift $ Codebase.runTransaction codebase (Ops.checkBranchHashNameLookupExists rootBranchHash) hashLen <- lift $ Codebase.runTransaction codebase Codebase.hashLength names <- @@ -1004,47 +997,34 @@ namesAtPathFromRootBranchHash codebase mbh path = do when (not haveNameLookupForRoot) . throwError $ ExpectedNameLookup rootBranchHash lift . Codebase.runTransaction codebase $ Codebase.namesAtPath rootBranchHash path else do - Branch.toNames . Branch.getAt0 path . Branch.head <$> resolveCausalHash (Just rootCausalHash) codebase + Branch.toNames . Branch.getAt0 path . Branch.head <$> resolveCausalHash rootCausalHash codebase let pped = PPED.makePPED (PPE.hqNamer hashLen names) (PPE.suffixifyByHash names) pure (names, pped) resolveCausalHash :: - (Monad m) => Maybe CausalHash -> Codebase m v a -> Backend m (Branch m) -resolveCausalHash h codebase = case h of - Nothing -> lift (Codebase.getRootBranch codebase) - Just bhash -> do - mayBranch <- lift $ Codebase.getBranchForHash codebase bhash - whenNothing mayBranch (throwError $ NoBranchForHash bhash) - -resolveCausalHashV2 :: Maybe CausalHash -> Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) -resolveCausalHashV2 h = case h of - Nothing -> Codebase.getShallowRootCausal - Just ch -> Codebase.expectCausalBranchByCausalHash ch + (Monad m) => CausalHash -> Codebase m v a -> Backend m (Branch m) +resolveCausalHash bhash codebase = do + mayBranch <- lift $ Codebase.getBranchForHash codebase bhash + whenNothing mayBranch (throwError $ NoBranchForHash bhash) resolveRootBranchHash :: - (MonadIO m) => Maybe ShortCausalHash -> Codebase m v a -> Backend m (Branch m) -resolveRootBranchHash mayRoot codebase = case mayRoot of - Nothing -> - lift (Codebase.getRootBranch codebase) - Just sch -> do - h <- hoistBackend (Codebase.runTransaction codebase) (expandShortCausalHash sch) - resolveCausalHash (Just h) codebase + (MonadIO m) => ShortCausalHash -> Codebase m v a -> Backend m (Branch m) +resolveRootBranchHash sch codebase = do + h <- hoistBackend (Codebase.runTransaction codebase) (expandShortCausalHash sch) + resolveCausalHash h codebase resolveRootBranchHashV2 :: - Maybe ShortCausalHash -> Backend Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) -resolveRootBranchHashV2 mayRoot = case mayRoot of - Nothing -> lift Codebase.getShallowRootCausal - Just sch -> do - h <- expandShortCausalHash sch - lift (resolveCausalHashV2 (Just h)) - -normaliseRootCausalHash :: Maybe (Either ShortCausalHash CausalHash) -> Backend Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) -normaliseRootCausalHash mayCh = case mayCh of - Nothing -> lift $ resolveCausalHashV2 Nothing - Just (Left sch) -> do + ShortCausalHash -> Backend Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) +resolveRootBranchHashV2 sch = do + h <- expandShortCausalHash sch + lift (Codebase.expectCausalBranchByCausalHash h) + +normaliseRootCausalHash :: Either ShortCausalHash CausalHash -> Backend Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction) +normaliseRootCausalHash = \case + (Left sch) -> do ch <- expandShortCausalHash sch - lift $ resolveCausalHashV2 (Just ch) - Just (Right ch) -> lift $ resolveCausalHashV2 (Just ch) + lift $ Codebase.expectCausalBranchByCausalHash ch + (Right ch) -> lift $ Codebase.expectCausalBranchByCausalHash ch -- | Determines whether we include full cycles in the results, (e.g. if I search for `isEven`, will I find `isOdd` too?) -- From 2bf53bc3ae6bffaae5e8edad89d67e82e48e27df Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 3 Jun 2024 11:43:21 -0600 Subject: [PATCH 068/631] Add transcript from issue #1532 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Unfortunately, the linked transcript doesn’t contain text, AFAICT. So this copies over the issue text, but that is also missing some information. --- unison-src/transcripts/fix1532.md | 99 +++++++++++++++++++++++++++++++ 1 file changed, 99 insertions(+) create mode 100644 unison-src/transcripts/fix1532.md diff --git a/unison-src/transcripts/fix1532.md b/unison-src/transcripts/fix1532.md new file mode 100644 index 0000000000..222896523f --- /dev/null +++ b/unison-src/transcripts/fix1532.md @@ -0,0 +1,99 @@ +When using `delete.namespace` ucm will not assign `numberedArgs` which is unexpected. + +It also assigns multiple things to the same number (possibly related). + +## Transcript showing the problem + +First, lets create two namespaces. `foo` and `bar`, and add some definitions. + +```unison +x = 42 +y = 100 +``` + +```ucm + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + x : Nat + y : Nat + +``` +```ucm + ☝️ The namespace .foo is empty. + +.foo> add + + ⍟ I've added these definitions: + + x : Nat + y : Nat + +``` +```unison +z = x + y +``` + +```ucm + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + z : Nat + +``` +```ucm + ☝️ The namespace .bar is empty. + +.bar> add + + ⍟ I've added these definitions: + + z : Nat + +``` +Let's see what we have created... +```ucm +.> ls + + 1. bar/ (1 definition) + 2. builtin/ (168 definitions) + 3. foo/ (2 definitions) + +``` +Now, if we try deleting the namespace `foo`, we get an error, as expected. + +```ucm +.> delete.namespace foo + + ⚠️ + + I couldn't delete + + 1. foo.x : builtin.Nat + 2. foo.y : builtin.Nat + + + because it's still being used by these definitions: + + 1. bar.z : builtin.Nat + + +``` +However, the numbered arguments are not assigned by that command. +```ucm +.> debug.numberedArgs + + 1. .bar + 2. .builtin + 3. .foo + +``` +As you can see, the earlier output from `ls is still there. From 811c9e70bb0fbd4f4b96a5d8b828f9007fbcafe4 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 3 Jun 2024 11:56:33 -0600 Subject: [PATCH 069/631] Clean up the transcript and see that it passes The issue had already been fixed at some point. Closes #1532. --- unison-src/transcripts/fix1532.md | 91 +++++------------------- unison-src/transcripts/fix1532.output.md | 89 +++++++++++++++++++++++ 2 files changed, 105 insertions(+), 75 deletions(-) create mode 100644 unison-src/transcripts/fix1532.output.md diff --git a/unison-src/transcripts/fix1532.md b/unison-src/transcripts/fix1532.md index 222896523f..6b5a07c938 100644 --- a/unison-src/transcripts/fix1532.md +++ b/unison-src/transcripts/fix1532.md @@ -1,99 +1,40 @@ -When using `delete.namespace` ucm will not assign `numberedArgs` which is unexpected. - -It also assigns multiple things to the same number (possibly related). - -## Transcript showing the problem - -First, lets create two namespaces. `foo` and `bar`, and add some definitions. - -```unison -x = 42 -y = 100 -``` - ```ucm - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - x : Nat - y : Nat - +.> builtins.merge ``` -```ucm - ☝️ The namespace .foo is empty. - -.foo> add - ⍟ I've added these definitions: - - x : Nat - y : Nat +First, lets create two namespaces. `foo` and `bar`, and add some definitions. -``` ```unison -z = x + y +foo.x = 42 +foo.y = 100 +bar.z = x + y ``` ```ucm - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - z : Nat - +.> add ``` -```ucm - ☝️ The namespace .bar is empty. - -.bar> add - - ⍟ I've added these definitions: - - z : Nat -``` Let's see what we have created... + ```ucm .> ls - - 1. bar/ (1 definition) - 2. builtin/ (168 definitions) - 3. foo/ (2 definitions) - ``` + Now, if we try deleting the namespace `foo`, we get an error, as expected. -```ucm +```ucm:error .> delete.namespace foo +``` - ⚠️ - - I couldn't delete - - 1. foo.x : builtin.Nat - 2. foo.y : builtin.Nat - - - because it's still being used by these definitions: - - 1. bar.z : builtin.Nat - +Any numbered arguments should refer to `bar.z`. -``` -However, the numbered arguments are not assigned by that command. ```ucm .> debug.numberedArgs +``` - 1. .bar - 2. .builtin - 3. .foo +We can then delete the dependent term, and then delete `foo`. +```ucm +.> delete.term 1 +.> delete.namespace foo ``` -As you can see, the earlier output from `ls is still there. diff --git a/unison-src/transcripts/fix1532.output.md b/unison-src/transcripts/fix1532.output.md new file mode 100644 index 0000000000..d2707bb51a --- /dev/null +++ b/unison-src/transcripts/fix1532.output.md @@ -0,0 +1,89 @@ +```ucm +.> builtins.merge + + Done. + +``` +First, lets create two namespaces. `foo` and `bar`, and add some definitions. + +```unison +foo.x = 42 +foo.y = 100 +bar.z = x + y +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bar.z : Nat + foo.x : Nat + foo.y : Nat + +``` +```ucm +.> add + + ⍟ I've added these definitions: + + bar.z : Nat + foo.x : Nat + foo.y : Nat + +``` +Let's see what we have created... + +```ucm +.> ls + + 1. bar/ (1 term) + 2. builtin/ (469 terms, 74 types) + 3. foo/ (2 terms) + +``` +Now, if we try deleting the namespace `foo`, we get an error, as expected. + +```ucm +.> delete.namespace foo + + ⚠️ + + I didn't delete the namespace because the following + definitions are still in use. + + Dependency Referenced In + x 1. bar.z + + y 2. bar.z + + If you want to proceed anyways and leave those definitions + without names, use delete.namespace.force + +``` +Any numbered arguments should refer to `bar.z`. + +```ucm +.> debug.numberedArgs + + 1. bar.z + 2. bar.z + +``` +We can then delete the dependent term, and then delete `foo`. + +```ucm +.> delete.term 1 + + Done. + +.> delete.namespace foo + + Done. + +``` From 6f1c56c1315fd700636c0606d26bb3f649f893c4 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 3 Jun 2024 13:57:45 -0400 Subject: [PATCH 070/631] tweak messages --- unison-cli/src/Unison/Cli/Pretty.hs | 4 -- .../src/Unison/CommandLine/InputPatterns.hs | 42 +++++++++++++++++-- .../src/Unison/CommandLine/OutputMessages.hs | 31 +++----------- unison-src/transcripts/fix4482.output.md | 12 ++++++ .../transcripts/upgrade-sad-path.output.md | 17 +++----- .../upgrade-suffixifies-properly.output.md | 12 ++++++ 6 files changed, 74 insertions(+), 44 deletions(-) diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index 8f82d3d44f..2e91fbd98a 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -22,7 +22,6 @@ module Unison.Cli.Pretty prettyMergeSource, prettyMergeSourceOrTarget, prettyProjectAndBranchName, - prettyBranchName, prettyProjectBranchName, prettyProjectName, prettyProjectNameSlash, @@ -271,9 +270,6 @@ prettyProjectAndBranchName :: ProjectAndBranch ProjectName ProjectBranchName -> prettyProjectAndBranchName (ProjectAndBranch project branch) = P.group (prettyProjectName project <> P.hiBlack "/" <> prettyProjectBranchName branch) -prettyBranchName :: ProjectAndBranch ProjectName ProjectBranchName -> Pretty -prettyBranchName (ProjectAndBranch _ branch) = prettySlashProjectBranchName branch - -- produces: -- -- #5v5UtREE1fTiyTsTK2zJ1YNqfiF25SkfUnnji86Lms#0 -- Optional.None, Maybe.Nothing : Maybe a diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index a281f02ebe..ed70b96c97 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -168,7 +168,14 @@ import U.Codebase.Sqlite.DbId (ProjectBranchId) import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Auth.HTTPClient (AuthenticatedHttpClient) -import Unison.Cli.Pretty (prettyProjectAndBranchName, prettyProjectName, prettyProjectNameSlash, prettySlashProjectBranchName, prettyURI) +import Unison.Cli.Pretty + ( prettyProjectAndBranchName, + prettyProjectBranchName, + prettyProjectName, + prettyProjectNameSlash, + prettySlashProjectBranchName, + prettyURI, + ) import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase @@ -191,6 +198,7 @@ import Unison.CommandLine.Completion import Unison.CommandLine.FZFResolvers qualified as Resolvers import Unison.CommandLine.InputPattern (ArgumentType (..), InputPattern (InputPattern), IsOptional (..), unionSuggestions) import Unison.CommandLine.InputPattern qualified as I +import Unison.Core.Project (ProjectBranchName (..)) import Unison.HashQualified qualified as HQ import Unison.Name (Name) import Unison.Name qualified as Name @@ -200,7 +208,6 @@ import Unison.Prelude import Unison.Project ( ProjectAndBranch (..), ProjectAndBranchNames (..), - ProjectBranchName, ProjectBranchNameOrLatestRelease (..), ProjectBranchSpecifier (..), ProjectName, @@ -3163,7 +3170,36 @@ upgradeCommitInputPattern = aliases = ["commit.upgrade"], visibility = I.Visible, args = [], - help = P.wrap $ makeExample' upgradeCommitInputPattern <> "commits the current upgrade.", + help = + let mainBranch = UnsafeProjectBranchName "main" + tempBranch = UnsafeProjectBranchName "upgrade-foo-to-bar" + in P.wrap + ( makeExample' upgradeCommitInputPattern + <> "merges a temporary branch created by the" + <> makeExample' upgrade + <> "command back into its parent branch, and removes the temporary branch." + ) + <> P.newline + <> P.newline + <> P.wrap + ( "For example, if you've done" + <> makeExample upgrade ["foo", "bar"] + <> "from" + <> P.group (prettyProjectBranchName mainBranch <> ",") + <> "then" + <> makeExample' upgradeCommitInputPattern + <> "is equivalent to doing" + ) + <> P.newline + <> P.newline + <> P.indentN + 2 + ( P.bulleted + [ makeExampleNoBackticks projectSwitch [prettySlashProjectBranchName mainBranch], + makeExampleNoBackticks mergeInputPattern [prettySlashProjectBranchName tempBranch], + makeExampleNoBackticks deleteBranch [prettySlashProjectBranchName tempBranch] + ] + ), parse = \case [] -> Right Input.UpgradeCommitI _ -> Left (I.help upgradeCommitInputPattern) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 5625569afe..2bf0a860e3 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2269,38 +2269,17 @@ notifyUser dir = \case "", P.wrap "When you're done, you can run", "", - P.indentN - 2 - ( P.bulleted - [ IP.makeExampleNoBackticks IP.projectSwitch [prettySlashProjectBranchName main], - IP.makeExampleNoBackticks IP.mergeInputPattern [prettySlashProjectBranchName temp], - IP.makeExampleNoBackticks IP.deleteBranch [prettySlashProjectBranchName temp] - ] - ), - "", - "or (equivalently)", - "", - P.indentN - 2 - ( P.bulleted - [ IP.makeExampleNoBackticks IP.upgradeCommitInputPattern [] - ] - ), + P.indentN 2 (IP.makeExampleNoBackticks IP.upgradeCommitInputPattern []), "", P.wrap $ "to merge your changes back into" - <> P.group (prettyProjectBranchName main <> ".") - <> "Or, if you'd like to abandon the upgrade instead, you can run", + <> prettyProjectBranchName main + <> "and delete the temporary branch. Or, if you decide to cancel the upgrade instead, you can run", "", - P.indentN - 2 - ( P.bulleted [IP.makeExampleNoBackticks IP.deleteBranch [prettySlashProjectBranchName temp]] - ), + P.indentN 2 (IP.makeExampleNoBackticks IP.deleteBranch [prettySlashProjectBranchName temp]), "", P.wrap $ - "to delete" - <> prettyProjectBranchName temp - <> "and switch back to" + "to delete the temporary branch and switch back to" <> P.group (prettyProjectBranchName main <> ".") ] UpgradeSuccess old new -> diff --git a/unison-src/transcripts/fix4482.output.md b/unison-src/transcripts/fix4482.output.md index 30bb9ff6b3..d61ddd6657 100644 --- a/unison-src/transcripts/fix4482.output.md +++ b/unison-src/transcripts/fix4482.output.md @@ -39,6 +39,18 @@ myproj/main> upgrade foo0 foo1 I couldn't automatically upgrade foo0 to foo1. However, I've added the definitions that need attention to the top of scratch.u. + + When you're done, you can run + + upgrade.commit + + to merge your changes back into main and delete the temporary + branch. Or, if you decide to cancel the upgrade instead, you + can run + + delete.branch /upgrade-foo0-to-foo1 + + to delete the temporary branch and switch back to main. ``` ```unison:added-by-ucm scratch.u diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md index 6f94eeb7a3..f0811cd8ee 100644 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ b/unison-src/transcripts/upgrade-sad-path.output.md @@ -38,20 +38,15 @@ proj/main> upgrade old new When you're done, you can run - * switch /main - * merge /upgrade-old-to-new - * delete.branch /upgrade-old-to-new + upgrade.commit - or (equivalently) + to merge your changes back into main and delete the temporary + branch. Or, if you decide to cancel the upgrade instead, you + can run - * upgrade.commit + delete.branch /upgrade-old-to-new - to merge your changes back into main. Or, if you'd like to - abandon the upgrade instead, you can run - - * delete.branch /upgrade-old-to-new - - to delete upgrade-old-to-new and switch back to main. + to delete the temporary branch and switch back to main. ``` ```unison:added-by-ucm scratch.u diff --git a/unison-src/transcripts/upgrade-suffixifies-properly.output.md b/unison-src/transcripts/upgrade-suffixifies-properly.output.md index 2d38a70156..4b7b313199 100644 --- a/unison-src/transcripts/upgrade-suffixifies-properly.output.md +++ b/unison-src/transcripts/upgrade-suffixifies-properly.output.md @@ -47,6 +47,18 @@ myproject/main> upgrade old new I couldn't automatically upgrade old to new. However, I've added the definitions that need attention to the top of scratch.u. + + When you're done, you can run + + upgrade.commit + + to merge your changes back into main and delete the temporary + branch. Or, if you decide to cancel the upgrade instead, you + can run + + delete.branch /upgrade-old-to-new + + to delete the temporary branch and switch back to main. ``` ```unison:added-by-ucm scratch.u From 1cb243767f1a1ce24144ebc6e83201c8f99fd589 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Mon, 3 Jun 2024 14:16:23 -0400 Subject: [PATCH 071/631] require CONTRIBUTORS.md to automerge --- .mergify.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.mergify.yml b/.mergify.yml index 5b7829eff3..eff5a6fcc3 100644 --- a/.mergify.yml +++ b/.mergify.yml @@ -1,6 +1,7 @@ pull_request_rules: - name: automatic merge on CI success and review conditions: + - check-success=Contributor signed CONTRIBUTORS.markdown - check-success=build ucm (ubuntu-20.04) - check-success=build ucm (macOS-12) - check-success=build ucm (windows-2019) From 2e754a876237d0a3fb5703d7c357a88e05b80538 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 10:08:34 -0700 Subject: [PATCH 072/631] Propagate lack of root branch combinators to local Codebase Server --- .../src/Unison/Server/CodebaseServer.hs | 29 +++++++++---------- .../src/Unison/Server/Local/Definitions.hs | 2 +- .../Local/Endpoints/DefinitionSummary.hs | 15 +++++----- .../Server/Local/Endpoints/FuzzyFind.hs | 11 +++---- .../Server/Local/Endpoints/GetDefinitions.hs | 11 +++---- .../Local/Endpoints/NamespaceDetails.hs | 19 ++++++------ .../Local/Endpoints/NamespaceListing.hs | 11 +++---- unison-share-api/src/Unison/Server/Types.hs | 4 +++ 8 files changed, 53 insertions(+), 49 deletions(-) diff --git a/unison-share-api/src/Unison/Server/CodebaseServer.hs b/unison-share-api/src/Unison/Server/CodebaseServer.hs index 02834e9794..4a3025a71f 100644 --- a/unison-share-api/src/Unison/Server/CodebaseServer.hs +++ b/unison-share-api/src/Unison/Server/CodebaseServer.hs @@ -119,16 +119,13 @@ import Unison.Server.Local.Endpoints.Projects (ListProjectBranchesEndpoint, List import Unison.Server.Local.Endpoints.UCM (UCMAPI, ucmServer) import Unison.Server.NameSearch (NameSearch (..)) import Unison.Server.NameSearch.FromNames qualified as Names -import Unison.Server.Types (TermDefinition (..), TermDiffResponse (..), TypeDefinition (..), TypeDiffResponse (..), mungeString, setCacheControl) +import Unison.Server.Types (RequiredQueryParam, TermDefinition (..), TermDiffResponse (..), TypeDefinition (..), TypeDiffResponse (..), mungeString, setCacheControl) import Unison.ShortHash qualified as ShortHash import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Util.Pretty qualified as Pretty --- | Fail the route with a reasonable error if the query param is missing. -type RequiredQueryParam = Servant.QueryParam' '[Servant.Required, Servant.Strict] - -- HTML content type data HTML = HTML @@ -567,12 +564,12 @@ serveLooseCode :: Rt.Runtime Symbol -> ServerT LooseCodeAPI (Backend IO) serveLooseCode codebase rt = - (\root rel name -> setCacheControl <$> NamespaceListing.serve codebase (Left <$> root) rel name) - :<|> (\namespaceName mayRoot renderWidth -> setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Left <$> mayRoot) renderWidth) - :<|> (\mayRoot relativePath rawHqns renderWidth suff -> setCacheControl <$> serveDefinitions rt codebase (Left <$> mayRoot) relativePath rawHqns renderWidth suff) - :<|> (\mayRoot relativePath limit renderWidth query -> setCacheControl <$> serveFuzzyFind codebase (Left <$> mayRoot) relativePath limit renderWidth query) - :<|> (\shortHash mayName mayRoot relativeTo renderWidth -> setCacheControl <$> serveTermSummary codebase shortHash mayName (Left <$> mayRoot) relativeTo renderWidth) - :<|> (\shortHash mayName mayRoot relativeTo renderWidth -> setCacheControl <$> serveTypeSummary codebase shortHash mayName (Left <$> mayRoot) relativeTo renderWidth) + (\root rel name -> setCacheControl <$> NamespaceListing.serve codebase (Left root) rel name) + :<|> (\namespaceName mayRoot renderWidth -> setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Left mayRoot) renderWidth) + :<|> (\mayRoot relativePath rawHqns renderWidth suff -> setCacheControl <$> serveDefinitions rt codebase (Left mayRoot) relativePath rawHqns renderWidth suff) + :<|> (\mayRoot relativePath limit renderWidth query -> setCacheControl <$> serveFuzzyFind codebase (Left mayRoot) relativePath limit renderWidth query) + :<|> (\shortHash mayName mayRoot relativeTo renderWidth -> setCacheControl <$> serveTermSummary codebase shortHash mayName (Left mayRoot) relativeTo renderWidth) + :<|> (\shortHash mayName mayRoot relativeTo renderWidth -> setCacheControl <$> serveTypeSummary codebase shortHash mayName (Left mayRoot) relativeTo renderWidth) serveProjectsCodebaseServerAPI :: Codebase IO Symbol Ann -> @@ -591,26 +588,26 @@ serveProjectsCodebaseServerAPI codebase rt projectName branchName = do projectAndBranchName = ProjectAndBranch projectName branchName namespaceListingEndpoint _rootParam rel name = do root <- resolveProjectRootHash codebase projectAndBranchName - setCacheControl <$> NamespaceListing.serve codebase (Just . Right $ root) rel name + setCacheControl <$> NamespaceListing.serve codebase (Right $ root) rel name namespaceDetailsEndpoint namespaceName _rootParam renderWidth = do root <- resolveProjectRootHash codebase projectAndBranchName - setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Just . Right $ root) renderWidth + setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Right $ root) renderWidth serveDefinitionsEndpoint _rootParam relativePath rawHqns renderWidth suff = do root <- resolveProjectRootHash codebase projectAndBranchName - setCacheControl <$> serveDefinitions rt codebase (Just . Right $ root) relativePath rawHqns renderWidth suff + setCacheControl <$> serveDefinitions rt codebase (Right $ root) relativePath rawHqns renderWidth suff serveFuzzyFindEndpoint _rootParam relativePath limit renderWidth query = do root <- resolveProjectRootHash codebase projectAndBranchName - setCacheControl <$> serveFuzzyFind codebase (Just . Right $ root) relativePath limit renderWidth query + setCacheControl <$> serveFuzzyFind codebase (Right $ root) relativePath limit renderWidth query serveTermSummaryEndpoint shortHash mayName _rootParam relativeTo renderWidth = do root <- resolveProjectRootHash codebase projectAndBranchName - setCacheControl <$> serveTermSummary codebase shortHash mayName (Just . Right $ root) relativeTo renderWidth + setCacheControl <$> serveTermSummary codebase shortHash mayName (Right $ root) relativeTo renderWidth serveTypeSummaryEndpoint shortHash mayName _rootParam relativeTo renderWidth = do root <- resolveProjectRootHash codebase projectAndBranchName - setCacheControl <$> serveTypeSummary codebase shortHash mayName (Just . Right $ root) relativeTo renderWidth + setCacheControl <$> serveTypeSummary codebase shortHash mayName (Right $ root) relativeTo renderWidth resolveProjectRoot :: (Codebase IO v a) -> (ProjectAndBranch ProjectName ProjectBranchName) -> Backend IO (V2.CausalBranch Sqlite.Transaction) resolveProjectRoot codebase projectAndBranchName@(ProjectAndBranch projectName branchName) = do diff --git a/unison-share-api/src/Unison/Server/Local/Definitions.hs b/unison-share-api/src/Unison/Server/Local/Definitions.hs index b1f5b03d52..9c014a965f 100644 --- a/unison-share-api/src/Unison/Server/Local/Definitions.hs +++ b/unison-share-api/src/Unison/Server/Local/Definitions.hs @@ -81,7 +81,7 @@ prettyDefinitionsForHQName perspective shallowRoot renderWidth suffixifyBindings -- ppe which returns names fully qualified to the current perspective, not to the codebase root. let biases = maybeToList $ HQ.toName query hqLength <- liftIO $ Codebase.runTransaction codebase $ Codebase.hashLength - (localNamesOnly, unbiasedPPED) <- namesAtPathFromRootBranchHash codebase (Just shallowRoot) namesRoot + (localNamesOnly, unbiasedPPED) <- namesAtPathFromRootBranchHash codebase shallowRoot namesRoot let pped = PPED.biasTo biases unbiasedPPED let nameSearch = makeNameSearch hqLength localNamesOnly (DefinitionResults terms types misses) <- liftIO $ Codebase.runTransaction codebase do diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs index 3de04b5054..bd939684dd 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs @@ -48,6 +48,7 @@ import Unison.Server.Backend qualified as Backend import Unison.Server.Syntax (SyntaxText) import Unison.Server.Types ( APIGet, + RequiredQueryParam, TermTag (..), TypeTag, mayDefaultWidth, @@ -67,7 +68,7 @@ type TermSummaryAPI = -- It's propagated through to the response as-is. -- If missing, the short hash will be used instead. :> QueryParam "name" Name - :> QueryParam "rootBranch" ShortCausalHash + :> RequiredQueryParam "rootBranch" ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParam "renderWidth" Width :> APIGet TermSummary @@ -98,11 +99,11 @@ serveTermSummary :: Codebase IO Symbol Ann -> Referent -> Maybe Name -> - Maybe (Either ShortCausalHash CausalHash) -> + Either ShortCausalHash CausalHash -> Maybe Path.Path -> Maybe Width -> Backend IO TermSummary -serveTermSummary codebase referent mayName mayRoot relativeTo mayWidth = do +serveTermSummary codebase referent mayName root relativeTo mayWidth = do let shortHash = Referent.toShortHash referent let displayName = maybe (HQ.HashOnly shortHash) HQ.NameOnly mayName let relativeToPath = fromMaybe Path.empty relativeTo @@ -111,7 +112,7 @@ serveTermSummary codebase referent mayName mayRoot relativeTo mayWidth = do (root, sig) <- Backend.hoistBackend (Codebase.runTransaction codebase) do - root <- Backend.normaliseRootCausalHash mayRoot + root <- Backend.normaliseRootCausalHash root sig <- lift (Backend.loadReferentType codebase referent) pure (root, sig) case sig of @@ -126,7 +127,7 @@ serveTermSummary codebase referent mayName mayRoot relativeTo mayWidth = do namesPerspective <- Ops.namesPerspectiveForRootAndPath (V2Causal.valueHash root) (coerce . Path.toList $ fromMaybe Path.Empty relativeTo) PPESqlite.ppedForReferences namesPerspective deps False -> do - (_localNames, ppe) <- Backend.namesAtPathFromRootBranchHash codebase (Just root) relativeToPath + (_localNames, ppe) <- Backend.namesAtPathFromRootBranchHash codebase root relativeToPath pure ppe let formattedTermSig = Backend.formatSuffixedType ppe width typeSig let summary = mkSummary termReference formattedTermSig @@ -150,7 +151,7 @@ type TypeSummaryAPI = -- It's propagated through to the response as-is. -- If missing, the short hash will be used instead. :> QueryParam "name" Name - :> QueryParam "rootBranch" ShortCausalHash + :> RequiredQueryParam "rootBranch" ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParam "renderWidth" Width :> APIGet TypeSummary @@ -181,7 +182,7 @@ serveTypeSummary :: Codebase IO Symbol Ann -> Reference -> Maybe Name -> - Maybe (Either ShortCausalHash CausalHash) -> + Either ShortCausalHash CausalHash -> Maybe Path.Path -> Maybe Width -> Backend IO TypeSummary diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs index 5aaa434463..6044e36fca 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs @@ -38,6 +38,7 @@ import Unison.Server.Types HashQualifiedName, NamedTerm, NamedType, + RequiredQueryParam, UnisonName, mayDefaultWidth, ) @@ -47,7 +48,7 @@ import Unison.Util.Pretty (Width) type FuzzyFindAPI = "find" - :> QueryParam "rootBranch" SCH.ShortCausalHash + :> RequiredQueryParam "rootBranch" SCH.ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParam "limit" Int :> QueryParam "renderWidth" Width @@ -142,18 +143,18 @@ serveFuzzyFind :: forall m. (MonadIO m) => Codebase m Symbol Ann -> - Maybe (Either SCH.ShortCausalHash CausalHash) -> + Either SCH.ShortCausalHash CausalHash -> Maybe Path.Path -> Maybe Int -> Maybe Width -> Maybe String -> Backend.Backend m [(FZF.Alignment, FoundResult)] -serveFuzzyFind codebase mayRoot relativeTo limit typeWidth query = do +serveFuzzyFind codebase root relativeTo limit typeWidth query = do let path = fromMaybe Path.empty relativeTo rootCausal <- Backend.hoistBackend (Codebase.runTransaction codebase) do - Backend.normaliseRootCausalHash mayRoot - (localNamesOnly, ppe) <- Backend.namesAtPathFromRootBranchHash codebase (Just rootCausal) path + Backend.normaliseRootCausalHash root + (localNamesOnly, ppe) <- Backend.namesAtPathFromRootBranchHash codebase rootCausal path let alignments :: ( [ ( FZF.Alignment, UnisonName, diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/GetDefinitions.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/GetDefinitions.hs index 49a67357ea..f4ce8353ef 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/GetDefinitions.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/GetDefinitions.hs @@ -35,6 +35,7 @@ import Unison.Server.Local.Definitions qualified as Local import Unison.Server.Types ( APIGet, DefinitionDisplayResults, + RequiredQueryParam, Suffixify (..), defaultWidth, ) @@ -44,7 +45,7 @@ import Unison.Util.Pretty (Width) type DefinitionsAPI = "getDefinition" - :> QueryParam "rootBranch" ShortCausalHash + :> RequiredQueryParam "rootBranch" ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParams "names" (HQ.HashQualified Name) :> QueryParam "renderWidth" Width @@ -96,7 +97,7 @@ instance ToParam (QueryParam "namespace" Path.Path) where ) Normal -instance ToParam (QueryParam "rootBranch" ShortCausalHash) where +instance ToParam (RequiredQueryParam "rootBranch" ShortCausalHash) where toParam _ = DocQueryParam "rootBranch" @@ -120,15 +121,15 @@ instance ToSample DefinitionDisplayResults where serveDefinitions :: Rt.Runtime Symbol -> Codebase IO Symbol Ann -> - Maybe (Either ShortCausalHash CausalHash) -> + Either ShortCausalHash CausalHash -> Maybe Path.Path -> [HQ.HashQualified Name] -> Maybe Width -> Maybe Suffixify -> Backend.Backend IO DefinitionDisplayResults -serveDefinitions rt codebase mayRoot relativePath hqns width suff = +serveDefinitions rt codebase root relativePath hqns width suff = do - rootCausalHash <- Backend.hoistBackend (Codebase.runTransaction codebase) . Backend.normaliseRootCausalHash $ mayRoot + rootCausalHash <- Backend.hoistBackend (Codebase.runTransaction codebase) . Backend.normaliseRootCausalHash $ root hqns & foldMapM ( Local.prettyDefinitionsForHQName diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs index bcb6ca5fa1..ebfbea5d6f 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs @@ -25,6 +25,7 @@ import Unison.Server.Doc qualified as Doc import Unison.Server.Types ( APIGet, NamespaceDetails (..), + RequiredQueryParam, v2CausalBranchToUnisonHash, ) import Unison.Symbol (Symbol) @@ -33,7 +34,7 @@ import Unison.Util.Pretty (Width) type NamespaceDetailsAPI = "namespaces" :> Capture "namespace" Path.Path - :> QueryParam "rootBranch" ShortCausalHash + :> RequiredQueryParam "rootBranch" ShortCausalHash :> QueryParam "renderWidth" Width :> APIGet NamespaceDetails @@ -47,23 +48,21 @@ namespaceDetails :: Rt.Runtime Symbol -> Codebase IO Symbol Ann -> Path.Path -> - Maybe (Either ShortCausalHash CausalHash) -> + Either ShortCausalHash CausalHash -> Maybe Width -> Backend IO NamespaceDetails -namespaceDetails runtime codebase namespacePath mayRoot _mayWidth = do +namespaceDetails runtime codebase namespacePath root _mayWidth = do (rootCausal, namespaceCausal, shallowBranch) <- Backend.hoistBackend (Codebase.runTransaction codebase) do rootCausalHash <- - case mayRoot of - Nothing -> Backend.resolveRootBranchHashV2 Nothing - Just (Left sch) -> Backend.resolveRootBranchHashV2 (Just sch) - Just (Right ch) -> lift $ Backend.resolveCausalHashV2 (Just ch) - -- lift (Backend.resolveCausalHashV2 rootCausalHash) - namespaceCausal <- lift $ Codebase.getShallowCausalAtPath namespacePath (Just rootCausalHash) + case root of + (Left sch) -> Backend.resolveRootBranchHashV2 sch + (Right ch) -> lift $ Codebase.expectCausalBranchByCausalHash ch + namespaceCausal <- lift $ Codebase.getShallowCausalAtPath namespacePath rootCausalHash shallowBranch <- lift $ V2Causal.value namespaceCausal pure (rootCausalHash, namespaceCausal, shallowBranch) namespaceDetails <- do - (_localNamesOnly, ppe) <- Backend.namesAtPathFromRootBranchHash codebase (Just rootCausal) namespacePath + (_localNamesOnly, ppe) <- Backend.namesAtPathFromRootBranchHash codebase rootCausal namespacePath let mayReadmeRef = Backend.findDocInBranch readmeNames shallowBranch renderedReadme <- for mayReadmeRef \readmeRef -> do -- Local server currently ignores eval errors. diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs index fe5e5ee06a..a194c7534c 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs @@ -36,6 +36,7 @@ import Unison.Server.Types HashQualifiedName, NamedTerm (..), NamedType (..), + RequiredQueryParam, UnisonHash, UnisonName, v2CausalBranchToUnisonHash, @@ -47,7 +48,7 @@ import Unison.Var (Var) type NamespaceListingAPI = "list" - :> QueryParam "rootBranch" ShortCausalHash + :> RequiredQueryParam "rootBranch" ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParam "namespace" Path.Path :> APIGet NamespaceListing @@ -192,12 +193,12 @@ backendListEntryToNamespaceObject ppe typeWidth = \case serve :: Codebase IO Symbol Ann -> - Maybe (Either ShortCausalHash CausalHash) -> + Either ShortCausalHash CausalHash -> Maybe Path.Path -> Maybe Path.Path -> Backend.Backend IO NamespaceListing -serve codebase maySCH mayRelativeTo mayNamespaceName = do - rootCausal <- Backend.hoistBackend (Codebase.runTransaction codebase) $ Backend.normaliseRootCausalHash maySCH +serve codebase root mayRelativeTo mayNamespaceName = do + rootCausal <- Backend.hoistBackend (Codebase.runTransaction codebase) $ Backend.normaliseRootCausalHash root -- Relative and Listing Path resolution -- @@ -217,7 +218,7 @@ serve codebase maySCH mayRelativeTo mayNamespaceName = do let path = relativeToPath <> namespacePath (listingCausal, listingBranch) <- (lift . Codebase.runTransaction codebase) do - listingCausal <- Codebase.getShallowCausalAtPath path (Just rootCausal) + listingCausal <- Codebase.getShallowCausalAtPath path rootCausal listingBranch <- V2Causal.value listingCausal pure (listingCausal, listingBranch) -- TODO: Currently the ppe is just used to render the types returned from the namespace diff --git a/unison-share-api/src/Unison/Server/Types.hs b/unison-share-api/src/Unison/Server/Types.hs index 48f9ace2bc..b4e32cda4e 100644 --- a/unison-share-api/src/Unison/Server/Types.hs +++ b/unison-share-api/src/Unison/Server/Types.hs @@ -20,6 +20,7 @@ import Data.OpenApi.Lens qualified as OpenApi import Data.Text qualified as Text import Data.Text.Lazy qualified as Text.Lazy import Data.Text.Lazy.Encoding qualified as Text +import Servant qualified import Servant.API ( Capture, FromHttpApiData (..), @@ -540,3 +541,6 @@ instance ToJSON TypeDiffResponse where "oldType" .= oldType, "newType" .= newType ] + +-- | Servant utility for a query param that's required, providing a useful error message if it's missing. +type RequiredQueryParam = Servant.QueryParam' '[Servant.Required, Servant.Strict] From 2773153f97934467427f5c2ffbaa02024df9192f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 13:06:49 -0700 Subject: [PATCH 073/631] Fix argparse for running 'main' within project Add projectPath parser --- .../src/Unison/Codebase/ProjectPath.hs | 28 +++++++++++++++++++ unison-cli/src/ArgParse.hs | 11 ++++++-- 2 files changed, 36 insertions(+), 3 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index b2b831f9fb..441950d147 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -11,18 +11,25 @@ module Unison.Codebase.ProjectPath toIds, toNames, asProjectAndBranch_, + projectPathParser, + parseProjectPath, ) where import Control.Lens import Data.Bifoldable (Bifoldable (..)) import Data.Bitraversable (Bitraversable (..)) +import Data.Text qualified as Text +import Text.Megaparsec qualified as Megaparsec +import Text.Megaparsec.Char qualified as Megaparsec import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.Path.Parse qualified as Path import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) +import Unison.Project qualified as Project data ProjectPathG proj branch = ProjectPath { project :: proj, @@ -81,3 +88,24 @@ projectAndBranch_ = lens go set where go (ProjectPath proj branch _) = ProjectAndBranch proj branch set (ProjectPath _ _ p) (ProjectAndBranch proj branch) = ProjectPath proj branch p + +type Parser = Megaparsec.Parsec Void Text + +projectPathParser :: Parser ProjectPathNames +projectPathParser = do + (projName, hasTrailingSlash) <- Project.projectNameParser + projBranchName <- Project.projectBranchNameParser (not hasTrailingSlash) + _ <- Megaparsec.char ':' + path' >>= \case + Path.AbsolutePath' p -> pure $ ProjectPath projName projBranchName p + Path.RelativePath' {} -> fail "Expected an absolute path" + where + path' :: Parser Path.Path' + path' = do + pathStr <- Megaparsec.takeRest + case Path.parsePath' (Text.unpack pathStr) of + Left err -> fail (Text.unpack err) + Right x -> pure x + +parseProjectPath :: Text -> Either Text ProjectPathNames +parseProjectPath txt = first (Text.pack . Megaparsec.errorBundlePretty) $ Megaparsec.parse projectPathParser "" txt diff --git a/unison-cli/src/ArgParse.hs b/unison-cli/src/ArgParse.hs index 8d2251623a..ab24fd16c5 100644 --- a/unison-cli/src/ArgParse.hs +++ b/unison-cli/src/ArgParse.hs @@ -54,6 +54,8 @@ import Stats import System.Environment (lookupEnv) import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path +import Unison.Codebase.ProjectPath (ProjectPathNames) +import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.Types (ShouldWatchFiles (..)) import Unison.HashQualified (HashQualified) import Unison.LSP (LspFormattingConfig (..)) @@ -68,9 +70,8 @@ import Unison.Util.Pretty (Width (..)) -- | Valid ways to provide source code to the run command data RunSource = RunFromPipe (HashQualified Name) - | RunFromSymbol (ProjectAndBranch Project ProjectBranch, HashQualified Name) + | RunFromSymbol ProjectPathNames | RunFromFile FilePath (HashQualified Name) ->>>>>>> | RunCompiled FilePath deriving (Show, Eq) @@ -375,9 +376,13 @@ runHQParser :: Parser (HashQualified Name) runHQParser = argument (maybeReader (HQ.parseText . Text.pack)) (metavar "SYMBOL") +runProjectPathParser :: Parser PP.ProjectPathNames +runProjectPathParser = + argument (maybeReader (eitherToMaybe . PP.parseProjectPath . Text.pack)) (metavar "@myproject/mybranch:.path.in.project") + runSymbolParser :: Parser Command runSymbolParser = - Run . RunFromSymbol <$> runHQParser <*> runArgumentParser + Run . RunFromSymbol <$> runProjectPathParser <*> runArgumentParser runFileParser :: Parser Command runFileParser = From 33458a8141c0bbb5adb81e6064efc721be402532 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 13:06:49 -0700 Subject: [PATCH 074/631] Fix LSP to work with projects --- .../U/Codebase/Sqlite/Project.hs | 2 +- parser-typechecker/src/Unison/Codebase.hs | 12 ++++++ unison-cli/src/Unison/LSP.hs | 25 ++++++------ unison-cli/src/Unison/LSP/FileAnalysis.hs | 5 ++- unison-cli/src/Unison/LSP/Formatting.hs | 5 ++- unison-cli/src/Unison/LSP/Types.hs | 8 ++-- unison-cli/src/Unison/LSP/UCMWorker.hs | 38 +++++++++---------- 7 files changed, 52 insertions(+), 43 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Project.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Project.hs index 2707e09c74..94e90b5c00 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Project.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Project.hs @@ -14,5 +14,5 @@ data Project = Project { projectId :: !ProjectId, name :: !ProjectName } - deriving stock (Generic, Show) + deriving stock (Generic, Show, Eq) deriving anyclass (ToRow, FromRow) diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 1cc958b763..171367fc1c 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -53,6 +53,8 @@ module Unison.Codebase getShallowProjectRootBranch, getShallowBranchAtProjectPath, getShallowProjectRootByNames, + getProjectBranchRoot, + expectProjectBranchRoot, -- * Root branch SqliteCodebase.Operations.namesAtPath, @@ -230,6 +232,16 @@ getShallowProjectRootByNames (ProjectAndBranch projectName branchName) = runMayb causalHash <- lift $ Q.expectCausalHash causalHashId lift $ Operations.expectCausalBranchByCausalHash causalHash +getProjectBranchRoot :: (MonadIO m) => Codebase m v a -> ProjectBranch -> m (Maybe (Branch m)) +getProjectBranchRoot codebase ProjectBranch {causalHashId} = do + causalHash <- runTransaction codebase $ Q.expectCausalHash causalHashId + getBranchForHash codebase causalHash + +expectProjectBranchRoot :: (MonadIO m) => Codebase m v a -> ProjectBranch -> m (Branch m) +expectProjectBranchRoot codebase ProjectBranch {causalHashId} = do + causalHash <- runTransaction codebase $ Q.expectCausalHash causalHashId + expectBranchForHash codebase causalHash + -- | Like 'getBranchForHash', but for when the hash is known to be in the codebase. expectBranchForHash :: (Monad m) => Codebase m v a -> CausalHash -> m (Branch m) expectBranchForHash codebase hash = diff --git a/unison-cli/src/Unison/LSP.hs b/unison-cli/src/Unison/LSP.hs index 867a08ed1e..4ef4b92750 100644 --- a/unison-cli/src/Unison/LSP.hs +++ b/unison-cli/src/Unison/LSP.hs @@ -27,9 +27,8 @@ import Language.LSP.VFS import Network.Simple.TCP qualified as TCP import System.Environment (lookupEnv) import System.IO (hPutStrLn) -import U.Codebase.HashTags import Unison.Codebase -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) import Unison.Debug qualified as Debug import Unison.LSP.CancelRequest (cancelRequestHandler) @@ -61,8 +60,8 @@ getLspPort :: IO String getLspPort = fromMaybe "5757" <$> lookupEnv "UNISON_LSP_PORT" -- | Spawn an LSP server on the configured port. -spawnLsp :: LspFormattingConfig -> Codebase IO Symbol Ann -> Runtime Symbol -> STM CausalHash -> STM (Path.Absolute) -> IO () -spawnLsp lspFormattingConfig codebase runtime latestRootHash latestPath = +spawnLsp :: LspFormattingConfig -> Codebase IO Symbol Ann -> Runtime Symbol -> STM PP.ProjectPath -> IO () +spawnLsp lspFormattingConfig codebase runtime latestPath = ifEnabled . TCP.withSocketsDo $ do lspPort <- getLspPort UnliftIO.handleIO (handleFailure lspPort) $ do @@ -82,7 +81,7 @@ spawnLsp lspFormattingConfig codebase runtime latestRootHash latestPath = -- different un-saved state for the same file. initVFS $ \vfs -> do vfsVar <- newMVar vfs - void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestRootHash latestPath) + void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestPath) where handleFailure :: String -> IOException -> IO () handleFailure lspPort ioerr = @@ -113,16 +112,15 @@ serverDefinition :: Codebase IO Symbol Ann -> Runtime Symbol -> Ki.Scope -> - STM CausalHash -> - STM (Path.Absolute) -> + STM PP.ProjectPath -> ServerDefinition Config -serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestRootHash latestPath = +serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestPath = ServerDefinition { defaultConfig = defaultLSPConfig, configSection = "unison", parseConfig = Config.parseConfig, onConfigChange = Config.updateConfig, - doInitialize = lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath, + doInitialize = lspDoInitialize vfsVar codebase runtime scope latestPath, staticHandlers = lspStaticHandlers lspFormattingConfig, interpretHandler = lspInterpretHandler, options = lspOptions @@ -134,12 +132,11 @@ lspDoInitialize :: Codebase IO Symbol Ann -> Runtime Symbol -> Ki.Scope -> - STM CausalHash -> - STM (Path.Absolute) -> + STM PP.ProjectPath -> LanguageContextEnv Config -> Msg.TMessage 'Msg.Method_Initialize -> IO (Either Msg.ResponseError Env) -lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath lspContext _initMsg = do +lspDoInitialize vfsVar codebase runtime scope latestPath lspContext _initMsg = do checkedFilesVar <- newTVarIO mempty dirtyFilesVar <- newTVarIO mempty ppedCacheVar <- newEmptyTMVarIO @@ -152,13 +149,13 @@ lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath lspConte Env { ppedCache = atomically $ readTMVar ppedCacheVar, currentNamesCache = atomically $ readTMVar currentNamesCacheVar, - currentPathCache = atomically $ readTMVar currentPathCacheVar, + currentProjectPathCache = atomically $ readTMVar currentPathCacheVar, nameSearchCache = atomically $ readTMVar nameSearchCacheVar, .. } let lspToIO = flip runReaderT lspContext . unLspT . flip runReaderT env . runLspM Ki.fork scope (lspToIO Analysis.fileAnalysisWorker) - Ki.fork scope (lspToIO $ ucmWorker ppedCacheVar currentNamesCacheVar nameSearchCacheVar currentPathCacheVar latestRootHash latestPath) + Ki.fork scope (lspToIO $ ucmWorker ppedCacheVar currentNamesCacheVar nameSearchCacheVar currentPathCacheVar latestPath) pure $ Right $ env -- | LSP request handlers that don't register/unregister dynamically diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index f5f29b5e27..85ad0ba663 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -27,6 +27,7 @@ import Unison.ABT qualified as ABT import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) import Unison.Cli.UniqueTypeGuidLookup qualified as Cli import Unison.Codebase qualified as Codebase +import Unison.Codebase.ProjectPath qualified as PP import Unison.DataDeclaration qualified as DD import Unison.Debug qualified as Debug import Unison.FileParsers (ShouldUseTndr (..)) @@ -77,7 +78,7 @@ import Witherable -- | Lex, parse, and typecheck a file. checkFile :: (HasUri d Uri) => d -> Lsp (Maybe FileAnalysis) checkFile doc = runMaybeT do - currentPath <- lift getCurrentPath + pp <- lift getCurrentProjectPath let fileUri = doc ^. uri (fileVersion, contents) <- VFS.getFileContents fileUri parseNames <- lift getCurrentNames @@ -90,7 +91,7 @@ checkFile doc = runMaybeT do let parsingEnv = Parser.ParsingEnv { uniqueNames = uniqueName, - uniqueTypeGuid = Cli.loadUniqueTypeGuid currentPath, + uniqueTypeGuid = Cli.loadUniqueTypeGuid (pp ^. PP.absPath_), names = parseNames } (notes, parsedFile, typecheckedFile) <- do diff --git a/unison-cli/src/Unison/LSP/Formatting.hs b/unison-cli/src/Unison/LSP/Formatting.hs index 48e46d8028..ebba4b1a81 100644 --- a/unison-cli/src/Unison/LSP/Formatting.hs +++ b/unison-cli/src/Unison/LSP/Formatting.hs @@ -8,6 +8,7 @@ import Language.LSP.Protocol.Lens import Language.LSP.Protocol.Message qualified as Msg import Language.LSP.Protocol.Types import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Formatting +import Unison.Codebase.ProjectPath qualified as PP import Unison.LSP.Conversions (lspToURange, uToLspRange) import Unison.LSP.FileAnalysis (getFileAnalysis) import Unison.LSP.FileAnalysis qualified as FileAnalysis @@ -30,10 +31,10 @@ formatDefs :: Uri -> Maybe (Set Range {- the ranges to format, if Nothing then f formatDefs fileUri mayRangesToFormat = fromMaybe [] <$> runMaybeT do FileAnalysis {parsedFile = mayParsedFile, typecheckedFile = mayTypecheckedFile} <- getFileAnalysis fileUri - currentPath <- lift getCurrentPath + pp <- lift getCurrentProjectPath Config {formattingWidth} <- lift getConfig MaybeT $ - Formatting.formatFile (\uf tf -> FileAnalysis.ppedForFileHelper uf tf) formattingWidth currentPath mayParsedFile mayTypecheckedFile (Set.map lspToURange <$> mayRangesToFormat) + Formatting.formatFile (\uf tf -> FileAnalysis.ppedForFileHelper uf tf) formattingWidth (pp ^. PP.absPath_) mayParsedFile mayTypecheckedFile (Set.map lspToURange <$> mayRangesToFormat) <&> (fmap . fmap) uTextReplacementToLSP where uTextReplacementToLSP :: Formatting.TextReplacement -> TextEdit diff --git a/unison-cli/src/Unison/LSP/Types.hs b/unison-cli/src/Unison/LSP/Types.hs index c5fe0e9a95..b368e915ef 100644 --- a/unison-cli/src/Unison/LSP/Types.hs +++ b/unison-cli/src/Unison/LSP/Types.hs @@ -24,7 +24,7 @@ import Language.LSP.Server import Language.LSP.Server qualified as LSP import Language.LSP.VFS import Unison.Codebase -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) import Unison.Debug qualified as Debug import Unison.LSP.Orphans () @@ -72,7 +72,7 @@ data Env = Env currentNamesCache :: IO Names, ppedCache :: IO PrettyPrintEnvDecl, nameSearchCache :: IO (NameSearch Sqlite.Transaction), - currentPathCache :: IO Path.Absolute, + currentProjectPathCache :: IO PP.ProjectPath, vfsVar :: MVar VFS, runtime :: Runtime Symbol, -- The information we have for each file. @@ -129,8 +129,8 @@ data FileAnalysis = FileAnalysis } deriving stock (Show) -getCurrentPath :: Lsp Path.Absolute -getCurrentPath = asks currentPathCache >>= liftIO +getCurrentProjectPath :: Lsp PP.ProjectPath +getCurrentProjectPath = asks currentProjectPathCache >>= liftIO getCodebaseCompletions :: Lsp CompletionTree getCodebaseCompletions = asks completionsVar >>= atomically . readTMVar diff --git a/unison-cli/src/Unison/LSP/UCMWorker.hs b/unison-cli/src/Unison/LSP/UCMWorker.hs index 2f28955021..70212d29ad 100644 --- a/unison-cli/src/Unison/LSP/UCMWorker.hs +++ b/unison-cli/src/Unison/LSP/UCMWorker.hs @@ -1,16 +1,16 @@ module Unison.LSP.UCMWorker where import Control.Monad.Reader -import U.Codebase.HashTags import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Debug qualified as Debug import Unison.LSP.Completion import Unison.LSP.Types import Unison.LSP.VFS qualified as VFS import Unison.Names (Names) +import Unison.Prelude import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl import Unison.PrettyPrintEnvDecl.Names qualified as PPED @@ -24,21 +24,21 @@ ucmWorker :: TMVar PrettyPrintEnvDecl -> TMVar Names -> TMVar (NameSearch Sqlite.Transaction) -> - TMVar Path.Absolute -> - STM CausalHash -> - STM Path.Absolute -> + TMVar ProjectPath -> + STM ProjectPath -> Lsp () -ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar getLatestRoot getLatestPath = do +ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar getLatestProjectPath = do Env {codebase, completionsVar} <- ask - let loop :: (CausalHash, Path.Absolute) -> Lsp a - loop (currentRoot, currentPath) = do - Debug.debugM Debug.LSP "LSP path: " currentPath - currentBranch0 <- fmap Branch.head . liftIO $ (Codebase.getBranchAtPath codebase currentPath) + let loop :: ProjectPath -> Lsp a + loop currentProjectPath = do + currentBranch <- liftIO $ Codebase.expectProjectBranchRoot codebase (currentProjectPath ^. #branch) + Debug.debugM Debug.LSP "LSP path: " currentProjectPath + let currentBranch0 = Branch.head currentBranch let currentNames = Branch.toNames currentBranch0 hl <- liftIO $ Codebase.runTransaction codebase Codebase.hashLength let pped = PPED.makePPED (PPE.hqNamer hl currentNames) (PPE.suffixifyByHash currentNames) atomically $ do - writeTMVar currentPathVar currentPath + writeTMVar currentPathVar currentProjectPath writeTMVar currentNamesVar currentNames writeTMVar ppedVar pped writeTMVar nameSearchCacheVar (NameSearch.makeNameSearch hl currentNames) @@ -48,17 +48,15 @@ ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar getLatestRoo writeTMVar completionsVar (namesToCompletionTree currentNames) Debug.debugLogM Debug.LSP "LSP Initialized" latest <- atomically $ do - latestRoot <- getLatestRoot - latestPath <- getLatestPath - guard $ (currentRoot /= latestRoot || currentPath /= latestPath) - pure (latestRoot, latestPath) + latestPath <- getLatestProjectPath + guard $ (currentProjectPath /= latestPath) + pure latestPath Debug.debugLogM Debug.LSP "LSP Change detected" loop latest - (rootBranch, currentPath) <- atomically $ do - rootBranch <- getLatestRoot - currentPath <- getLatestPath - pure (rootBranch, currentPath) - loop (rootBranch, currentPath) + currentProjectPath <- atomically $ do + currentProjectPath <- getLatestProjectPath + pure currentProjectPath + loop currentProjectPath where -- This is added in stm-2.5.1, remove this if we upgrade. writeTMVar :: TMVar a -> a -> STM () From 4e2ccf23cc3dd366acb5d153a0e50304274bab63 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 14:12:46 -0700 Subject: [PATCH 075/631] Fix up some more root branch gets --- parser-typechecker/src/Unison/Codebase.hs | 10 ++++++++++ unison-cli/src/Unison/Cli/MonadUtils.hs | 4 ++-- unison-cli/src/Unison/CommandLine.hs | 5 ++--- unison-cli/src/Unison/CommandLine/InputPattern.hs | 3 +-- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 1 - 5 files changed, 15 insertions(+), 8 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 171367fc1c..fbe1d51d4a 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -55,6 +55,7 @@ module Unison.Codebase getShallowProjectRootByNames, getProjectBranchRoot, expectProjectBranchRoot, + getBranchAtProjectPath, -- * Root branch SqliteCodebase.Operations.namesAtPath, @@ -242,6 +243,15 @@ expectProjectBranchRoot codebase ProjectBranch {causalHashId} = do causalHash <- runTransaction codebase $ Q.expectCausalHash causalHashId expectBranchForHash codebase causalHash +getBranchAtProjectPath :: + (MonadIO m) => + Codebase m v a -> + PP.ProjectPath -> + m (Maybe (Branch m)) +getBranchAtProjectPath codebase pp = runMaybeT do + rootBranch <- MaybeT $ getProjectBranchRoot codebase (pp ^. #branch) + hoistMaybe $ Branch.getAt (pp ^. PP.path_) rootBranch + -- | Like 'getBranchForHash', but for when the hash is known to be in the codebase. expectBranchForHash :: (Monad m) => Codebase m v a -> CausalHash -> m (Branch m) expectBranchForHash codebase hash = diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 58dd5410e3..0a07833e39 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -280,9 +280,9 @@ modifyProjectRoot f = do -- | Get the current branch. getCurrentBranch :: Cli (Branch IO) getCurrentBranch = do - path <- getCurrentPath Cli.Env {codebase} <- ask - liftIO $ Codebase.getBranchAtPath codebase path + pp <- getCurrentProjectPath + liftIO $ Codebase.getBranchAtProjectPath codebase pp -- | Get the current branch0. getCurrentBranch0 :: Cli (Branch0 IO) diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index fb6cc05453..4c100ab293 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -46,9 +46,8 @@ import Unison.Codebase (Codebase) import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Input (Event (..), Input (..)) -import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Editor.Output (NumberedArgs) -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Watch qualified as Watch import Unison.CommandLine.FZFResolvers qualified as FZFResolvers import Unison.CommandLine.FuzzySelect qualified as Fuzzy @@ -133,7 +132,7 @@ parseInput :: -- Returns either an error message or the fully expanded arguments list and parsed input. -- If the output is `Nothing`, the user cancelled the input (e.g. ctrl-c) IO (Either (P.Pretty CT.ColorText) (Maybe (InputPattern.Arguments, Input))) - parseInput codebase projPath currentProjectRoot numberedArgs patterns segments = runExceptT do +parseInput codebase projPath currentProjectRoot numberedArgs patterns segments = runExceptT do let getCurrentBranch0 :: IO (Branch0 IO) getCurrentBranch0 = do projRoot <- currentProjectRoot diff --git a/unison-cli/src/Unison/CommandLine/InputPattern.hs b/unison-cli/src/Unison/CommandLine/InputPattern.hs index 001d4186f9..01f7ddebc4 100644 --- a/unison-cli/src/Unison/CommandLine/InputPattern.hs +++ b/unison-cli/src/Unison/CommandLine/InputPattern.hs @@ -27,9 +27,8 @@ import System.Console.Haskeline qualified as Line import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Codebase (Codebase) import Unison.Codebase.Editor.Input (Input (..)) -import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) -import Unison.Codebase.Path as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.FZFResolvers (FZFResolver (..)) import Unison.Prelude import Unison.Util.ColorText qualified as CT diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 9c20725120..9748a14bcd 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -207,7 +207,6 @@ import Unison.Project import Unison.Syntax.HashQualified qualified as HQ (parseText) import Unison.Syntax.Name qualified as Name (parseText, unsafeParseText) import Unison.Syntax.NameSegment qualified as NameSegment (renderParseErr, segmentP) -import Unison.Project.Util (ProjectContext (..), projectContextFromPath) import Unison.Referent qualified as Referent import Unison.Server.Backend (ShallowListEntry (..)) import Unison.Server.Backend qualified as Backend From f0d2c84c48cfeaeb70286c4f3308c4e1415bc652 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 3 Jun 2024 18:10:10 -0400 Subject: [PATCH 076/631] tmp --- .../src/Unison/CommandLine/InputPatterns.hs | 77 ++++++++++--------- 1 file changed, 41 insertions(+), 36 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index f2016eeed5..52dea08183 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1687,42 +1687,47 @@ pullImpl name aliases pullMode addendum = do (flip Input.PullI pullMode) . ( \case [] -> pure $ Input.PullSourceTarget0 - [sourceString] -> - bimap (\err -> I.help self <> P.newline <> err) Input.PullSourceTarget1 $ - handlePullSourceArg sourceString - [sourceString, targetString] -> - Input.PullSourceTarget2 - <$> first (\err -> I.help self <> P.newline <> err) (handlePullSourceArg sourceString) - <*> first - ( \err -> - -- You used to be able to pull into a path. So if target parsing fails, but path parsing succeeds, - -- explain that the command has changed. Furthermore, in the special case that the user is trying to - -- pull into the `lib` namespace, suggest using `lib.install`. - case handlePath'Arg targetString of - Left _ -> I.help self <> P.newline <> err - Right path -> - I.help self - <> P.newline - <> P.newline - <> P.newline - <> let pullingIntoLib = - case path of - Path.RelativePath' - ( Path.Relative - (Path.toList -> lib : _) - ) -> lib == NameSegment.libSegment - _ -> False - in P.wrap $ - "You may only" - <> makeExample' pull - <> "into a branch." - <> if pullingIntoLib - then - "Did you mean to run" - <> P.group (makeExample libInstallInputPattern [P.string $ unifyArgument sourceString] <> "?") - else mempty - ) - (handleMaybeProjectBranchArg targetString) + [sourceString] -> Input.PullSourceTarget1 <$> handlePullSourceArg sourceString + [sourceString, targetString] -> do + source <- handlePullSourceArg sourceString + target <- + handleMaybeProjectBranchArg targetString & mapLeft \err -> + -- You used to be able to pull into a path, so... + case handlePath'Arg targetString of + -- Parsing as a path didn't work either, just show the original parse error + Left _ -> err + -- The user is trying to pull into `lib`, but you can't do that anymore. Suggest using + -- `lib.install` instead (though + -- user is trying to pull into the `lib` namespace, suggest using `lib.install`. + Right (Path.RelativePath' (Path.Relative (Path.toList -> lib : _))) + | lib == NameSegment.libSegment -> undefined + | otherwise -> + P.wrap $ "I think you're wanting to merge" + -- I think you're wanting to merge @unison/base/releases/latest into the `a.b` subnamespace; but + -- the `pull` command only supports merging into the top level of a local project branch. + Right path -> + I.help self + <> P.newline + <> P.newline + <> P.newline + <> let pullingIntoLib = + case path of + Path.RelativePath' + ( Path.Relative + (Path.toList -> lib : _) + ) -> lib == NameSegment.libSegment + _ -> False + in -- Use `help pull` to see some examples. + P.wrap $ + "You may only" + <> makeExample' pull + <> "into a branch." + <> if pullingIntoLib + then + "Did you mean to run" + <> P.group (makeExample libInstallInputPattern [P.string $ unifyArgument sourceString] <> "?") + else mempty + pure (Input.PullSourceTarget2 source target) _ -> Left $ I.help self ) } From 138c6e96cef54451d93bf48f8a4e6c7c7da5b7bb Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 14:18:30 -0700 Subject: [PATCH 077/631] Fix up input patterns for project branch args --- .../src/Unison/CommandLine/InputPatterns.hs | 59 +++++++++---------- 1 file changed, 27 insertions(+), 32 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 9748a14bcd..d8cd31ad9c 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -137,7 +137,6 @@ module Unison.CommandLine.InputPatterns ) where -import Control.Lens (preview, review) import Control.Lens.Cons qualified as Cons import Data.List (intercalate) import Data.List.Extra qualified as List @@ -192,8 +191,8 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment -import Unison.Prelude hiding (view) import Unison.Parser.Ann (Ann) +import Unison.Prelude hiding (view) import Unison.Project ( ProjectAndBranch (..), ProjectAndBranchNames (..), @@ -204,9 +203,6 @@ import Unison.Project Semver, branchWithOptionalProjectParser, ) -import Unison.Syntax.HashQualified qualified as HQ (parseText) -import Unison.Syntax.Name qualified as Name (parseText, unsafeParseText) -import Unison.Syntax.NameSegment qualified as NameSegment (renderParseErr, segmentP) import Unison.Referent qualified as Referent import Unison.Server.Backend (ShallowListEntry (..)) import Unison.Server.Backend qualified as Backend @@ -351,15 +347,6 @@ handleProjectArg = SA.Project project -> pure project otherArgType -> Left $ wrongStructuredArgument "a project" otherArgType -handleLooseCodeOrProjectArg :: I.Argument -> Either (P.Pretty CT.ColorText) Input.LooseCodeOrProject -handleLooseCodeOrProjectArg = - either - (maybe (Left $ P.text "invalid path or project branch") pure . parseLooseCodeOrProject) - \case - SA.AbsolutePath path -> pure . This $ Path.absoluteToPath' path - SA.ProjectBranch pb -> pure $ That pb - otherArgType -> Left $ wrongStructuredArgument "a path or project branch" otherArgType - handleMaybeProjectBranchArg :: I.Argument -> Either (P.Pretty CT.ColorText) (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) handleMaybeProjectBranchArg = @@ -394,7 +381,6 @@ handleHashQualifiedNameArg = SA.SearchResult mpath result -> pure $ searchResultToHQ mpath result otherArgType -> Left $ wrongStructuredArgument "a hash-qualified name" otherArgType - handlePathArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path handlePathArg = either @@ -510,13 +496,15 @@ handleBranchId2Arg = Input.parseBranchId2 \case SA.Namespace hash -> pure . Left $ SCH.fromFullHash hash - SA.AbsolutePath path -> pure . pure . LoosePath $ Path.absoluteToPath' path - SA.Name name -> pure . pure . LoosePath $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> pure . pure . LoosePath $ Path.fromName' name + SA.AbsolutePath path -> pure . pure . UnqualifiedPath $ Path.absoluteToPath' path + SA.Name name -> pure . pure . UnqualifiedPath $ Path.fromName' name + SA.NameWithBranchPrefix (Left _) name -> pure . pure . UnqualifiedPath $ Path.fromName' name SA.NameWithBranchPrefix (Right prefix) name -> - pure . pure . LoosePath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + pure . pure . UnqualifiedPath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name SA.ProjectBranch (ProjectAndBranch mproject branch) -> - pure . pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject + case mproject of + Just proj -> pure . pure $ QualifiedBranchPath proj branch Path.absoluteEmpty + Nothing -> pure . pure $ BranchPathInCurrentProject branch Path.absoluteEmpty otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg handleBranchRelativePathArg :: I.Argument -> Either (P.Pretty P.ColorText) BranchRelativePath @@ -524,13 +512,15 @@ handleBranchRelativePathArg = either parseBranchRelativePath \case - SA.AbsolutePath path -> pure . LoosePath $ Path.absoluteToPath' path - SA.Name name -> pure . LoosePath $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> pure . LoosePath $ Path.fromName' name + SA.AbsolutePath path -> pure . UnqualifiedPath $ Path.absoluteToPath' path + SA.Name name -> pure . UnqualifiedPath $ Path.fromName' name + SA.NameWithBranchPrefix (Left _) name -> pure . UnqualifiedPath $ Path.fromName' name SA.NameWithBranchPrefix (Right prefix) name -> - pure . LoosePath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + pure . UnqualifiedPath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name SA.ProjectBranch (ProjectAndBranch mproject branch) -> - pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject + case mproject of + Just proj -> pure $ QualifiedBranchPath proj branch Path.absoluteEmpty + Nothing -> pure $ BranchPathInCurrentProject branch Path.absoluteEmpty otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg hqNameToSplit' :: HQ.HashQualified Name -> Either ShortHash Path.HQSplit' @@ -1484,7 +1474,7 @@ deleteNamespaceForce = deleteNamespaceParser :: P.Pretty CT.ColorText -> Input.Insistence -> I.Arguments -> Either (P.Pretty CT.ColorText) Input deleteNamespaceParser helpText insistence = \case - [p] -> Input.DeleteI . DeleteTarget'Namespace insistence . pure <$> handleSplitArg p + [p] -> Input.DeleteI . DeleteTarget'Namespace insistence <$> handleSplitArg p _ -> Left helpText renameBranch :: InputPattern @@ -1975,10 +1965,15 @@ mergeOldSquashInputPattern = <> "The resulting `dest` will have (at most) 1" <> "additional history entry.", parse = \case + [src] -> + Input.MergeLocalBranchI + <$> handleMaybeProjectBranchArg src + <*> pure Nothing + <*> pure Branch.SquashMerge [src, dest] -> Input.MergeLocalBranchI <$> handleMaybeProjectBranchArg src - <*> handleMaybeProjectBranchArg dest + <*> (Just <$> handleMaybeProjectBranchArg dest) <*> pure Branch.SquashMerge _ -> Left $ I.help mergeOldSquashInputPattern } @@ -2018,12 +2013,12 @@ mergeOldInputPattern = [src] -> Input.MergeLocalBranchI <$> handleMaybeProjectBranchArg src - <*> pure (This Path.relativeEmpty') + <*> pure Nothing <*> pure Branch.RegularMerge [src, dest] -> Input.MergeLocalBranchI <$> handleMaybeProjectBranchArg src - <*> handleMaybeProjectBranchArg dest + <*> (Just <$> handleMaybeProjectBranchArg dest) <*> pure Branch.RegularMerge _ -> Left $ I.help mergeOldInputPattern ) @@ -2106,9 +2101,9 @@ mergeOldPreviewInputPattern = ] ) ( \case - [src] -> Input.PreviewMergeLocalBranchI <$> handleMaybeProjectBranchArg src <*> pure (This Path.relativeEmpty') + [src] -> Input.PreviewMergeLocalBranchI <$> handleMaybeProjectBranchArg src <*> pure Nothing [src, dest] -> - Input.PreviewMergeLocalBranchI <$> handleMaybeProjectBranchArg src <*> handleLooseCodeOrProjectArg dest + Input.PreviewMergeLocalBranchI <$> handleMaybeProjectBranchArg src <*> (Just <$> handleMaybeProjectBranchArg dest) _ -> Left $ I.help mergeOldPreviewInputPattern ) where @@ -3005,7 +3000,7 @@ branchInputPattern = ], parse = \case [source0, name] -> - Input.BranchI . Input.BranchSourceI'LooseCodeOrProject + Input.BranchI . Input.BranchSourceI'UnresolvedProjectBranch <$> handleMaybeProjectBranchArg source0 <*> handleMaybeProjectBranchArg name [name] -> Input.BranchI Input.BranchSourceI'CurrentContext <$> handleMaybeProjectBranchArg name From 75cf28d4dd9504fc9c97a88a0b5c7c817942f8e4 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 3 Jun 2024 19:44:57 -0400 Subject: [PATCH 078/631] some better error messages when trying to pull into a path --- codebase2/core/Unison/NameSegment.hs | 4 + .../src/Unison/Codebase/Editor/HandleInput.hs | 2 +- .../Codebase/Editor/HandleInput/InstallLib.hs | 7 +- .../src/Unison/Codebase/Editor/Input.hs | 4 +- .../src/Unison/Codebase/Editor/Output.hs | 3 + .../src/Unison/CommandLine/InputPatterns.hs | 116 ++++++++++-------- .../src/Unison/CommandLine/OutputMessages.hs | 6 + 7 files changed, 88 insertions(+), 54 deletions(-) diff --git a/codebase2/core/Unison/NameSegment.hs b/codebase2/core/Unison/NameSegment.hs index d14f8c86b9..32771f75dc 100644 --- a/codebase2/core/Unison/NameSegment.hs +++ b/codebase2/core/Unison/NameSegment.hs @@ -5,6 +5,7 @@ module Unison.NameSegment defaultPatchSegment, docSegment, libSegment, + pattern LibSegment, publicLooseCodeSegment, baseSegment, snocSegment, @@ -36,6 +37,9 @@ docSegment = NameSegment "doc" libSegment :: NameSegment libSegment = NameSegment "lib" +pattern LibSegment :: NameSegment +pattern LibSegment = NameSegment "lib" + publicLooseCodeSegment :: NameSegment publicLooseCodeSegment = NameSegment "public" diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 76218eba92..26f54ace25 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -965,7 +965,7 @@ loop e = do ReleaseDraftI semver -> handleReleaseDraft semver UpgradeI old new -> handleUpgrade old new UpgradeCommitI -> handleCommitUpgrade - LibInstallI libdep -> handleInstallLib libdep + LibInstallI remind libdep -> handleInstallLib remind libdep inputDescription :: Input -> Cli Text inputDescription input = diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs index f43ffbb41a..1085a93f48 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs @@ -38,8 +38,8 @@ import Unison.Project ) import Unison.Syntax.NameSegment qualified as NameSegment (unsafeParseText) -handleInstallLib :: ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease) -> Cli () -handleInstallLib (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName) = do +handleInstallLib :: Bool -> ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease) -> Cli () +handleInstallLib remind (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName) = do (currentProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch let currentProjectBranchPath = @@ -63,6 +63,9 @@ handleInstallLib (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName) Share.IncludeSquashedHead (ProjectAndBranch (libdepProject.projectId, libdepProjectName) libdepBranchName) + when remind do + Cli.respond (Output.UseLibInstallNotPull (ProjectAndBranch libdepProjectName libdepBranchName)) + Cli.Env {codebase} <- ask causalHash <- diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 36fc59a033..8edb5317cb 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -224,7 +224,9 @@ data Input | EditNamespaceI [Path.Path] | -- New merge algorithm: merge the given project branch into the current one. MergeI (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - | LibInstallI !(ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) + | LibInstallI + !Bool -- Remind the user to use `lib.install` next time, not `pull`? + !(ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) | UpgradeCommitI deriving (Eq, Show) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 397813e837..9e13e7dd26 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -406,6 +406,8 @@ data Output | MergeStrayConstructor !MergeSourceOrTarget !Name | InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment | NoUpgradeInProgress + | UseLibInstallNotPull !(ProjectAndBranch ProjectName ProjectBranchName) + data UpdateOrUpgrade = UOUUpdate | UOUUpgrade @@ -643,6 +645,7 @@ isFailure o = case o of MergeStrayConstructor {} -> True InstalledLibdep {} -> False NoUpgradeInProgress {} -> True + UseLibInstallNotPull {} -> 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 52dea08183..8e36ab3232 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -157,7 +157,7 @@ import U.Codebase.Sqlite.DbId (ProjectBranchId) import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Auth.HTTPClient (AuthenticatedHttpClient) -import Unison.Cli.Pretty (prettyProjectAndBranchName, prettyProjectName, prettyProjectNameSlash, prettySlashProjectBranchName, prettyURI) +import Unison.Cli.Pretty (prettyPath', prettyProjectAndBranchName, prettyProjectName, prettyProjectNameSlash, prettySlashProjectBranchName, prettyURI) import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase @@ -1569,7 +1569,7 @@ libInstallInputPattern = ] ], parse = \case - [arg] -> Input.LibInstallI <$> handleProjectMaybeBranchArg arg + [arg] -> Input.LibInstallI False <$> handleProjectMaybeBranchArg arg _ -> Left (I.help libInstallInputPattern) } @@ -1682,54 +1682,70 @@ pullImpl name aliases pullMode addendum = do "", explainRemote Pull ], - parse = - fmap - (flip Input.PullI pullMode) - . ( \case - [] -> pure $ Input.PullSourceTarget0 - [sourceString] -> Input.PullSourceTarget1 <$> handlePullSourceArg sourceString - [sourceString, targetString] -> do - source <- handlePullSourceArg sourceString - target <- - handleMaybeProjectBranchArg targetString & mapLeft \err -> - -- You used to be able to pull into a path, so... - case handlePath'Arg targetString of - -- Parsing as a path didn't work either, just show the original parse error - Left _ -> err - -- The user is trying to pull into `lib`, but you can't do that anymore. Suggest using - -- `lib.install` instead (though - -- user is trying to pull into the `lib` namespace, suggest using `lib.install`. - Right (Path.RelativePath' (Path.Relative (Path.toList -> lib : _))) - | lib == NameSegment.libSegment -> undefined - | otherwise -> - P.wrap $ "I think you're wanting to merge" - -- I think you're wanting to merge @unison/base/releases/latest into the `a.b` subnamespace; but - -- the `pull` command only supports merging into the top level of a local project branch. - Right path -> - I.help self - <> P.newline - <> P.newline - <> P.newline - <> let pullingIntoLib = - case path of - Path.RelativePath' - ( Path.Relative - (Path.toList -> lib : _) - ) -> lib == NameSegment.libSegment - _ -> False - in -- Use `help pull` to see some examples. - P.wrap $ - "You may only" - <> makeExample' pull - <> "into a branch." - <> if pullingIntoLib - then - "Did you mean to run" - <> P.group (makeExample libInstallInputPattern [P.string $ unifyArgument sourceString] <> "?") - else mempty - pure (Input.PullSourceTarget2 source target) - _ -> Left $ I.help self - ) + parse = \case + [] -> pure $ Input.PullI Input.PullSourceTarget0 pullMode + [sourceArg] -> do + source <- handlePullSourceArg sourceArg + pure (Input.PullI (Input.PullSourceTarget1 source) pullMode) + [sourceArg, targetArg] -> + -- You used to be able to pull into a path, so this arg parser is a little complicated, because + -- we want to provide helpful suggestions if you are doing a deprecated or invalid thing. + case ( handlePullSourceArg sourceArg, + handleMaybeProjectBranchArg targetArg, + handlePath'Arg targetArg + ) of + (Right source, Right target, _) -> Right (Input.PullI (Input.PullSourceTarget2 source target) pullMode) + (Left err, _, _) -> Left err + -- Parsing as a path didn't work either; just show the branch parse error + (Right _, Left err, Left _) -> Left err + -- The user is trying to pull a branch into `lib`, but you can't do that anymore. We will ignore + -- the name they've chosed (e.g. "lib.base"), and instead run `lib.install` (which picks a + -- name), with a reminder message that `lib.install` is the new way. + -- + -- Oops we're ignoring the "pull mode" but `pull.without-history` shouldn't really be a `pull` anyway... + ( Right (RemoteRepo.ReadShare'ProjectBranch source), + Left _, + Right (Path.RelativePath' (Path.Relative (Path.toList -> NameSegment.LibSegment : _))) + ) -> + case source of + This sourceProject -> Right (Input.LibInstallI True (ProjectAndBranch sourceProject Nothing)) + -- Nice, since we can `pull /branch` but can't `lib.install /branch`, we fail here after all. + That _sourceBranch -> + Left $ + P.wrap + ( "The use of" + <> makeExample' pull + <> "to install libraries is now deprecated. Going forward, you can use" + <> P.group (makeExample libInstallInputPattern ["@user/project/branch-or-release"] <> ".") + ) + These sourceProject sourceBranch -> + Right (Input.LibInstallI True (ProjectAndBranch sourceProject (Just sourceBranch))) + (Right source, Left _, Right path) -> + Left $ + P.wrap + ( "I think you're wanting to merge" + <> case source of + RemoteRepo.ReadShare'LooseCode _sourcePath -> "some non-project code" + RemoteRepo.ReadShare'ProjectBranch (This sourceProject) -> + prettyProjectNameSlash sourceProject + RemoteRepo.ReadShare'ProjectBranch (That ProjectBranchNameOrLatestRelease'LatestRelease) -> + "the latest release" + RemoteRepo.ReadShare'ProjectBranch (That (ProjectBranchNameOrLatestRelease'Name sourceBranch)) -> + prettySlashProjectBranchName sourceBranch + RemoteRepo.ReadShare'ProjectBranch (These sourceProject ProjectBranchNameOrLatestRelease'LatestRelease) -> + "the latest release of" <> prettyProjectName sourceProject + RemoteRepo.ReadShare'ProjectBranch (These sourceProject (ProjectBranchNameOrLatestRelease'Name sourceBranch)) -> + prettyProjectAndBranchName (ProjectAndBranch sourceProject sourceBranch) + <> "into the" + <> prettyPath' path + <> "namespace, but the" + <> makeExample' pull + <> "command only supports merging into the top level of a local project branch." + ) + <> P.newline + <> P.newline + <> P.wrap "Use `help pull` to see some examples." + _ -> Left $ I.help self } debugTabCompletion :: InputPattern diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index fa3aedbe99..bef6eda4a3 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2089,6 +2089,12 @@ notifyUser dir = \case <> P.group (P.text (NameSegment.toEscapedText segment) <> ".") NoUpgradeInProgress -> pure . P.wrap $ "It doesn't look like there's an upgrade in progress." + UseLibInstallNotPull libdep -> + pure . P.wrap $ + "The use of" + <> IP.makeExample' IP.pull + <> "to install libraries is now deprecated. Going forward, you can use" + <> P.group (IP.makeExample IP.libInstallInputPattern [prettyProjectAndBranchName libdep] <> ".") expectedEmptyPushDest :: WriteRemoteNamespace Void -> Pretty expectedEmptyPushDest namespace = From 3267a3e54cc565ae7b8d79ec336ecaf8f511f4c7 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 16:30:49 -0700 Subject: [PATCH 079/631] Fix up Merge2 --- .../src/Unison/Codebase/ProjectPath.hs | 4 ++ unison-cli/src/Unison/Cli/ProjectUtils.hs | 14 +++--- .../Codebase/Editor/HandleInput/Branch.hs | 48 +++++++++++++++---- .../Codebase/Editor/HandleInput/Merge2.hs | 23 ++++----- 4 files changed, 57 insertions(+), 32 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index 441950d147..5c249cea40 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -4,6 +4,7 @@ module Unison.Codebase.ProjectPath ProjectPathNames, ProjectPath, fromProjectAndBranch, + projectBranchRoot, absPath_, path_, projectAndBranch_, @@ -44,6 +45,9 @@ type ProjectPathNames = ProjectPathG ProjectName ProjectBranchName type ProjectPath = ProjectPathG Project ProjectBranch +projectBranchRoot :: ProjectAndBranch Project ProjectBranch -> ProjectPath +projectBranchRoot (ProjectAndBranch proj branch) = ProjectPath proj branch Path.absoluteEmpty + fromProjectAndBranch :: ProjectAndBranch Project ProjectBranch -> Path.Absolute -> ProjectPath fromProjectAndBranch (ProjectAndBranch proj branch) path = ProjectPath proj branch path diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index 2dccc83bb3..e4017e307c 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -12,6 +12,7 @@ module Unison.Cli.ProjectUtils expectProjectAndBranchByIds, getProjectAndBranchByTheseNames, expectProjectAndBranchByTheseNames, + getProjectBranchCausalHash, -- * Loading remote project info expectRemoteProjectById, @@ -43,20 +44,19 @@ import Data.Maybe (fromJust) import Data.Set qualified as Set import Data.Text qualified as Text import Data.These (These (..)) -import U.Codebase.Causal qualified import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.DbId import U.Codebase.Sqlite.Project (Project) import U.Codebase.Sqlite.Project qualified as Sqlite +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite +import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.Share.Projects (IncludeSquashedHead) import Unison.Cli.Share.Projects qualified as Share -import Unison.Codebase qualified as Codebase -import Unison.Codebase.Editor.Input (LooseCodeOrProject) import Unison.Codebase.Editor.Output (Output (LocalProjectBranchDoesntExist)) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path @@ -201,11 +201,9 @@ resolveProjectBranch defaultProj (ProjectAndBranch mayProjectName mayBranchName) pure projectAndBranch -- | Get the causal hash of a project branch. -getProjectBranchCausalHash :: ProjectAndBranch ProjectId ProjectBranchId -> Transaction CausalHash -getProjectBranchCausalHash branch = do - let path = projectBranchPath branch - causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute path) - pure causal.causalHash +getProjectBranchCausalHash :: ProjectBranch -> Transaction CausalHash +getProjectBranchCausalHash ProjectBranch {causalHashId} = do + Q.expectCausalHash causalHashId ------------------------------------------------------------------------------------------------------------------------ -- Remote project utils diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 1747ba2628..4da27dca65 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -1,23 +1,27 @@ -- | @branch@ input handler module Unison.Codebase.Editor.HandleInput.Branch ( handleBranch, - doCreateBranch, + createBranchFromParent, + createBranchFromNamespace, ) where -import Data.These (These (..)) +import Control.Monad.Reader import Data.UUID.V4 qualified as UUID import U.Codebase.Sqlite.DbId import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.ProjectBranch qualified as ProjectBranch import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite +import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch (Branch) +import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.ProjectPath qualified as PP @@ -40,10 +44,10 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB ProjectBranchNameKind'NothingSpecial -> pure () currentProjectName <- Cli.getCurrentProjectPath <&> view (#project . #name) + let projectName = (fromMaybe currentProjectName mayProjectName) destProject <- do Cli.runTransactionWithRollback \rollback -> do - let projectName = (fromMaybe currentProjectName mayProjectName) Queries.loadProjectByName projectName & onNothingM do -- We can't make the *first* branch of a project with `branch`; the project has to already exist. rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName newBranchName)) @@ -57,7 +61,7 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB pp <- Cli.getCurrentProjectPath Just <$> ProjectUtils.resolveProjectBranch (pp ^. #project) (unresolvedProjectBranch & #branch %~ Just) - _ <- doCreateBranch (view #branch <$> maySrcProjectAndBranch) destProject newBranchName + _ <- createBranchFromParent (view #branch <$> maySrcProjectAndBranch) destProject newBranchName Cli.respond $ Output.CreatedProjectBranch @@ -68,9 +72,9 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB else Output.CreatedProjectBranchFrom'OtherBranch sourceBranch Nothing -> Output.CreatedProjectBranchFrom'Nothingness ) - projectAndBranchNames + (projectAndBranchNames & #project .~ projectName) --- | @doCreateBranch createFrom project branch description@: +-- | @createBranchFromParent createFrom project branch description@: -- -- 1. Creates a new branch row for @branch@ in project @project@ (failing if @branch@ already exists in @project@). -- 3. Switches to the new branch. @@ -79,17 +83,16 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB -- @release.draft@ command, which essentially just creates a branch, but with some different output for the user. -- -- Returns the branch id of the newly-created branch. -doCreateBranch :: +createBranchFromParent :: -- If no parent branch is provided, make an empty branch. Maybe Sqlite.ProjectBranch -> Sqlite.Project -> ProjectBranchName -> Cli ProjectBranchId -doCreateBranch mayParentBranch project getNewBranchName = do +createBranchFromParent mayParentBranch project newBranchName = do let projectId = project ^. #projectId newBranchId <- Cli.runTransactionWithRollback \rollback -> do - newBranchName <- getNewBranchName Queries.projectBranchExistsByName projectId newBranchName >>= \case True -> rollback (Output.ProjectAndBranchNameAlreadyExists (ProjectAndBranch (project ^. #name) newBranchName)) False -> do @@ -112,3 +115,30 @@ doCreateBranch mayParentBranch project getNewBranchName = do Cli.switchProject (ProjectAndBranch projectId newBranchId) pure newBranchId + +createBranchFromNamespace :: Sqlite.Project -> Sqlite.Transaction ProjectBranchName -> Branch IO -> Cli ProjectBranchId +createBranchFromNamespace project getBranchName branch = do + let projectId = project ^. #projectId + Cli.Env {codebase} <- ask + let causalHash = Branch.headHash branch + liftIO $ Codebase.putBranch codebase branch + newBranchId <- + Cli.runTransactionWithRollback \rollback -> do + branchName <- getBranchName + Queries.projectBranchExistsByName projectId branchName >>= \case + True -> rollback (Output.ProjectAndBranchNameAlreadyExists (ProjectAndBranch (project ^. #name) branchName)) + False -> do + newProjectBranchId <- Sqlite.unsafeIO (ProjectBranchId <$> UUID.nextRandom) + newBranchCausalHashId <- Q.expectCausalHashIdByCausalHash causalHash + Queries.insertProjectBranch + Sqlite.ProjectBranch + { projectId, + branchId = newProjectBranchId, + name = branchName, + parentBranchId = Nothing, + causalHashId = newBranchCausalHashId + } + pure newProjectBranchId + + Cli.switchProject (ProjectAndBranch projectId newBranchId) + pure newBranchId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 352bb0d1f9..3c1af1358e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -42,6 +42,7 @@ import U.Codebase.Sqlite.DbId (ProjectId) import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Builtin.Decls qualified as Builtin.Decls import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceAndTarget (..), MergeSourceOrTarget (..)) @@ -66,6 +67,7 @@ import Unison.Codebase.Editor.RemoteRepo (ReadShareLooseCode (..)) import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath (ProjectPathG (..)) +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache) import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions import Unison.Codebase.SqliteCodebase.Operations qualified as Operations @@ -139,14 +141,12 @@ import Unison.Util.SyntaxText (SyntaxText') import Unison.Var (Var) import Witch (unsafeFrom) import Prelude hiding (unzip, zip, zipWith) -import qualified U.Codebase.Sqlite.Queries as Q handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do -- Assert that Alice (us) is on a project branch, and grab the causal hash. ProjectPath aliceProject aliceProjectBranch _path <- Cli.getCurrentProjectPath let aliceProjectAndBranch = ProjectAndBranch aliceProject aliceProjectBranch - aliceCausalHash <- Cli.runTransaction (projectBranchToCausalHash aliceProjectBranch) -- Resolve Bob's maybe-project-name + branch-name to the info the merge algorithm needs: the project name, branch -- name, and causal hash. @@ -166,10 +166,6 @@ handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do { alice = aliceProjectAndBranch, bob = bobProjectAndBranch } - where - projectBranchToCausalHash :: ProjectBranch -> Transaction CausalHash - projectBranchToCausalHash branch = do - Q.expectCausalHash (branch ^. causalHashId) data MergeInfo = MergeInfo { alice :: !AliceMergeInfo, @@ -200,7 +196,6 @@ doMerge info = do then realDebugFunctions else fakeDebugFunctions - let alicePath = ProjectUtils.projectBranchPath (ProjectUtils.justTheIds info.alice.projectAndBranch) let aliceBranchNames = ProjectUtils.justTheNames info.alice.projectAndBranch let mergeSource = MergeSourceOrTarget'Source info.bob.source let mergeTarget = MergeSourceOrTarget'Target aliceBranchNames @@ -217,7 +212,7 @@ doMerge info = do -- Otherwise, if LCA == alice (so alice is behind bob), then we could fast forward to bob, so we're done. when (info.lca.causalHash == Just info.alice.causalHash) do bobBranch <- liftIO (Codebase.expectBranchForHash codebase info.bob.causalHash) - _ <- Cli.updateAt info.description alicePath (\_aliceBranch -> bobBranch) + _ <- Cli.updateAt info.description (PP.projectBranchRoot info.alice.projectAndBranch) (\_aliceBranch -> bobBranch) Cli.respond (Output.MergeSuccessFastForward mergeSourceAndTarget) done () @@ -416,12 +411,10 @@ doMerge info = do Nothing -> do Cli.Env {writeSource} <- ask _temporaryBranchId <- - HandleInput.Branch.doCreateBranch' - (Branch.mergeNode stageOneBranch parents.alice parents.bob) - Nothing + HandleInput.Branch.createBranchFromNamespace info.alice.projectAndBranch.project (findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget) - info.description + (Branch.mergeNode stageOneBranch parents.alice parents.bob) scratchFilePath <- Cli.getLatestFile <&> \case Nothing -> "scratch.u" @@ -434,7 +427,7 @@ doMerge info = do _ <- Cli.updateAt info.description - alicePath + info.alice.projectAndBranch (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) Cli.respond (Output.MergeSuccess mergeSourceAndTarget) @@ -442,8 +435,8 @@ doMergeLocalBranch :: TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () doMergeLocalBranch branches = do (aliceCausalHash, bobCausalHash, lcaCausalHash) <- Cli.runTransaction do - aliceCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds branches.alice) - bobCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds branches.bob) + aliceCausalHash <- ProjectUtils.getProjectBranchCausalHash (branches.alice ^. #branch) + bobCausalHash <- ProjectUtils.getProjectBranchCausalHash (branches.bob ^. #branch) -- Using Alice and Bob's causal hashes, find the LCA (if it exists) lcaCausalHash <- Operations.lca aliceCausalHash bobCausalHash pure (aliceCausalHash, bobCausalHash, lcaCausalHash) From 9bf5d6f105f7357267ba785c5af491bff89e6018 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 16:54:58 -0700 Subject: [PATCH 080/631] Fix up MonadUtils --- unison-cli/src/Unison/Cli/MonadUtils.hs | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 0a07833e39..bb27225e22 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -282,7 +282,7 @@ getCurrentBranch :: Cli (Branch IO) getCurrentBranch = do Cli.Env {codebase} <- ask pp <- getCurrentProjectPath - liftIO $ Codebase.getBranchAtProjectPath codebase pp + fromMaybe Branch.empty <$> liftIO (Codebase.getBranchAtProjectPath codebase pp) -- | Get the current branch0. getCurrentBranch0 :: Cli (Branch0 IO) @@ -449,7 +449,7 @@ stepManyAtMNoSync actions = do syncRoot :: Text -> Cli () syncRoot description = do rootBranch <- getProjectRoot - updateCurrentProjectRoot rootBranch description + updateCurrentProjectBranchRoot rootBranch description -- | Update a branch at the given path, returning `True` if -- an update occurred and false otherwise @@ -461,7 +461,7 @@ updateAtM :: updateAtM reason pp f = do b <- getBranchFromProjectPath (pp & PP.absPath_ .~ Path.absoluteEmpty) b' <- Branch.modifyAtM (pp ^. PP.path_) f b - updateCurrentProjectRoot b' reason + updateCurrentProjectBranchRoot b' reason pure $ b /= b' -- | Update a branch at the given path, returning `True` if @@ -488,10 +488,19 @@ updateAndStepAt reason updates steps = do ProjectPath _ projBranch _ <- getCurrentProjectPath updateProjectBranchRoot projBranch root reason +updateCurrentProjectBranchRoot :: Branch IO -> Text -> Cli () +updateCurrentProjectBranchRoot new reason = do + pp <- getCurrentProjectPath + updateProjectBranchRoot (pp ^. #branch) new reason + updateProjectBranchRoot :: ProjectBranch -> Branch IO -> Text -> Cli () -updateProjectBranchRoot projectBranch new reason = +updateProjectBranchRoot projectBranch new _reason = do + Cli.Env {codebase} <- ask Cli.time "updateCurrentProjectRoot" do - runTransaction $ Q.setProjectBranchHead (projectBranch ^. #branchId) (Branch.headHash new) + liftIO $ Codebase.putBranch codebase new + Cli.runTransaction $ do + causalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash new) + Q.setProjectBranchHead (projectBranch ^. #projectId) (projectBranch ^. #branchId) causalHashId setCurrentProjectRoot new ------------------------------------------------------------------------------------------------------------------------ From 9e04ffc9ee99bd215a9dec0721fc2415235757d7 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 3 Jun 2024 20:19:54 -0400 Subject: [PATCH 081/631] improve pull into non-existent branch error message --- unison-cli/src/Unison/Cli/ProjectUtils.hs | 16 ++++++++++------ .../Codebase/Editor/HandleInput/Pull.hs | 16 ++++++++-------- .../src/Unison/Codebase/Editor/Output.hs | 2 ++ .../src/Unison/CommandLine/OutputMessages.hs | 19 +++++++++++++++++++ 4 files changed, 39 insertions(+), 14 deletions(-) diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index 66eb87414c..f184349fd4 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -24,6 +24,7 @@ module Unison.Cli.ProjectUtils expectProjectAndBranchByIds, getProjectAndBranchByTheseNames, expectProjectAndBranchByTheseNames, + getProjectAndBranchByNames, expectLooseCodeOrProjectBranch, getProjectBranchCausalHash, @@ -216,6 +217,13 @@ hydrateNames = \case pure (ProjectAndBranch (project ^. #name) branchName) These projectName branchName -> pure (ProjectAndBranch projectName branchName) +getProjectAndBranchByNames :: ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) +getProjectAndBranchByNames (ProjectAndBranch projectName branchName) = + runMaybeT do + project <- MaybeT (Queries.loadProjectByName projectName) + branch <- MaybeT (Queries.loadProjectBranchByName (project ^. #projectId) branchName) + pure (ProjectAndBranch project branch) + -- Expect a local project+branch by ids. expectProjectAndBranchByIds :: ProjectAndBranch ProjectId ProjectBranchId -> @@ -238,12 +246,8 @@ getProjectAndBranchByTheseNames = \case (ProjectAndBranch project _branch, _restPath) <- MaybeT getCurrentProjectBranch branch <- MaybeT (Cli.runTransaction (Queries.loadProjectBranchByName (project ^. #projectId) branchName)) pure (ProjectAndBranch project branch) - These projectName branchName -> do - Cli.runTransaction do - runMaybeT do - project <- MaybeT (Queries.loadProjectByName projectName) - branch <- MaybeT (Queries.loadProjectBranchByName (project ^. #projectId) branchName) - pure (ProjectAndBranch project branch) + These projectName branchName -> + Cli.runTransaction (getProjectAndBranchByNames (ProjectAndBranch projectName branchName)) -- Expect a local project branch by a "these names", using the following defaults if a name is missing: -- diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index baaad634b1..6165d60bc3 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -157,14 +157,14 @@ resolveSourceAndTarget :: resolveSourceAndTarget includeSquashed = \case Input.PullSourceTarget0 -> liftA2 (,) (resolveImplicitSource includeSquashed) resolveImplicitTarget Input.PullSourceTarget1 source -> liftA2 (,) (resolveExplicitSource includeSquashed source) resolveImplicitTarget - Input.PullSourceTarget2 source target -> - liftA2 - (,) - (resolveExplicitSource includeSquashed source) - ( ProjectUtils.expectProjectAndBranchByTheseNames case target of - ProjectAndBranch Nothing branch -> That branch - ProjectAndBranch (Just project) branch -> These project branch - ) + Input.PullSourceTarget2 source0 target0 -> do + source <- resolveExplicitSource includeSquashed source0 + maybeTarget <- + ProjectUtils.getProjectAndBranchByTheseNames case target0 of + ProjectAndBranch Nothing branch -> That branch + ProjectAndBranch (Just project) branch -> These project branch + target <- maybeTarget & onNothing (Cli.returnEarly (Output.PullIntoMissingBranch source target0)) + pure (source, target) resolveImplicitSource :: Share.IncludeSquashedHead -> Cli (ReadRemoteNamespace Share.RemoteProjectBranch) resolveImplicitSource includeSquashed = diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 9e13e7dd26..52b11b23ca 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -407,6 +407,7 @@ data Output | InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment | NoUpgradeInProgress | UseLibInstallNotPull !(ProjectAndBranch ProjectName ProjectBranchName) + | PullIntoMissingBranch !(ReadRemoteNamespace Share.RemoteProjectBranch) !(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) data UpdateOrUpgrade = UOUUpdate | UOUUpgrade @@ -646,6 +647,7 @@ isFailure o = case o of InstalledLibdep {} -> False NoUpgradeInProgress {} -> True UseLibInstallNotPull {} -> False + PullIntoMissingBranch {} -> True isNumberedFailure :: NumberedOutput -> Bool isNumberedFailure = \case diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index bef6eda4a3..2370f56eda 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2095,6 +2095,25 @@ notifyUser dir = \case <> IP.makeExample' IP.pull <> "to install libraries is now deprecated. Going forward, you can use" <> P.group (IP.makeExample IP.libInstallInputPattern [prettyProjectAndBranchName libdep] <> ".") + PullIntoMissingBranch source (ProjectAndBranch maybeTargetProject targetBranch) -> + pure . P.wrap $ + "I think you're wanting to merge" + <> sourcePretty + <> "into" + <> P.group (targetPretty <> ",") + <> "but" + <> targetPretty + <> "doesn't exist. If you want, you can create it with" + <> (IP.makeExample IP.branchEmptyInputPattern [targetPretty] <> ",") + <> "and then" + <> IP.makeExample' IP.pull + <> "again." + where + sourcePretty = prettyReadRemoteNamespace source + targetPretty = + case maybeTargetProject of + Nothing -> prettyProjectBranchName targetBranch + Just targetProject -> prettyProjectAndBranchName (ProjectAndBranch targetProject targetBranch) expectedEmptyPushDest :: WriteRemoteNamespace Void -> Pretty expectedEmptyPushDest namespace = From 7efaaef80e9ea41bfd49ea1c32ee23d253af737e Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 4 Jun 2024 10:33:58 -0400 Subject: [PATCH 082/631] was aiming for the implied project/branch name, but dunno how --- .../src/Unison/CommandLine/InputPatterns.hs | 2 +- .../src/Unison/CommandLine/OutputMessages.hs | 8 +-- unison-src/transcripts/pull-errors.md | 9 +++ unison-src/transcripts/pull-errors.output.md | 56 +++++++++++++++++++ 4 files changed, 69 insertions(+), 6 deletions(-) create mode 100644 unison-src/transcripts/pull-errors.md create mode 100644 unison-src/transcripts/pull-errors.output.md diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 96017d9d45..5ea7c4ffae 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1729,7 +1729,7 @@ pullImpl name aliases pullMode addendum = do These sourceProject sourceBranch -> Right (Input.LibInstallI True (ProjectAndBranch sourceProject (Just sourceBranch))) (Right source, Left _, Right path) -> - Left $ + Left . P.indentN 2 $ P.wrap ( "I think you're wanting to merge" <> case source of diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index fd64e388d8..84da282537 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2117,12 +2117,10 @@ notifyUser dir = \case pure . P.wrap $ "I think you're wanting to merge" <> sourcePretty - <> "into" - <> P.group (targetPretty <> ",") - <> "but" + <> "into the" <> targetPretty - <> "doesn't exist. If you want, you can create it with" - <> (IP.makeExample IP.branchEmptyInputPattern [targetPretty] <> ",") + <> "branch, but it doesn't exist. If you want, you can create it with" + <> P.group (IP.makeExample IP.branchEmptyInputPattern [targetPretty] <> ",") <> "and then" <> IP.makeExample' IP.pull <> "again." diff --git a/unison-src/transcripts/pull-errors.md b/unison-src/transcripts/pull-errors.md new file mode 100644 index 0000000000..f314ad5abb --- /dev/null +++ b/unison-src/transcripts/pull-errors.md @@ -0,0 +1,9 @@ +```ucm +.> project.create-empty test +``` +```ucm:error +test/main> pull @aryairani/test-almost-empty/main lib.base_latest +test/main> pull @aryairani/test-almost-empty/main a.b +test/main> pull @aryairani/test-almost-empty/main a +test/main> pull @aryairani/test-almost-empty/main .a +``` diff --git a/unison-src/transcripts/pull-errors.output.md b/unison-src/transcripts/pull-errors.output.md new file mode 100644 index 0000000000..963eaabb52 --- /dev/null +++ b/unison-src/transcripts/pull-errors.output.md @@ -0,0 +1,56 @@ +```ucm +.> project.create-empty test + + 🎉 I've created the project test. + + 🎨 Type `ui` to explore this project's code in your browser. + 🔭 Discover libraries at https://share.unison-lang.org + 📖 Use `help-topic projects` to learn more about projects. + + Write your first Unison code with UCM: + + 1. Open scratch.u. + 2. Write some Unison code and save the file. + 3. In UCM, type `add` to save it to your new project. + + 🎉 🥳 Happy coding! + +``` +```ucm +test/main> pull @aryairani/test-almost-empty/main lib.base_latest + + The use of `pull` to install libraries is now deprecated. + Going forward, you can use + `lib.install @aryairani/test-almost-empty/main`. + + Downloaded 2 entities. + + I installed @aryairani/test-almost-empty/main as + aryairani_test_almost_empty_main. + +test/main> pull @aryairani/test-almost-empty/main a.b + + I think you're wanting to merge + @aryairani/test-almost-empty/main into the a.b namespace, but + the `pull` command only supports merging into the top level of + a local project branch. + + Use `help pull` to see some examples. + +test/main> pull @aryairani/test-almost-empty/main a + + I think you're wanting to merge + @aryairani/test-almost-empty/main into the a branch, but it + doesn't exist. If you want, you can create it with + `branch.empty a`, and then `pull` again. + +test/main> pull @aryairani/test-almost-empty/main .a + + I think you're wanting to merge + @aryairani/test-almost-empty/main into the .a namespace, but + the `pull` command only supports merging into the top level of + a local project branch. + + Use `help pull` to see some examples. + +``` From 8a1ea75bf9bb269438c14b8357349803985367bf Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 4 Jun 2024 10:40:12 -0400 Subject: [PATCH 083/631] pass --ui flag in default launcher --- .github/workflows/bundle-ucm.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 281e891118..7bebd320e7 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -234,7 +234,7 @@ jobs: content: | #!/bin/bash unison_root="$(dirname "$(readlink -f "$0")")" - "${unison_root}/unison/unison" --runtime-path "${unison_root}/runtime/bin/unison-runtime" "$@" + "${unison_root}/unison/unison" --ui "${unison_root}/ui" --runtime-path "${unison_root}/runtime/bin/unison-runtime" "$@" - name: create startup script (Windows) if: runner.os == 'Windows' uses: 1arp/create-a-file-action@0.4.4 @@ -243,7 +243,7 @@ jobs: file: ucm.cmd content: | @echo off - "%~dp0unison\unison.exe" --runtime-path "%~dp0runtime\unison-runtime.exe" %* + "%~dp0unison\unison.exe" --ui "%~dp0ui" --runtime-path "%~dp0runtime\unison-runtime.exe" %* - name: package everything together run: | if [[ ${{runner.os}} = 'Windows' ]]; then From c3a2dfb0013fc5788c1a37f340ec2f031ae17934 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 4 Jun 2024 09:41:57 -0700 Subject: [PATCH 084/631] Don't include causalHashId in ProjectBranch --- .../U/Codebase/Sqlite/ProjectBranch.hs | 5 +-- .../U/Codebase/Sqlite/Queries.hs | 14 ++++++- parser-typechecker/src/Unison/Codebase.hs | 39 +++++++++++-------- unison-cli/src/Unison/Cli/ProjectUtils.hs | 3 +- 4 files changed, 38 insertions(+), 23 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectBranch.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectBranch.hs index 986de3fbb6..05b63e7e23 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectBranch.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectBranch.hs @@ -3,7 +3,7 @@ module U.Codebase.Sqlite.ProjectBranch ) where -import U.Codebase.Sqlite.DbId (CausalHashId, ProjectBranchId, ProjectId) +import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) import Unison.Core.Orphans.Sqlite () import Unison.Core.Project (ProjectBranchName) import Unison.Prelude @@ -14,8 +14,7 @@ data ProjectBranch = ProjectBranch { projectId :: !ProjectId, branchId :: !ProjectBranchId, name :: !ProjectBranchName, - parentBranchId :: !(Maybe ProjectBranchId), - causalHashId :: !CausalHashId + parentBranchId :: !(Maybe ProjectBranchId) } deriving stock (Eq, Generic, Show) deriving anyclass (ToRow, FromRow) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index a0a49d151b..a896cbcea8 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -136,6 +136,7 @@ module U.Codebase.Sqlite.Queries renameProjectBranch, deleteProjectBranch, setProjectBranchHead, + expectProjectBranchHead, setMostRecentBranch, loadMostRecentBranch, @@ -3686,8 +3687,8 @@ loadProjectAndBranchNames projectId branchId = |] -- | Insert a project branch. -insertProjectBranch :: ProjectBranch -> Transaction () -insertProjectBranch (ProjectBranch projectId branchId branchName maybeParentBranchId causalHashId) = do +insertProjectBranch :: CausalHashId -> ProjectBranch -> Transaction () +insertProjectBranch causalHashId (ProjectBranch projectId branchId branchName maybeParentBranchId) = do execute [sql| INSERT INTO project_branch (project_id, branch_id, name, causal_hash_id) @@ -3781,6 +3782,15 @@ setProjectBranchHead projectId branchId causalHashId = WHERE project_id = :projectId AND branch_id = :branchId |] +expectProjectBranchHead :: ProjectId -> ProjectBranchId -> Transaction CausalHashId +expectProjectBranchHead projectId branchId = + queryOneCol + [sql| + SELECT causal_hash_id + FROM project_branch + WHERE project_id = :projectId AND branch_id = :branchId + |] + data LoadRemoteBranchFlag = IncludeSelfRemote | ExcludeSelfRemote diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index fbe1d51d4a..91d6275d76 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -50,10 +50,10 @@ module Unison.Codebase getShallowCausalAtPath, Operations.expectCausalBranchByCausalHash, getShallowCausalAtPathFromRootHash, - getShallowProjectRootBranch, + getShallowProjectBranchRoot, + expectShallowProjectBranchRoot, getShallowBranchAtProjectPath, getShallowProjectRootByNames, - getProjectBranchRoot, expectProjectBranchRoot, getBranchAtProjectPath, @@ -213,43 +213,48 @@ getShallowBranchAtPath path branch = do childBranch <- V2Causal.value childCausal getShallowBranchAtPath p childBranch -getShallowProjectRootBranch :: ProjectBranch -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) -getShallowProjectRootBranch ProjectBranch {causalHashId} = do - causalHash <- Q.expectCausalHash causalHashId - Operations.expectCausalBranchByCausalHash causalHash >>= V2Causal.value - -- | Recursively descend into causals following the given path, -- Use the root causal if none is provided. getShallowBranchAtProjectPath :: PP.ProjectPath -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) getShallowBranchAtProjectPath (PP.ProjectPath _project projectBranch path) = do - projectRootBranch <- getShallowProjectRootBranch projectBranch + projectRootBranch <- fromMaybe V2Branch.empty <$> getShallowProjectBranchRoot projectBranch getShallowBranchAtPath (Path.unabsolute path) projectRootBranch getShallowProjectRootByNames :: ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe (V2Branch.CausalBranch Sqlite.Transaction)) getShallowProjectRootByNames (ProjectAndBranch projectName branchName) = runMaybeT do - ProjectBranch {causalHashId} <- MaybeT $ Q.loadProjectBranchByNames projectName branchName + ProjectBranch {projectId, branchId} <- MaybeT $ Q.loadProjectBranchByNames projectName branchName + causalHashId <- lift $ Q.expectProjectBranchHead projectId branchId causalHash <- lift $ Q.expectCausalHash causalHashId lift $ Operations.expectCausalBranchByCausalHash causalHash -getProjectBranchRoot :: (MonadIO m) => Codebase m v a -> ProjectBranch -> m (Maybe (Branch m)) -getProjectBranchRoot codebase ProjectBranch {causalHashId} = do - causalHash <- runTransaction codebase $ Q.expectCausalHash causalHashId - getBranchForHash codebase causalHash - expectProjectBranchRoot :: (MonadIO m) => Codebase m v a -> ProjectBranch -> m (Branch m) -expectProjectBranchRoot codebase ProjectBranch {causalHashId} = do - causalHash <- runTransaction codebase $ Q.expectCausalHash causalHashId +expectProjectBranchRoot codebase ProjectBranch {projectId, branchId} = do + causalHash <- runTransaction codebase $ do + causalHashId <- Q.expectProjectBranchHead projectId branchId + Q.expectCausalHash causalHashId expectBranchForHash codebase causalHash +expectShallowProjectBranchRoot :: ProjectBranch -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) +expectShallowProjectBranchRoot ProjectBranch {projectId, branchId} = do + causalHashId <- Q.expectProjectBranchHead projectId branchId + causalHash <- Q.expectCausalHash causalHashId + Operations.expectCausalBranchByCausalHash causalHash >>= V2Causal.value + +getShallowProjectBranchRoot :: ProjectBranch -> Sqlite.Transaction (Maybe (V2Branch.Branch Sqlite.Transaction)) +getShallowProjectBranchRoot ProjectBranch {projectId, branchId} = do + causalHashId <- Q.expectProjectBranchHead projectId branchId + causalHash <- Q.expectCausalHash causalHashId + Operations.loadCausalBranchByCausalHash causalHash >>= traverse V2Causal.value + getBranchAtProjectPath :: (MonadIO m) => Codebase m v a -> PP.ProjectPath -> m (Maybe (Branch m)) getBranchAtProjectPath codebase pp = runMaybeT do - rootBranch <- MaybeT $ getProjectBranchRoot codebase (pp ^. #branch) + rootBranch <- lift $ expectProjectBranchRoot codebase (pp ^. #branch) hoistMaybe $ Branch.getAt (pp ^. PP.path_) rootBranch -- | Like 'getBranchForHash', but for when the hash is known to be in the codebase. diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index e4017e307c..df9695273c 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -202,7 +202,8 @@ resolveProjectBranch defaultProj (ProjectAndBranch mayProjectName mayBranchName) -- | Get the causal hash of a project branch. getProjectBranchCausalHash :: ProjectBranch -> Transaction CausalHash -getProjectBranchCausalHash ProjectBranch {causalHashId} = do +getProjectBranchCausalHash ProjectBranch {projectId, branchId} = do + causalHashId <- Q.expectProjectBranchHead projectId branchId Q.expectCausalHash causalHashId ------------------------------------------------------------------------------------------------------------------------ From ecba9369dbec3b9e9c559c8a5cf8f4c6c29eb711 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Jun 2024 17:02:05 -0700 Subject: [PATCH 085/631] Fix up project branch deletes --- unison-cli/src/Unison/Cli/MonadUtils.hs | 28 +++++++++++-------- .../Editor/HandleInput/DeleteBranch.hs | 22 +++++---------- .../Codebase/Editor/HandleInput/Merge2.hs | 4 +-- 3 files changed, 26 insertions(+), 28 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index bb27225e22..478df575b3 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -299,6 +299,11 @@ getBranch0FromProjectPath :: PP.ProjectPath -> Cli (Branch0 IO) getBranch0FromProjectPath pp = Branch.head <$> getBranchFromProjectPath pp +getRootBranchForProjectBranch :: ProjectBranch -> Cli (Branch IO) +getRootBranchForProjectBranch ProjectBranch {projectId, branchId} = do + Cli.runTransaction do + _ + -- | Get the maybe-branch at an absolute path. getMaybeBranchFromProjectPath :: PP.ProjectPath -> Cli (Maybe (Branch IO)) getMaybeBranchFromProjectPath pp = do @@ -481,22 +486,23 @@ updateAndStepAt :: g (Path, Branch0 IO -> Branch0 IO) -> Cli () updateAndStepAt reason updates steps = do - root <- - (Branch.stepManyAt steps) - . (\root -> foldl' (\b (Path.Absolute p, f) -> Branch.modifyAt p f b) root updates) - <$> getProjectRoot + let f b = + b + & (\root -> foldl' (\b (Path.Absolute p, f) -> Branch.modifyAt p f b) root updates) + & (Branch.stepManyAt steps) ProjectPath _ projBranch _ <- getCurrentProjectPath - updateProjectBranchRoot projBranch root reason + updateProjectBranchRoot reason projBranch f -updateCurrentProjectBranchRoot :: Branch IO -> Text -> Cli () -updateCurrentProjectBranchRoot new reason = do +updateCurrentProjectBranchRoot :: Text -> (Branch IO -> Branch IO) -> Cli () +updateCurrentProjectBranchRoot reason f = do pp <- getCurrentProjectPath - updateProjectBranchRoot (pp ^. #branch) new reason + updateProjectBranchRoot reason (pp ^. #branch) f -updateProjectBranchRoot :: ProjectBranch -> Branch IO -> Text -> Cli () -updateProjectBranchRoot projectBranch new _reason = do +updateProjectBranchRoot :: Text -> ProjectBranch -> (Branch IO -> Branch IO) -> Cli () +updateProjectBranchRoot reason projectBranch f = do + error "implement project-branch reflog" reason Cli.Env {codebase} <- ask - Cli.time "updateCurrentProjectRoot" do + Cli.time "updateProjectBranchRoot" do liftIO $ Codebase.putBranch codebase new Cli.runTransaction $ do causalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash new) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs index 06656cece5..2c91256bb7 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs @@ -6,8 +6,6 @@ module Unison.Codebase.Editor.HandleInput.DeleteBranch where import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) -import Data.Map.Strict qualified as Map -import Data.These (These (..)) import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries @@ -17,9 +15,6 @@ import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Editor.HandleInput.ProjectCreate import Unison.Codebase.ProjectPath (ProjectPathG (..)) -import Unison.Codebase.Branch qualified as Branch -import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path qualified as Path import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Sqlite qualified as Sqlite @@ -33,7 +28,7 @@ import Witch (unsafeFrom) handleDeleteBranch :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleDeleteBranch projectAndBranchNamesToDelete = do ProjectPath currentProject currentBranch _ <- Cli.getCurrentProjectPath - projectAndBranchToDelete <- ProjectUtils.resolveProjectBranch currentProject (projectAndBranchNames & #branch %~ Just) + projectAndBranchToDelete@(ProjectAndBranch _projectToDelete branchToDelete) <- ProjectUtils.resolveProjectBranch currentProject (projectAndBranchNamesToDelete & #branch %~ Just) doDeleteProjectBranch projectAndBranchToDelete -- If the user is on the branch that they're deleting, we have to cd somewhere; try these in order: @@ -46,10 +41,11 @@ handleDeleteBranch projectAndBranchNamesToDelete = do mayNextLocation <- Cli.runTransaction . runMaybeT $ asum - [ parentBranch projectId (branchToDelete ^. #parentBranchId), - findMainBranchInProject projectId, - findAnyBranchInProject projectId, - findAnyBranchInCodebase + [ parentBranch (branchToDelete ^. #projectId) (branchToDelete ^. #parentBranchId), + findMainBranchInProject (currentProject ^. #projectId), + findAnyBranchInProject (currentProject ^. #projectId), + findAnyBranchInCodebase, + createDummyProject ] nextLoc <- mayNextLocation `whenNothing` projectCreate False Nothing Cli.switchProject nextLoc @@ -71,14 +67,10 @@ handleDeleteBranch projectAndBranchNamesToDelete = do findAnyBranchInCodebase = do (_, pbIds) <- MaybeT . fmap listToMaybe $ Queries.loadAllProjectBranchNamePairs pure pbIds + createDummyProject = error "TODO: create new branch or project if we delete the last branch you're on." -- | Delete a project branch and record an entry in the reflog. doDeleteProjectBranch :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> Cli () doDeleteProjectBranch projectAndBranch = do Cli.runTransaction do Queries.deleteProjectBranch projectAndBranch.project.projectId projectAndBranch.branch.branchId - Cli.stepAt - ("delete.branch " <> into @Text (ProjectUtils.justTheNames projectAndBranch)) - ( Path.unabsolute (ProjectUtils.projectBranchesPath projectAndBranch.project.projectId), - over Branch.children (Map.delete (ProjectUtils.projectBranchSegment projectAndBranch.branch.branchId)) - ) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 3c1af1358e..82a82ee74e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -425,10 +425,10 @@ doMerge info = do Cli.runTransaction (Codebase.addDefsToCodebase codebase tuf) let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch _ <- - Cli.updateAt - info.description + Cli.updateProjectBranchRoot info.alice.projectAndBranch (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) + info.description Cli.respond (Output.MergeSuccess mergeSourceAndTarget) doMergeLocalBranch :: TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () From f42d57f3a0139e813a3229b8a4f0815fc6c67d30 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 4 Jun 2024 10:00:52 -0700 Subject: [PATCH 086/631] Fix up MonadUtils again --- unison-cli/src/Unison/Cli/MonadUtils.hs | 46 ++++++++++++------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 478df575b3..5fa5e4c601 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -25,10 +25,11 @@ module Unison.Cli.MonadUtils -- ** Getting/setting branches setCurrentProjectRoot, modifyProjectRoot, - getProjectRoot, - getProjectRoot0, + getCurrentProjectRoot, + getCurrentProjectRoot0, getCurrentBranch, getCurrentBranch0, + getProjectBranchRoot, getBranchFromProjectPath, getBranch0FromProjectPath, getMaybeBranchFromProjectPath, @@ -249,14 +250,14 @@ resolveShortCausalHashToCausalHash rollback shortHash = do -- Getting/Setting branches -- | Get the root branch. -getProjectRoot :: Cli (Branch IO) -getProjectRoot = do +getCurrentProjectRoot :: Cli (Branch IO) +getCurrentProjectRoot = do use #currentProjectRoot >>= atomically . readTMVar -- | Get the root branch0. -getProjectRoot0 :: Cli (Branch0 IO) -getProjectRoot0 = - Branch.head <$> getProjectRoot +getCurrentProjectRoot0 :: Cli (Branch0 IO) +getCurrentProjectRoot0 = + Branch.head <$> getCurrentProjectRoot -- | Set a new root branch. -- @@ -299,19 +300,16 @@ getBranch0FromProjectPath :: PP.ProjectPath -> Cli (Branch0 IO) getBranch0FromProjectPath pp = Branch.head <$> getBranchFromProjectPath pp -getRootBranchForProjectBranch :: ProjectBranch -> Cli (Branch IO) -getRootBranchForProjectBranch ProjectBranch {projectId, branchId} = do - Cli.runTransaction do - _ +getProjectBranchRoot :: ProjectBranch -> Cli (Branch IO) +getProjectBranchRoot projectBranch = do + Cli.Env {codebase} <- ask + liftIO $ Codebase.expectProjectBranchRoot codebase projectBranch -- | Get the maybe-branch at an absolute path. getMaybeBranchFromProjectPath :: PP.ProjectPath -> Cli (Maybe (Branch IO)) getMaybeBranchFromProjectPath pp = do Cli.Env {codebase} <- ask - let ProjectBranch {causalHashId} = pp ^. #branch - causalHash <- Cli.runTransaction $ Q.expectCausalHash causalHashId - rootBranch <- liftIO $ Codebase.expectBranchForHash codebase causalHash - pure (Branch.getAt (pp ^. PP.path_) rootBranch) + liftIO $ Codebase.getBranchAtProjectPath codebase pp -- | Get the maybe-branch0 at an absolute path. getMaybeBranch0FromProjectPath :: PP.ProjectPath -> Cli (Maybe (Branch0 IO)) @@ -419,7 +417,7 @@ stepManyAtNoSync' :: f (Path.Absolute, Branch0 IO -> Cli (Branch0 IO)) -> Cli Bool stepManyAtNoSync' actions = do - origRoot <- getProjectRoot + origRoot <- getCurrentProjectRoot newRoot <- Branch.stepManyAtM (relativizeActions actions) origRoot setCurrentProjectRoot newRoot pure (origRoot /= newRoot) @@ -446,15 +444,15 @@ stepManyAtMNoSync :: f (Path.Absolute, Branch0 IO -> IO (Branch0 IO)) -> Cli () stepManyAtMNoSync actions = do - oldRoot <- getProjectRoot + oldRoot <- getCurrentProjectRoot newRoot <- liftIO (Branch.stepManyAtM (relativizeActions actions) oldRoot) setCurrentProjectRoot newRoot -- | Sync the in-memory root branch. syncRoot :: Text -> Cli () syncRoot description = do - rootBranch <- getProjectRoot - updateCurrentProjectBranchRoot rootBranch description + rootBranch <- getCurrentProjectRoot + updateCurrentProjectBranchRoot description (const rootBranch) -- | Update a branch at the given path, returning `True` if -- an update occurred and false otherwise @@ -464,10 +462,10 @@ updateAtM :: (Branch IO -> Cli (Branch IO)) -> Cli Bool updateAtM reason pp f = do - b <- getBranchFromProjectPath (pp & PP.absPath_ .~ Path.absoluteEmpty) - b' <- Branch.modifyAtM (pp ^. PP.path_) f b - updateCurrentProjectBranchRoot b' reason - pure $ b /= b' + old <- getBranchFromProjectPath (pp & PP.absPath_ .~ Path.absoluteEmpty) + new <- Branch.modifyAtM (pp ^. PP.path_) f old + updateCurrentProjectBranchRoot reason (const new) + pure $ old /= new -- | Update a branch at the given path, returning `True` if -- an update occurred and false otherwise @@ -503,6 +501,8 @@ updateProjectBranchRoot reason projectBranch f = do error "implement project-branch reflog" reason Cli.Env {codebase} <- ask Cli.time "updateProjectBranchRoot" do + old <- getProjectBranchRoot projectBranch + let new = f old liftIO $ Codebase.putBranch codebase new Cli.runTransaction $ do causalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash new) From 63fa3fdca65931b39d0b890a976482bb694e7587 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 4 Jun 2024 13:20:49 -0400 Subject: [PATCH 087/631] the `--ui` flag conflicts with commands, like `transcript` --- .github/workflows/bundle-ucm.yaml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 7bebd320e7..d77ba14030 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -234,7 +234,8 @@ jobs: content: | #!/bin/bash unison_root="$(dirname "$(readlink -f "$0")")" - "${unison_root}/unison/unison" --ui "${unison_root}/ui" --runtime-path "${unison_root}/runtime/bin/unison-runtime" "$@" + export UCM_WEB_UI="${unison_root}/ui" + "${unison_root}/unison/unison" --runtime-path "${unison_root}/runtime/bin/unison-runtime" "$@" - name: create startup script (Windows) if: runner.os == 'Windows' uses: 1arp/create-a-file-action@0.4.4 @@ -243,7 +244,8 @@ jobs: file: ucm.cmd content: | @echo off - "%~dp0unison\unison.exe" --ui "%~dp0ui" --runtime-path "%~dp0runtime\unison-runtime.exe" %* + SET UCM_WEB_UI="%~dp0ui" + "%~dp0unison\unison.exe" --runtime-path "%~dp0runtime\unison-runtime.exe" %* - name: package everything together run: | if [[ ${{runner.os}} = 'Windows' ]]; then From 0247854e70000b0a1d3375c1a3f83dc9fbc62db7 Mon Sep 17 00:00:00 2001 From: aryairani <538571+aryairani@users.noreply.github.com> Date: Tue, 4 Jun 2024 18:34:00 +0000 Subject: [PATCH 088/631] [create-pull-request] automated change --- .../U/Codebase/Sqlite/Serialization.hs | 2 +- parser-typechecker/src/Unison/Builtin.hs | 1 - .../src/Unison/PrettyPrintEnv/MonadPretty.hs | 2 +- .../src/Unison/Runtime/Array.hs | 1 - .../src/Unison/Runtime/Builtin.hs | 42 ++++++++++--------- .../src/Unison/Runtime/Crypto/Rsa.hs | 11 ++--- .../src/Unison/Runtime/Decompile.hs | 14 +++---- .../src/Unison/Runtime/Foreign.hs | 2 +- .../src/Unison/Typechecker/Context.hs | 2 +- .../src/Unison/Util/Text/Pattern.hs | 5 ++- .../Codebase/Editor/HandleInput/Update2.hs | 2 +- .../src/Unison/Codebase/Editor/Output.hs | 1 - 12 files changed, 43 insertions(+), 42 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs index 38611aae4e..98554c38d1 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs @@ -60,6 +60,7 @@ import Data.Bytes.VarInt (VarInt (VarInt), unVarInt) import Data.List (elemIndex) import Data.Set qualified as Set import Data.Vector (Vector) +import U.Codebase.Decl (Modifier) import U.Codebase.Decl qualified as Decl import U.Codebase.Kind (Kind) import U.Codebase.Kind qualified as Kind @@ -94,7 +95,6 @@ import Unison.Hash32 qualified as Hash32 import Unison.Prelude import Unison.Util.Monoid qualified as Monoid import Prelude hiding (getChar, putChar) -import U.Codebase.Decl (Modifier) debug :: Bool debug = False diff --git a/parser-typechecker/src/Unison/Builtin.hs b/parser-typechecker/src/Unison/Builtin.hs index 816b8a239a..0c7e0514bf 100644 --- a/parser-typechecker/src/Unison/Builtin.hs +++ b/parser-typechecker/src/Unison/Builtin.hs @@ -1073,7 +1073,6 @@ handle = Type.fileHandle () phandle = Type.processHandle () unit = DD.unitType () - udpSocket, udpListenSocket, udpClientSockAddr :: Type udpSocket = Type.udpSocket () udpListenSocket = Type.udpListenSocket () diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs b/parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs index 6dffefd90d..cace699ec8 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs @@ -5,7 +5,7 @@ module Unison.PrettyPrintEnv.MonadPretty where import Control.Lens (views, _1, _2) import Control.Monad.Reader (MonadReader, Reader, local, runReader) import Data.Set qualified as Set -import Unison.Prelude +import Unison.Prelude import Unison.PrettyPrintEnv (PrettyPrintEnv) import Unison.Var (Var) diff --git a/parser-typechecker/src/Unison/Runtime/Array.hs b/parser-typechecker/src/Unison/Runtime/Array.hs index bb3b62f461..2faa68903a 100644 --- a/parser-typechecker/src/Unison/Runtime/Array.hs +++ b/parser-typechecker/src/Unison/Runtime/Array.hs @@ -56,7 +56,6 @@ import Data.Primitive.PrimArray as EPA hiding import Data.Primitive.PrimArray qualified as PA import Data.Primitive.Types import Data.Word (Word8) - import GHC.Exts (toList) #ifdef ARRAY_CHECK diff --git a/parser-typechecker/src/Unison/Runtime/Builtin.hs b/parser-typechecker/src/Unison/Runtime/Builtin.hs index 027b9b69e4..3feb0d55e0 100644 --- a/parser-typechecker/src/Unison/Runtime/Builtin.hs +++ b/parser-typechecker/src/Unison/Runtime/Builtin.hs @@ -81,15 +81,17 @@ import Network.Simple.TCP as SYS send, ) import Network.Socket as SYS - ( Socket, + ( PortNumber, + Socket, accept, - socketPort, PortNumber, + socketPort, ) import Network.TLS as TLS +import Network.TLS.Extra.Cipher as Cipher import Network.UDP as UDP - ( UDPSocket (..), - ClientSockAddr, + ( ClientSockAddr, ListenSocket, + UDPSocket (..), clientSocket, close, recv, @@ -99,8 +101,6 @@ import Network.UDP as UDP serverSocket, stop, ) - -import Network.TLS.Extra.Cipher as Cipher import System.Clock (Clock (..), getTime, nsec, sec) import System.Directory as SYS ( createDirectoryIfMissing, @@ -154,7 +154,6 @@ import System.Process as SYS ) import System.X509 qualified as X import Unison.ABT.Normalized hiding (TTm) -import Unison.Runtime.Crypto.Rsa as Rsa import Unison.Builtin qualified as Ty (builtinTypes) import Unison.Builtin.Decls qualified as Ty import Unison.Prelude hiding (Text, some) @@ -164,6 +163,7 @@ import Unison.Runtime.ANF as ANF import Unison.Runtime.ANF.Rehash (checkGroupHashes) import Unison.Runtime.ANF.Serialize as ANF import Unison.Runtime.Array qualified as PA +import Unison.Runtime.Crypto.Rsa as Rsa import Unison.Runtime.Exception (die) import Unison.Runtime.Foreign ( Foreign (Wrap), @@ -1561,13 +1561,13 @@ outIoFailBool stack1 stack2 stack3 extra fail result = ) ] -outIoFailTup :: forall v . (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v +outIoFailTup :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v outIoFailTup stack1 stack2 stack3 stack4 stack5 extra fail result = TMatch result . MatchSum $ mapFromList [ failureCase stack1 stack2 stack3 extra fail, ( 1, - ([BX, BX], + ( [BX, BX], TAbss [stack1, stack2] . TLetD stack3 BX (TCon Ty.unitRef 0 []) . TLetD stack4 BX (TCon Ty.pairRef 0 [stack2, stack3]) @@ -1575,7 +1575,7 @@ outIoFailTup stack1 stack2 stack3 stack4 stack5 extra fail result = $ right stack5 ) ) - ] + ] outIoFailG :: (Var v) => @@ -2346,7 +2346,7 @@ declareUdpForeigns = do $ \(host :: Util.Text.Text, port :: Util.Text.Text) -> let hostStr = Util.Text.toString host portStr = Util.Text.toString port - in UDP.clientSocket hostStr portStr True + in UDP.clientSocket hostStr portStr True declareForeign Tracked "IO.UDP.UDPSocket.recv.impl.v1" boxToEFBox . mkForeignIOF @@ -2374,25 +2374,27 @@ declareUdpForeigns = do $ \(ip :: Util.Text.Text, port :: Util.Text.Text) -> let maybeIp = readMaybe $ Util.Text.toString ip :: Maybe IP maybePort = readMaybe $ Util.Text.toString port :: Maybe PortNumber - in case (maybeIp, maybePort) of - (Nothing, _) -> fail "Invalid IP Address" - (_, Nothing) -> fail "Invalid Port Number" - (Just ip, Just pt) -> UDP.serverSocket (ip, pt) + in case (maybeIp, maybePort) of + (Nothing, _) -> fail "Invalid IP Address" + (_, Nothing) -> fail "Invalid Port Number" + (Just ip, Just pt) -> UDP.serverSocket (ip, pt) declareForeign Tracked "IO.UDP.ListenSocket.toText.impl.v1" boxDirect . mkForeign $ \(sock :: ListenSocket) -> pure $ show sock - declareForeign Tracked "IO.UDP.ListenSocket.recvFrom.impl.v1" boxToEFTup . - mkForeignIOF $ fmap (first Bytes.fromArray) <$> UDP.recvFrom + declareForeign Tracked "IO.UDP.ListenSocket.recvFrom.impl.v1" boxToEFTup + . mkForeignIOF + $ fmap (first Bytes.fromArray) <$> UDP.recvFrom declareForeign Tracked "IO.UDP.ClientSockAddr.toText.v1" boxDirect . mkForeign $ \(sock :: ClientSockAddr) -> pure $ show sock - declareForeign Tracked "IO.UDP.ListenSocket.sendTo.impl.v1" boxBoxBoxToEF0 . - mkForeignIOF $ \(socket :: ListenSocket, bytes :: Bytes.Bytes, addr :: ClientSockAddr) -> - UDP.sendTo socket (Bytes.toArray bytes) addr + declareForeign Tracked "IO.UDP.ListenSocket.sendTo.impl.v1" boxBoxBoxToEF0 + . mkForeignIOF + $ \(socket :: ListenSocket, bytes :: Bytes.Bytes, addr :: ClientSockAddr) -> + UDP.sendTo socket (Bytes.toArray bytes) addr declareForeigns :: FDecl Symbol () declareForeigns = do diff --git a/parser-typechecker/src/Unison/Runtime/Crypto/Rsa.hs b/parser-typechecker/src/Unison/Runtime/Crypto/Rsa.hs index fda5961958..7eb17c2962 100644 --- a/parser-typechecker/src/Unison/Runtime/Crypto/Rsa.hs +++ b/parser-typechecker/src/Unison/Runtime/Crypto/Rsa.hs @@ -1,8 +1,9 @@ -module Unison.Runtime.Crypto.Rsa ( - parseRsaPublicKey, - parseRsaPrivateKey, - rsaErrorToText, -) where +module Unison.Runtime.Crypto.Rsa + ( parseRsaPublicKey, + parseRsaPrivateKey, + rsaErrorToText, + ) +where import Crypto.Number.Basic qualified as Crypto import Crypto.PubKey.RSA qualified as RSA diff --git a/parser-typechecker/src/Unison/Runtime/Decompile.hs b/parser-typechecker/src/Unison/Runtime/Decompile.hs index cdbd3049cf..a1b1646ce8 100644 --- a/parser-typechecker/src/Unison/Runtime/Decompile.hs +++ b/parser-typechecker/src/Unison/Runtime/Decompile.hs @@ -21,9 +21,9 @@ import Unison.Reference (Reference, pattern Builtin) import Unison.Referent (pattern Ref) import Unison.Runtime.ANF (maskTags) import Unison.Runtime.Array - ( Array - , ByteArray - , byteArrayToList + ( Array, + ByteArray, + byteArrayToList, ) import Unison.Runtime.Foreign ( Foreign (..), @@ -64,13 +64,13 @@ import Unison.Type booleanRef, charRef, floatRef, + iarrayRef, + ibytearrayRef, intRef, listRef, natRef, termLinkRef, typeLinkRef, - iarrayRef, - ibytearrayRef, ) import Unison.Util.Bytes qualified as By import Unison.Util.Pretty (indentN, lines, lit, syntaxToColor, wrap) @@ -219,8 +219,8 @@ decompileForeign backref topTerms f | Just l <- maybeUnwrapForeign typeLinkRef f = pure $ typeLink () l | Just (a :: Array Closure) <- maybeUnwrapForeign iarrayRef f = - app () (ref () iarrayFromListRef) . list () <$> - traverse (decompile backref topTerms) (toList a) + app () (ref () iarrayFromListRef) . list () + <$> traverse (decompile backref topTerms) (toList a) | Just (a :: ByteArray) <- maybeUnwrapForeign ibytearrayRef f = pure $ app diff --git a/parser-typechecker/src/Unison/Runtime/Foreign.hs b/parser-typechecker/src/Unison/Runtime/Foreign.hs index e12253095e..c9cd12fafb 100644 --- a/parser-typechecker/src/Unison/Runtime/Foreign.hs +++ b/parser-typechecker/src/Unison/Runtime/Foreign.hs @@ -27,8 +27,8 @@ import Data.Primitive (ByteArray, MutableArray, MutableByteArray) import Data.Tagged (Tagged (..)) import Data.X509 qualified as X509 import Network.Socket (Socket) -import Network.UDP (ListenSocket, UDPSocket, ClientSockAddr) import Network.TLS qualified as TLS (ClientParams, Context, ServerParams) +import Network.UDP (ClientSockAddr, ListenSocket, UDPSocket) import System.Clock (TimeSpec) import System.IO (Handle) import System.Process (ProcessHandle) diff --git a/parser-typechecker/src/Unison/Typechecker/Context.hs b/parser-typechecker/src/Unison/Typechecker/Context.hs index 8b6a5939b9..11279cf898 100644 --- a/parser-typechecker/src/Unison/Typechecker/Context.hs +++ b/parser-typechecker/src/Unison/Typechecker/Context.hs @@ -84,6 +84,7 @@ import Unison.DataDeclaration import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.KindInference qualified as KindInference +import Unison.Name (Name) import Unison.Pattern (Pattern) import Unison.Pattern qualified as Pattern import Unison.PatternMatchCoverage (checkMatch) @@ -104,7 +105,6 @@ import Unison.Typechecker.TypeLookup qualified as TL import Unison.Typechecker.TypeVar qualified as TypeVar import Unison.Var (Var) import Unison.Var qualified as Var -import Unison.Name (Name) type TypeVar v loc = TypeVar.TypeVar (B.Blank loc) v diff --git a/parser-typechecker/src/Unison/Util/Text/Pattern.hs b/parser-typechecker/src/Unison/Util/Text/Pattern.hs index e2c80452ae..3ae41def21 100644 --- a/parser-typechecker/src/Unison/Util/Text/Pattern.hs +++ b/parser-typechecker/src/Unison/Util/Text/Pattern.hs @@ -157,8 +157,9 @@ compile (Many correct p) !_ !success = case p of Char cp -> walker (charPatternPred cp) p -> go where - go | correct = try "Many" (compile p) success success' - | otherwise = compile p success success' + go + | correct = try "Many" (compile p) success success' + | otherwise = compile p success success' success' acc rem | Text.size rem == 0 = success acc rem | otherwise = go acc rem diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 26a57d1412..1fb4e5eda4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -41,8 +41,8 @@ import Unison.Cli.Pretty qualified as Pretty import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) import Unison.Cli.UniqueTypeGuidLookup qualified as Cli import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch (Branch0) +import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Output (Output) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index fe7cece9e5..e6b5608e26 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -409,7 +409,6 @@ data Output | UseLibInstallNotPull !(ProjectAndBranch ProjectName ProjectBranchName) | PullIntoMissingBranch !(ReadRemoteNamespace Share.RemoteProjectBranch) !(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - data UpdateOrUpgrade = UOUUpdate | UOUUpgrade -- | What did we create a project branch from? From e656aa861cd0234fb3bb60a51a9ca5725e1e81cd Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 4 Jun 2024 18:26:42 -0600 Subject: [PATCH 089/631] Be explicit about various CLI command failures MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Parse failures more consistently report something like “I expected a branch, but received “blah.blah.blah”, which is a name.” And when the wrong number of args are provided to a command, “I expected exactly one argument, but received 0.” --- .../src/Unison/CommandLine/InputPatterns.hs | 206 +++++++++--------- 1 file changed, 104 insertions(+), 102 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 78cb3d0914..a9db25446e 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1,7 +1,4 @@ -{- - This module defines 'InputPattern' values for every supported input command. --} - +-- | This module defines 'InputPattern' values for every supported input command. module Unison.CommandLine.InputPatterns ( -- * Input commands add, @@ -297,14 +294,18 @@ unsupportedStructuredArgument :: Text -> I.Argument -> Either (P.Pretty CT.Color unsupportedStructuredArgument expected = either pure (const . Left . P.text $ "can’t use a numbered argument for " <> expected) +expectedButActually' :: Text -> String -> P.Pretty CT.ColorText +expectedButActually' expected actualValue = + P.text $ "Expected " <> expected <> ", but I saw “" <> Text.pack actualValue <> "”." + expectedButActually :: Text -> StructuredArgument -> Text -> P.Pretty CT.ColorText expectedButActually expected actualValue actualType = P.text $ "Expected " <> expected - <> ", but the numbered arg resulted in " + <> ", but the numbered arg resulted in “" <> formatStructuredArgument Nothing actualValue - <> ", which is " + <> "”, which is " <> actualType <> "." @@ -325,6 +326,10 @@ wrongStructuredArgument expected actual = SA.ShallowListEntry _ _ -> "an annotated symbol" SA.SearchResult _ _ -> "a search result" +wrongArgsLength :: Text -> [a] -> Either (P.Pretty CT.ColorText) b +wrongArgsLength expected args = + Left . P.text $ "I expected " <> expected <> ", but received " <> Text.pack (show $ length args) <> "." + patternName :: InputPattern -> P.Pretty P.ColorText patternName = fromString . I.patternName @@ -348,10 +353,7 @@ helpFor = I.help handleProjectArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectName handleProjectArg = either - ( \name -> - first (const . P.text $ "“" <> Text.pack name <> "” is an invalid project name") . tryInto @ProjectName $ - Text.pack name - ) + (\name -> first (const $ expectedButActually' "a project" name) . tryInto @ProjectName $ Text.pack name) \case SA.Project project -> pure project otherArgType -> Left $ wrongStructuredArgument "a project" otherArgType @@ -359,7 +361,7 @@ handleProjectArg = handleLooseCodeOrProjectArg :: I.Argument -> Either (P.Pretty CT.ColorText) Input.LooseCodeOrProject handleLooseCodeOrProjectArg = either - (maybe (Left $ P.text "invalid path or project branch") pure . parseLooseCodeOrProject) + (\str -> maybe (Left $ expectedButActually' "a path or project branch" str) pure $ parseLooseCodeOrProject str) \case SA.AbsolutePath path -> pure . This $ Path.absoluteToPath' path SA.ProjectBranch pb -> pure $ That pb @@ -378,12 +380,12 @@ handleProjectMaybeBranchArg :: I.Argument -> Either (P.Pretty CT.ColorText) (ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) handleProjectMaybeBranchArg = either - (first (const $ P.text "The argument wasn’t a project") . tryInto . Text.pack) + (\str -> first (const $ expectedButActually' "a project or branch" str) . tryInto $ Text.pack str) \case SA.Project proj -> pure $ ProjectAndBranch proj Nothing SA.ProjectBranch (ProjectAndBranch (Just proj) branch) -> pure . ProjectAndBranch proj . pure $ ProjectBranchNameOrLatestRelease'Name branch - otherArgType -> Left $ wrongStructuredArgument "a project" otherArgType + otherArgType -> Left $ wrongStructuredArgument "a project or branch" otherArgType handleHashQualifiedNameArg :: I.Argument -> Either (P.Pretty CT.ColorText) (HQ.HashQualified Name) handleHashQualifiedNameArg = @@ -479,7 +481,7 @@ handleBranchIdOrProjectArg :: Either (P.Pretty CT.ColorText) (These Input.BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)) handleBranchIdOrProjectArg = either - (maybe (Left $ P.text "Expected a branch or project, but it’s not") pure . branchIdOrProject) + (\str -> maybe (Left $ expectedButActually' "a branch" str) pure $ branchIdOrProject str) \case SA.Namespace hash -> pure . This . Left $ SCH.fromFullHash hash SA.AbsolutePath path -> pure . This . pure $ Path.absoluteToPath' path @@ -649,16 +651,16 @@ handlePushTargetArg :: I.Argument -> Either (P.Pretty CT.ColorText) (WriteRemoteNamespace (These ProjectName ProjectBranchName)) handlePushTargetArg = either - (maybe (Left "Wanted a source to push from, but this ain’t it.") pure . parsePushTarget) + (\str -> maybe (Left $ expectedButActually' "a target to push to" str) pure $ parsePushTarget str) $ fmap RemoteRepo.WriteRemoteProjectBranch . \case SA.Project project -> pure $ This project SA.ProjectBranch (ProjectAndBranch project branch) -> pure $ maybe That These project branch - otherNumArg -> Left $ wrongStructuredArgument "a source to push from" otherNumArg + otherNumArg -> Left $ wrongStructuredArgument "a target to push to" otherNumArg handlePushSourceArg :: I.Argument -> Either (P.Pretty CT.ColorText) Input.PushSource handlePushSourceArg = either - (maybe (Left $ P.text "Wanted a source to push from, but this ain’t it.") pure . parsePushSource) + (\str -> maybe (Left $ expectedButActually' "a source to push from" str) pure $ parsePushSource str) \case SA.AbsolutePath path -> pure . Input.PathySource $ Path.absoluteToPath' path SA.Name name -> pure . Input.PathySource $ Path.fromName' name @@ -672,7 +674,7 @@ handlePushSourceArg = handleProjectAndBranchNamesArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectAndBranchNames handleProjectAndBranchNamesArg = either - (first (const $ P.text "The argument wasn’t a project or branch") . tryInto @ProjectAndBranchNames . Text.pack) + (\str -> first (const $ expectedButActually' "a project or branch" str) . tryInto @ProjectAndBranchNames $ Text.pack str) $ fmap ProjectAndBranchNames'Unambiguous . \case SA.Project project -> pure $ This project SA.ProjectBranch (ProjectAndBranch mproj branch) -> pure $ maybe That These mproj branch @@ -689,7 +691,7 @@ mergeBuiltins = \case [] -> pure . Input.MergeBuiltinsI $ Nothing [p] -> Input.MergeBuiltinsI . Just <$> handlePathArg p - _ -> Left (I.help mergeBuiltins) + args -> wrongArgsLength "no more than one argument" args mergeIOBuiltins :: InputPattern mergeIOBuiltins = @@ -702,7 +704,7 @@ mergeIOBuiltins = \case [] -> pure . Input.MergeIOBuiltinsI $ Nothing [p] -> Input.MergeIOBuiltinsI . Just <$> handlePathArg p - _ -> Left (I.help mergeBuiltins) + args -> wrongArgsLength "no more than one argument" args updateBuiltins :: InputPattern updateBuiltins = @@ -766,7 +768,7 @@ load = \case [] -> pure $ Input.LoadI Nothing [file] -> Input.LoadI . Just <$> unsupportedStructuredArgument "a file name" file - _ -> Left (I.help load) + args -> wrongArgsLength "no more than one argument" args clear :: InputPattern clear = @@ -783,7 +785,7 @@ clear = ) \case [] -> pure Input.ClearI - _ -> Left (I.help clear) + args -> wrongArgsLength "no arguments" args add :: InputPattern add = @@ -826,7 +828,7 @@ update = <> "for your review.", parse = \case [] -> pure Input.Update2I - _ -> Left $ I.help update + args -> wrongArgsLength "no arguments" args } updateOldNoPatch :: InputPattern @@ -927,7 +929,7 @@ view = ] ) ( maybe - (Left $ I.help view) + (wrongArgsLength "at least one argument" []) ( fmap (Input.ShowDefinitionI Input.ConsoleLocation Input.ShowDefinitionLocal) . traverse handleHashQualifiedNameArg ) @@ -947,7 +949,7 @@ viewGlobal = ] ) ( maybe - (Left $ I.help viewGlobal) + (wrongArgsLength "at least one argument" []) ( fmap (Input.ShowDefinitionI Input.ConsoleLocation Input.ShowDefinitionGlobal) . traverse handleHashQualifiedNameArg ) @@ -966,7 +968,9 @@ display = "`display` without arguments invokes a search to select a definition to display, which requires that `fzf` can be found within your PATH." ] ) - $ maybe (Left $ I.help display) (fmap (Input.DisplayI Input.ConsoleLocation) . traverse handleHashQualifiedNameArg) + $ maybe + (wrongArgsLength "at least one argument" []) + (fmap (Input.DisplayI Input.ConsoleLocation) . traverse handleHashQualifiedNameArg) . NE.nonEmpty displayTo :: InputPattern @@ -983,14 +987,14 @@ displayTo = $ \case file : defs -> maybe - (Left $ I.help displayTo) + (wrongArgsLength "at least two arguments" [file]) ( \defs -> Input.DisplayI . Input.FileLocation <$> unsupportedStructuredArgument "a file name" file <*> traverse handleHashQualifiedNameArg defs ) $ NE.nonEmpty defs - _ -> Left (I.help displayTo) + [] -> wrongArgsLength "at least two arguments" [] docs :: InputPattern docs = @@ -1004,7 +1008,7 @@ docs = "`docs` without arguments invokes a search to select which definition to view documentation for, which requires that `fzf` can be found within your PATH." ] ) - $ maybe (Left $ I.help docs) (fmap Input.DocsI . traverse handleNameArg) . NE.nonEmpty + $ maybe (wrongArgsLength "at least one argument" []) (fmap Input.DocsI . traverse handleNameArg) . NE.nonEmpty api :: InputPattern api = @@ -1027,7 +1031,7 @@ ui = parse = \case [] -> pure $ Input.UiI Path.relativeEmpty' [path] -> Input.UiI <$> handlePath'Arg path - _ -> Left (I.help ui) + args -> wrongArgsLength "no more than one argument" args } undo :: InputPattern @@ -1044,10 +1048,9 @@ sfind :: InputPattern sfind = InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse where - parse [q] = - Input.StructuredFindI (Input.FindLocal Path.empty) - <$> handleHashQualifiedNameArg q - parse _ = Left "expected exactly one argument" + parse = \case + [q] -> Input.StructuredFindI (Input.FindLocal Path.empty) <$> handleHashQualifiedNameArg q + args -> wrongArgsLength "exactly one argument" args msg = P.lines [ P.wrap $ @@ -1078,7 +1081,7 @@ sfindReplace = InputPattern "rewrite" ["sfind.replace"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse where parse [q] = Input.StructuredFindReplaceI <$> handleHashQualifiedNameArg q - parse _ = Left "expected exactly one argument" + parse args = wrongArgsLength "exactly one argument" args msg :: P.Pretty CT.ColorText msg = P.lines @@ -1126,7 +1129,7 @@ findIn' cmd mkfscope = findHelp \case p : args -> Input.FindI False . mkfscope <$> handlePathArg p <*> pure (unifyArgument <$> args) - _ -> Left findHelp + args -> wrongArgsLength "at least one argument" args findHelp :: P.Pretty CT.ColorText findHelp = @@ -1190,7 +1193,7 @@ findShallow = ( fmap Input.FindShallowI . \case [] -> pure Path.relativeEmpty' [path] -> handlePath'Arg path - _ -> Left (I.help findShallow) + args -> wrongArgsLength "no more than one argument" args ) findVerbose :: InputPattern @@ -1332,7 +1335,7 @@ deleteProject = ], parse = \case [name] -> Input.DeleteI . DeleteTarget'Project <$> handleProjectArg name - _ -> Left (showPatternHelp deleteProject) + args -> wrongArgsLength "exactly one argument" args } deleteBranch :: InputPattern @@ -1349,7 +1352,7 @@ deleteBranch = ], parse = \case [name] -> Input.DeleteI . DeleteTarget'ProjectBranch <$> handleMaybeProjectBranchArg name - _ -> Left (showPatternHelp deleteBranch) + args -> wrongArgsLength "exactly one argument" args } where suggestionsConfig = @@ -1402,7 +1405,7 @@ aliasMany = \case srcs@(_ : _) Cons.:> dest -> Input.AliasManyI <$> traverse handleHashQualifiedSplitArg srcs <*> handlePath'Arg dest - _ -> Left (I.help aliasMany) + args -> wrongArgsLength "at least two arguments" args up :: InputPattern up = @@ -1414,7 +1417,7 @@ up = (P.wrapColumn2 [(makeExample up [], "move current path up one level (deprecated)")]) \case [] -> Right Input.UpI - _ -> Left (I.help up) + args -> wrongArgsLength "no arguments" args cd :: InputPattern cd = @@ -1445,7 +1448,7 @@ cd = \case [Left ".."] -> Right Input.UpI [p] -> Input.SwitchBranchI <$> handlePath'Arg p - _ -> Left (I.help cd) + args -> wrongArgsLength "exactly one argument" args back :: InputPattern back = @@ -1462,7 +1465,7 @@ back = ) \case [] -> pure Input.PopBranchI - _ -> Left (I.help cd) + args -> wrongArgsLength "no arguments" args deleteNamespace :: InputPattern deleteNamespace = @@ -1472,7 +1475,7 @@ deleteNamespace = I.Visible [("namespace to delete", Required, namespaceArg)] "`delete.namespace ` deletes the namespace `foo`" - (deleteNamespaceParser (I.help deleteNamespace) Input.Try) + (deleteNamespaceParser Input.Try) deleteNamespaceForce :: InputPattern deleteNamespaceForce = @@ -1484,13 +1487,13 @@ deleteNamespaceForce = ( "`delete.namespace.force ` deletes the namespace `foo`," <> "deletion will proceed even if other code depends on definitions in foo." ) - (deleteNamespaceParser (I.help deleteNamespaceForce) Input.Force) + (deleteNamespaceParser Input.Force) -deleteNamespaceParser :: P.Pretty CT.ColorText -> Input.Insistence -> I.Arguments -> Either (P.Pretty CT.ColorText) Input -deleteNamespaceParser helpText insistence = \case +deleteNamespaceParser :: Input.Insistence -> I.Arguments -> Either (P.Pretty CT.ColorText) Input +deleteNamespaceParser insistence = \case [Left "."] -> first fromString . pure $ Input.DeleteI (DeleteTarget'Namespace insistence Nothing) [p] -> Input.DeleteI . DeleteTarget'Namespace insistence . pure <$> handleSplitArg p - _ -> Left helpText + args -> wrongArgsLength "exactly one argument" args renameBranch :: InputPattern renameBranch = @@ -1502,7 +1505,7 @@ renameBranch = "`move.namespace foo bar` renames the path `foo` to `bar`." \case [src, dest] -> Input.MoveBranchI <$> handlePath'Arg src <*> handlePath'Arg dest - _ -> Left (I.help renameBranch) + args -> wrongArgsLength "exactly two arguments" args history :: InputPattern history = @@ -1523,7 +1526,7 @@ history = \case [src] -> Input.HistoryI (Just 10) (Just 10) <$> handleBranchIdArg src [] -> pure $ Input.HistoryI (Just 10) (Just 10) (Right Path.currentPath) - _ -> Left (I.help history) + args -> wrongArgsLength "no more than one argument" args forkLocal :: InputPattern forkLocal = @@ -1548,7 +1551,7 @@ forkLocal = ) \case [src, dest] -> Input.ForkLocalBranchI <$> handleBranchId2Arg src <*> handleBranchRelativePathArg dest - _ -> Left (I.help forkLocal) + args -> wrongArgsLength "exactly two arguments" args libInstallInputPattern :: InputPattern libInstallInputPattern = @@ -1578,7 +1581,7 @@ libInstallInputPattern = ], parse = \case [arg] -> Input.LibInstallI False <$> handleProjectMaybeBranchArg arg - _ -> Left (I.help libInstallInputPattern) + args -> wrongArgsLength "exactly one argument" args } reset :: InputPattern @@ -1600,7 +1603,7 @@ reset = \case [arg0] -> Input.ResetI <$> handleBranchIdOrProjectArg arg0 <*> pure Nothing [arg0, arg1] -> Input.ResetI <$> handleBranchIdOrProjectArg arg0 <*> fmap pure (handleLooseCodeOrProjectArg arg1) - _ -> Left $ I.help reset + args -> wrongArgsLength "one or two arguments" args where config = ProjectBranchSuggestionsConfig @@ -1632,7 +1635,7 @@ resetRoot = ) $ \case [src] -> Input.ResetRootI <$> handleBranchIdArg src - _ -> Left (I.help resetRoot) + args -> wrongArgsLength "exactly one argument" args pull :: InputPattern pull = @@ -1753,7 +1756,7 @@ pullImpl name aliases pullMode addendum = do <> P.newline <> P.newline <> P.wrap "Use `help pull` to see some examples." - _ -> Left $ I.help self + args -> wrongArgsLength "no more than two arguments" args } debugTabCompletion :: InputPattern @@ -1790,7 +1793,7 @@ debugFuzzyOptions = Input.DebugFuzzyOptionsI <$> unsupportedStructuredArgument "a command" cmd <*> traverse (unsupportedStructuredArgument "text") args - _ -> Left (I.help debugFuzzyOptions) + args -> wrongArgsLength "at least one argument" args debugFormat :: InputPattern debugFormat = @@ -1806,7 +1809,7 @@ debugFormat = ) ( \case [] -> Right Input.DebugFormatI - _ -> Left (I.help debugFormat) + args -> wrongArgsLength "no arguments" args ) push :: InputPattern @@ -1853,7 +1856,7 @@ push = [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr [targetStr, sourceStr] -> Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr - _ -> Left (I.help push) + args -> wrongArgsLength "no more than two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -1904,7 +1907,7 @@ pushCreate = [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr [targetStr, sourceStr] -> Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr - _ -> Left (I.help pushForce) + args -> wrongArgsLength "no more than two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -1934,7 +1937,7 @@ pushForce = [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr [targetStr, sourceStr] -> Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr - _ -> Left (I.help pushForce) + args -> wrongArgsLength "no more than two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -1974,7 +1977,7 @@ pushExhaustive = [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr [targetStr, sourceStr] -> Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr - _ -> Left (I.help pushExhaustive) + args -> wrongArgsLength "no more than two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -2006,7 +2009,7 @@ mergeOldSquashInputPattern = <$> handleLooseCodeOrProjectArg src <*> handleLooseCodeOrProjectArg dest <*> pure Branch.SquashMerge - _ -> Left $ I.help mergeOldSquashInputPattern + args -> wrongArgsLength "exactly two arguments" args } where suggestionsConfig = @@ -2057,7 +2060,7 @@ mergeOldInputPattern = <$> handleLooseCodeOrProjectArg src <*> handleLooseCodeOrProjectArg dest <*> pure Branch.RegularMerge - _ -> Left $ I.help mergeOldInputPattern + args -> wrongArgsLength "one or two arguments" args ) where config = @@ -2087,9 +2090,8 @@ mergeInputPattern = help = P.wrap $ makeExample mergeInputPattern ["/branch"] <> "merges `branch` into the current branch", parse = \case - [branchString] -> - Input.MergeI <$> handleMaybeProjectBranchArg branchString - _ -> Left $ I.help mergeInputPattern + [branchString] -> Input.MergeI <$> handleMaybeProjectBranchArg branchString + args -> wrongArgsLength "exactly one argument" args } parseLooseCodeOrProject :: String -> Maybe Input.LooseCodeOrProject @@ -2122,7 +2124,7 @@ diffNamespace = ( \case [before, after] -> Input.DiffNamespaceI <$> handleBranchIdArg before <*> handleBranchIdArg after [before] -> Input.DiffNamespaceI <$> handleBranchIdArg before <*> pure (pure Path.currentPath) - _ -> Left $ I.help diffNamespace + args -> wrongArgsLength "one or two arguments" args ) where suggestionsConfig = @@ -2152,7 +2154,7 @@ mergeOldPreviewInputPattern = [src] -> Input.PreviewMergeLocalBranchI <$> handleLooseCodeOrProjectArg src <*> pure (This Path.relativeEmpty') [src, dest] -> Input.PreviewMergeLocalBranchI <$> handleLooseCodeOrProjectArg src <*> handleLooseCodeOrProjectArg dest - _ -> Left $ I.help mergeOldPreviewInputPattern + args -> wrongArgsLength "one or two arguments" args ) where suggestionsConfig = @@ -2192,7 +2194,7 @@ edit = ], parse = maybe - (Left $ I.help edit) + (wrongArgsLength "at least one argument" []) ( fmap (Input.ShowDefinitionI Input.LatestFileLocation Input.ShowDefinitionLocal) . traverse handleHashQualifiedNameArg ) @@ -2486,7 +2488,7 @@ dependents = "List the named dependents of the specified definition." $ \case [thing] -> Input.ListDependentsI <$> handleHashQualifiedNameArg thing - _ -> Left (I.help dependents) + args -> wrongArgsLength "exactly one argument" args dependencies = InputPattern "dependencies" @@ -2496,7 +2498,7 @@ dependencies = "List the dependencies of the specified definition." $ \case [thing] -> Input.ListDependenciesI <$> handleHashQualifiedNameArg thing - _ -> Left (I.help dependencies) + args -> wrongArgsLength "exactly one argument" args namespaceDependencies :: InputPattern namespaceDependencies = @@ -2509,7 +2511,7 @@ namespaceDependencies = $ \case [p] -> Input.NamespaceDependenciesI . pure <$> handlePath'Arg p [] -> pure (Input.NamespaceDependenciesI Nothing) - _ -> Left (I.help namespaceDependencies) + args -> wrongArgsLength "no more than one argument" args debugNumberedArgs :: InputPattern debugNumberedArgs = @@ -2561,7 +2563,7 @@ debugTerm = "View debugging information for a given term." ( \case [thing] -> Input.DebugTermI False <$> handleHashQualifiedNameArg thing - _ -> Left (I.help debugTerm) + args -> wrongArgsLength "exactly one argument" args ) debugTermVerbose :: InputPattern @@ -2574,7 +2576,7 @@ debugTermVerbose = "View verbose debugging information for a given term." ( \case [thing] -> Input.DebugTermI True <$> handleHashQualifiedNameArg thing - _ -> Left (I.help debugTermVerbose) + args -> wrongArgsLength "exactly one argument" args ) debugType :: InputPattern @@ -2587,7 +2589,7 @@ debugType = "View debugging information for a given type." ( \case [thing] -> Input.DebugTypeI <$> handleHashQualifiedNameArg thing - _ -> Left (I.help debugType) + args -> wrongArgsLength "exactly one argument" args ) debugLSPFoldRanges :: InputPattern @@ -2621,7 +2623,7 @@ debugDoctor = ) ( \case [] -> Right $ Input.DebugDoctorI - _ -> Left (showPatternHelp debugDoctor) + args -> wrongArgsLength "no arguments" args ) debugNameDiff :: InputPattern @@ -2634,7 +2636,7 @@ debugNameDiff = help = P.wrap "List all name changes between two causal hashes. Does not detect patch changes.", parse = \case [from, to] -> Input.DebugNameDiffI <$> handleShortCausalHashArg from <*> handleShortCausalHashArg to - _ -> Left (I.help debugNameDiff) + args -> wrongArgsLength "exactly two arguments" args } test :: InputPattern @@ -2663,7 +2665,7 @@ test = . \case [] -> pure Path.empty [pathString] -> handlePathArg pathString - _ -> Left $ I.help test + args -> wrongArgsLength "no more than one argument" args } testAll :: InputPattern @@ -2704,7 +2706,7 @@ docsToHtml = Input.DocsToHtmlI <$> handlePath'Arg namespacePath <*> unsupportedStructuredArgument "a file name" destinationFilePath - _ -> Left $ showPatternHelp docsToHtml + args -> wrongArgsLength "exactly two arguments" args docToMarkdown :: InputPattern docToMarkdown = @@ -2721,7 +2723,7 @@ docToMarkdown = ) \case [docNameText] -> Input.DocToMarkdownI <$> handleNameArg docNameText - _ -> Left $ showPatternHelp docToMarkdown + args -> wrongArgsLength "exactly one argument" args execute :: InputPattern execute = @@ -2744,7 +2746,7 @@ execute = Input.ExecuteI <$> handleHashQualifiedNameArg main <*> traverse (unsupportedStructuredArgument "a command-line argument") args - _ -> Left $ showPatternHelp execute + [] -> wrongArgsLength "at least one argument" [] saveExecuteResult :: InputPattern saveExecuteResult = @@ -2758,7 +2760,7 @@ saveExecuteResult = ) $ \case [w] -> Input.SaveExecuteResultI <$> handleNameArg w - _ -> Left $ showPatternHelp saveExecuteResult + args -> wrongArgsLength "exactly one argument" args ioTest :: InputPattern ioTest = @@ -2775,7 +2777,7 @@ ioTest = ], parse = \case [thing] -> Input.IOTestI <$> handleHashQualifiedNameArg thing - _ -> Left $ showPatternHelp ioTest + args -> wrongArgsLength "exactly one argument" args } ioTestAll :: InputPattern @@ -2793,7 +2795,7 @@ ioTestAll = ], parse = \case [] -> Right Input.IOTestAllI - _ -> Left $ showPatternHelp ioTest + args -> wrongArgsLength "no arguments" args } makeStandalone :: InputPattern @@ -2816,7 +2818,7 @@ makeStandalone = Input.MakeStandaloneI <$> unsupportedStructuredArgument "a file name" file <*> handleHashQualifiedNameArg main - _ -> Left $ showPatternHelp makeStandalone + args -> wrongArgsLength "exactly two arguments" args runScheme :: InputPattern runScheme = @@ -2836,7 +2838,7 @@ runScheme = Input.ExecuteSchemeI <$> handleHashQualifiedNameArg main <*> traverse (unsupportedStructuredArgument "a command-line argument") args - _ -> Left $ showPatternHelp runScheme + [] -> wrongArgsLength "at least one argument" [] compileScheme :: InputPattern compileScheme = @@ -2858,7 +2860,7 @@ compileScheme = Input.CompileSchemeI . Text.pack <$> unsupportedStructuredArgument "a file name" file <*> handleHashQualifiedNameArg main - _ -> Left $ showPatternHelp compileScheme + args -> wrongArgsLength "exactly two arguments" args createAuthor :: InputPattern createAuthor = @@ -2883,7 +2885,7 @@ createAuthor = Input.CreateAuthorI <$> handleRelativeNameSegmentArg symbolStr <*> fmap (parseAuthorName . unwords) (traverse (unsupportedStructuredArgument "text") authorStr) - _ -> Left $ showPatternHelp createAuthor + args -> wrongArgsLength "at least two arguments" args where -- let's have a real parser in not too long parseAuthorName :: String -> Text @@ -2907,7 +2909,7 @@ authLogin = ) ( \case [] -> Right $ Input.AuthLoginI - _ -> Left (showPatternHelp authLogin) + args -> wrongArgsLength "no arguments" args ) printVersion :: InputPattern @@ -2921,7 +2923,7 @@ printVersion = ) ( \case [] -> Right $ Input.VersionI - _ -> Left (showPatternHelp printVersion) + args -> wrongArgsLength "no arguments" args ) projectCreate :: InputPattern @@ -2939,7 +2941,7 @@ projectCreate = parse = \case [] -> pure $ Input.ProjectCreateI True Nothing [name] -> Input.ProjectCreateI True . pure <$> handleProjectArg name - _ -> Left $ showPatternHelp projectCreate + args -> wrongArgsLength "no more than one argument" args } projectCreateEmptyInputPattern :: InputPattern @@ -2957,7 +2959,7 @@ projectCreateEmptyInputPattern = parse = \case [] -> pure $ Input.ProjectCreateI False Nothing [name] -> Input.ProjectCreateI False . pure <$> handleProjectArg name - _ -> Left $ showPatternHelp projectCreateEmptyInputPattern + args -> wrongArgsLength "no more than one argument" args } projectRenameInputPattern :: InputPattern @@ -2973,7 +2975,7 @@ projectRenameInputPattern = ], parse = \case [nameString] -> Input.ProjectRenameI <$> handleProjectArg nameString - _ -> Left (showPatternHelp projectRenameInputPattern) + args -> wrongArgsLength "exactly one argument" args } projectSwitch :: InputPattern @@ -2992,7 +2994,7 @@ projectSwitch = ], parse = \case [name] -> Input.ProjectSwitchI <$> handleProjectAndBranchNamesArg name - _ -> Left (showPatternHelp projectSwitch) + args -> wrongArgsLength "exactly one argument" args } where suggestionsConfig = @@ -3028,7 +3030,7 @@ branchesInputPattern = parse = \case [] -> Right (Input.BranchesI Nothing) [nameString] -> Input.BranchesI . pure <$> handleProjectArg nameString - _ -> Left (showPatternHelp branchesInputPattern) + args -> wrongArgsLength "no more than one argument" args } branchInputPattern :: InputPattern @@ -3053,7 +3055,7 @@ branchInputPattern = <$> handleLooseCodeOrProjectArg source0 <*> handleMaybeProjectBranchArg name [name] -> Input.BranchI Input.BranchSourceI'CurrentContext <$> handleMaybeProjectBranchArg name - _ -> Left $ showPatternHelp branchInputPattern + args -> wrongArgsLength "one or two arguments" args } where newBranchNameArg = @@ -3081,7 +3083,7 @@ branchEmptyInputPattern = [name] -> Input.BranchI Input.BranchSourceI'Empty <$> handleMaybeProjectBranchArg name - _ -> Left (showPatternHelp branchEmptyInputPattern) + args -> wrongArgsLength "exactly one argument" args } branchRenameInputPattern :: InputPattern @@ -3096,7 +3098,7 @@ branchRenameInputPattern = [("`branch.rename foo`", "renames the current branch to `foo`")], parse = \case [name] -> Input.BranchRenameI <$> handleProjectBranchNameArg name - _ -> Left (showPatternHelp branchRenameInputPattern) + args -> wrongArgsLength "exactly one argument" args } clone :: InputPattern @@ -3134,7 +3136,7 @@ clone = Input.CloneI <$> handleProjectAndBranchNamesArg remoteNames <*> fmap pure (handleProjectAndBranchNamesArg localNames) - _ -> Left $ showPatternHelp clone + args -> wrongArgsLength "one or two arguments" args } releaseDraft :: InputPattern @@ -3151,7 +3153,7 @@ releaseDraft = . tryInto @Semver . Text.pack =<< unsupportedStructuredArgument "a version number" semverString - _ -> Left (showPatternHelp releaseDraft) + args -> wrongArgsLength "exactly one argument" args } upgrade :: InputPattern @@ -3167,7 +3169,7 @@ upgrade = parse = \case [oldString, newString] -> Input.UpgradeI <$> handleRelativeNameSegmentArg oldString <*> handleRelativeNameSegmentArg newString - _ -> Left $ I.help upgrade + args -> wrongArgsLength "exactly two arguments" args } upgradeCommitInputPattern :: InputPattern @@ -3209,7 +3211,7 @@ upgradeCommitInputPattern = ), parse = \case [] -> Right Input.UpgradeCommitI - _ -> Left (I.help upgradeCommitInputPattern) + args -> wrongArgsLength "no arguments" args } validInputs :: [InputPattern] From 565da6d4a00276162dd179df8d04f5995e403fa4 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 4 Jun 2024 18:31:21 -0600 Subject: [PATCH 090/631] Include `help` output on all CLI command failures MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit ```ucm @unison/base/main> lib.install blah.blah.blah Sorry, I couldn’t understand your request. I expected a project or branch, but saw ”blah.blah.blah”. Usage: The `lib.install` command installs a dependency into the `lib` namespace. `lib.install @unison/base/releases/latest` installs the latest release of `@unison/base` `lib.install @unison/base/releases/3.0.0` installs version 3.0.0 of `@unison/base` `lib.install @unison/base/topic` installs the `topic` branch of `@unison/base` ``` --- unison-cli/src/Unison/CommandLine.hs | 14 ++++- .../src/Unison/CommandLine/InputPatterns.hs | 43 ++++++------- unison-src/transcripts/pull-errors.output.md | 62 ++++++++++++++++--- 3 files changed, 84 insertions(+), 35 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 2c8be9bf43..1431ebeac9 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -149,7 +149,19 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do Left (NoFZFOptions argDesc) -> throwError (noCompletionsMessage argDesc) Left FZFCancelled -> pure Nothing Right resolvedArgs -> do - parsedInput <- except . parse $ resolvedArgs + parsedInput <- + except + . first + ( \msg -> + P.indentN 2 $ + P.wrap (P.text "Sorry, I couldn’t understand your request. " <> msg) + <> P.newline + <> P.newline + <> P.text "Usage:" + <> P.newline + <> P.indentN 2 help + ) + $ parse resolvedArgs pure $ Just (Left command : resolvedArgs, parsedInput) Nothing -> throwE diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index a9db25446e..eecf3217a0 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1732,30 +1732,25 @@ pullImpl name aliases pullMode addendum = do These sourceProject sourceBranch -> Right (Input.LibInstallI True (ProjectAndBranch sourceProject (Just sourceBranch))) (Right source, Left _, Right path) -> - Left . P.indentN 2 $ - P.wrap - ( "I think you're wanting to merge" - <> case source of - RemoteRepo.ReadShare'LooseCode _sourcePath -> "some non-project code" - RemoteRepo.ReadShare'ProjectBranch (This sourceProject) -> - prettyProjectNameSlash sourceProject - RemoteRepo.ReadShare'ProjectBranch (That ProjectBranchNameOrLatestRelease'LatestRelease) -> - "the latest release" - RemoteRepo.ReadShare'ProjectBranch (That (ProjectBranchNameOrLatestRelease'Name sourceBranch)) -> - prettySlashProjectBranchName sourceBranch - RemoteRepo.ReadShare'ProjectBranch (These sourceProject ProjectBranchNameOrLatestRelease'LatestRelease) -> - "the latest release of" <> prettyProjectName sourceProject - RemoteRepo.ReadShare'ProjectBranch (These sourceProject (ProjectBranchNameOrLatestRelease'Name sourceBranch)) -> - prettyProjectAndBranchName (ProjectAndBranch sourceProject sourceBranch) - <> "into the" - <> prettyPath' path - <> "namespace, but the" - <> makeExample' pull - <> "command only supports merging into the top level of a local project branch." - ) - <> P.newline - <> P.newline - <> P.wrap "Use `help pull` to see some examples." + Left $ + "I think you're wanting to merge" + <> case source of + RemoteRepo.ReadShare'LooseCode _sourcePath -> "some non-project code" + RemoteRepo.ReadShare'ProjectBranch (This sourceProject) -> + prettyProjectNameSlash sourceProject + RemoteRepo.ReadShare'ProjectBranch (That ProjectBranchNameOrLatestRelease'LatestRelease) -> + "the latest release" + RemoteRepo.ReadShare'ProjectBranch (That (ProjectBranchNameOrLatestRelease'Name sourceBranch)) -> + prettySlashProjectBranchName sourceBranch + RemoteRepo.ReadShare'ProjectBranch (These sourceProject ProjectBranchNameOrLatestRelease'LatestRelease) -> + "the latest release of" <> prettyProjectName sourceProject + RemoteRepo.ReadShare'ProjectBranch (These sourceProject (ProjectBranchNameOrLatestRelease'Name sourceBranch)) -> + prettyProjectAndBranchName (ProjectAndBranch sourceProject sourceBranch) + <> "into the" + <> prettyPath' path + <> "namespace, but the" + <> makeExample' pull + <> "command only supports merging into the top level of a local project branch." args -> wrongArgsLength "no more than two arguments" args } diff --git a/unison-src/transcripts/pull-errors.output.md b/unison-src/transcripts/pull-errors.output.md index 963eaabb52..50e7c776ad 100644 --- a/unison-src/transcripts/pull-errors.output.md +++ b/unison-src/transcripts/pull-errors.output.md @@ -30,12 +30,33 @@ test/main> pull @aryairani/test-almost-empty/main lib.base_latest test/main> pull @aryairani/test-almost-empty/main a.b - I think you're wanting to merge - @aryairani/test-almost-empty/main into the a.b namespace, but - the `pull` command only supports merging into the top level of - a local project branch. + Sorry, I couldn’t understand your request. I think you're + wanting to merge @aryairani/test-almost-empty/main into the + a.b namespace, but the `pull` command only supports merging + into the top level of a local project branch. - Use `help pull` to see some examples. + Usage: + The `pull` command merges a remote namespace into a local + branch + + `pull @unison/base/main` merges the branch + `main` of the Unison + Share hosted project + `@unison/base` into + the current branch + `pull @unison/base/main my-base/topic` merges the branch + `main` of the Unison + Share hosted project + `@unison/base` into + the branch `topic` + of the local + `my-base` project + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + Project Release `@unison/base/releases/1.0.0` test/main> pull @aryairani/test-almost-empty/main a @@ -46,11 +67,32 @@ test/main> pull @aryairani/test-almost-empty/main a test/main> pull @aryairani/test-almost-empty/main .a - I think you're wanting to merge - @aryairani/test-almost-empty/main into the .a namespace, but - the `pull` command only supports merging into the top level of - a local project branch. + Sorry, I couldn’t understand your request. I think you're + wanting to merge @aryairani/test-almost-empty/main into the .a + namespace, but the `pull` command only supports merging into + the top level of a local project branch. - Use `help pull` to see some examples. + Usage: + The `pull` command merges a remote namespace into a local + branch + + `pull @unison/base/main` merges the branch + `main` of the Unison + Share hosted project + `@unison/base` into + the current branch + `pull @unison/base/main my-base/topic` merges the branch + `main` of the Unison + Share hosted project + `@unison/base` into + the branch `topic` + of the local + `my-base` project + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + Project Release `@unison/base/releases/1.0.0` ``` From cab24bbb2859fd87876c9245e18ce8deb86e72f1 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 5 Jun 2024 10:40:24 -0600 Subject: [PATCH 091/631] Remove partiality from `hqSplitFromName'` This function previously converted the `Name` to a `Path'`, so recovering the `Name` became partial. It now goes through `Split'` instead of `Path'`, preserving the guaranteed segment. --- parser-typechecker/src/Unison/Codebase/Path.hs | 8 +++----- .../Unison/Codebase/Editor/HandleInput/TermResolution.hs | 6 +++--- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Path.hs b/parser-typechecker/src/Unison/Codebase/Path.hs index b911e276f3..7fbab07c6e 100644 --- a/parser-typechecker/src/Unison/Codebase/Path.hs +++ b/parser-typechecker/src/Unison/Codebase/Path.hs @@ -90,7 +90,7 @@ import Data.Sequence qualified as Seq import Data.Text qualified as Text import GHC.Exts qualified as GHC import Unison.HashQualified' qualified as HQ' -import Unison.Name (Convert (..), Name, Parse) +import Unison.Name (Convert (..), Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.Prelude hiding (empty, toList) @@ -244,8 +244,8 @@ fromList = Path . Seq.fromList ancestors :: Absolute -> Seq Absolute ancestors (Absolute (Path segments)) = Absolute . Path <$> Seq.inits segments -hqSplitFromName' :: Name -> Maybe HQSplit' -hqSplitFromName' = fmap (fmap HQ'.fromName) . Lens.unsnoc . fromName' +hqSplitFromName' :: Name -> HQSplit' +hqSplitFromName' = fmap HQ'.fromName . splitFromName' -- | -- >>> splitFromName "a.b.c" @@ -546,5 +546,3 @@ instance Convert (path, NameSegment) (path, HQ'.HQSegment) where instance (Convert path0 path1) => Convert (path0, name) (path1, name) where convert = over _1 convert - -instance Parse Name HQSplit' where parse = hqSplitFromName' diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs index bb6dddabd6..a63ab11a0b 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs @@ -79,7 +79,7 @@ resolveTerm name = do case lookupTerm name names of [] -> Cli.returnEarly (TermNotFound $ fromJust parsed) where - parsed = hqSplitFromName' =<< HQ.toName name + parsed = hqSplitFromName' <$> HQ.toName name [rf] -> pure rf rfs -> Cli.returnEarly (TermAmbiguous suffixifiedPPE name (fromList rfs)) @@ -92,7 +92,7 @@ resolveCon name = do case lookupCon name names of ([], _) -> Cli.returnEarly (TermNotFound $ fromJust parsed) where - parsed = hqSplitFromName' =<< HQ.toName name + parsed = hqSplitFromName' <$> HQ.toName name ([co], _) -> pure co (_, rfts) -> Cli.returnEarly (TermAmbiguous suffixifiedPPE name (fromList rfts)) @@ -105,7 +105,7 @@ resolveTermRef name = do case lookupTermRefs name names of ([], _) -> Cli.returnEarly (TermNotFound $ fromJust parsed) where - parsed = hqSplitFromName' =<< HQ.toName name + parsed = hqSplitFromName' <$> HQ.toName name ([rf], _) -> pure rf (_, rfts) -> Cli.returnEarly (TermAmbiguous suffixifiedPPE name (fromList rfts)) From 529ae7f174ebe0ab7532701da4830f6b266cbdbd Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 5 Jun 2024 10:51:35 -0600 Subject: [PATCH 092/631] Add a failing transcript for #5055 --- unison-src/transcripts/fix5055.md | 5 ++ unison-src/transcripts/fix5055.output.md | 99 ++++++++++++++++++++++++ 2 files changed, 104 insertions(+) create mode 100644 unison-src/transcripts/fix5055.md create mode 100644 unison-src/transcripts/fix5055.output.md diff --git a/unison-src/transcripts/fix5055.md b/unison-src/transcripts/fix5055.md new file mode 100644 index 0000000000..38a63838f8 --- /dev/null +++ b/unison-src/transcripts/fix5055.md @@ -0,0 +1,5 @@ +```ucm +.> builtins.merge +.> ls builtin +.> view 1 +``` diff --git a/unison-src/transcripts/fix5055.output.md b/unison-src/transcripts/fix5055.output.md new file mode 100644 index 0000000000..f7c982029d --- /dev/null +++ b/unison-src/transcripts/fix5055.output.md @@ -0,0 +1,99 @@ +```ucm +.> builtins.merge + + Done. + +.> ls builtin + + 1. Any (builtin type) + 2. Any/ (2 terms) + 3. Boolean (builtin type) + 4. Boolean/ (1 term) + 5. Bytes (builtin type) + 6. Bytes/ (34 terms) + 7. Char (builtin type) + 8. Char/ (22 terms, 1 type) + 9. ClientSockAddr (builtin type) + 10. Code (builtin type) + 11. Code/ (9 terms) + 12. Debug/ (3 terms) + 13. Doc (type) + 14. Doc/ (6 terms) + 15. Either (type) + 16. Either/ (2 terms) + 17. Exception (type) + 18. Exception/ (1 term) + 19. Float (builtin type) + 20. Float/ (38 terms) + 21. Handle/ (1 term) + 22. ImmutableArray (builtin type) + 23. ImmutableArray/ (3 terms) + 24. ImmutableByteArray (builtin type) + 25. ImmutableByteArray/ (8 terms) + 26. Int (builtin type) + 27. Int/ (31 terms) + 28. IsPropagated (type) + 29. IsPropagated/ (1 term) + 30. IsTest (type) + 31. IsTest/ (1 term) + 32. Link (type) + 33. Link/ (3 terms, 2 types) + 34. List (builtin type) + 35. List/ (10 terms) + 36. ListenSocket (builtin type) + 37. MutableArray (builtin type) + 38. MutableArray/ (6 terms) + 39. MutableByteArray (builtin type) + 40. MutableByteArray/ (14 terms) + 41. Nat (builtin type) + 42. Nat/ (28 terms) + 43. Optional (type) + 44. Optional/ (2 terms) + 45. Pattern (builtin type) + 46. Pattern/ (9 terms) + 47. Ref (builtin type) + 48. Ref/ (2 terms) + 49. Request (builtin type) + 50. RewriteCase (type) + 51. RewriteCase/ (1 term) + 52. RewriteSignature (type) + 53. RewriteSignature/ (1 term) + 54. RewriteTerm (type) + 55. RewriteTerm/ (1 term) + 56. Rewrites (type) + 57. Rewrites/ (1 term) + 58. Scope (builtin type) + 59. Scope/ (6 terms) + 60. SeqView (type) + 61. SeqView/ (2 terms) + 62. Socket/ (1 term) + 63. Test/ (2 terms, 1 type) + 64. Text (builtin type) + 65. Text/ (34 terms) + 66. ThreadId/ (1 term) + 67. Tuple (type) + 68. Tuple/ (1 term) + 69. UDPSocket (builtin type) + 70. Unit (type) + 71. Unit/ (1 term) + 72. Universal/ (7 terms) + 73. Value (builtin type) + 74. Value/ (5 terms) + 75. bug (a -> b) + 76. crypto/ (17 terms, 2 types) + 77. io2/ (146 terms, 32 types) + 78. metadata/ (2 terms) + 79. todo (a -> b) + 80. unsafe/ (1 term) + +.> view 1 + +``` + + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + +Expected a hash-qualified name, but the numbered arg resulted in builtin.Any, which is an annotated symbol. From 8ef107817da3b8abc2f05fb1086a9c28288d929d Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 5 Jun 2024 10:58:54 -0600 Subject: [PATCH 093/631] Support `ShallowListEntry` in `InputPattern` handlers MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit These are produced by `ls`, but weren’t included in the handlers, so the results of `ls` weren’t usable as numbered args. Fixes #5055. --- .../src/Unison/Codebase/Editor/HandleInput.hs | 2 +- .../Codebase/Editor/StructuredArgument.hs | 4 +-- .../src/Unison/CommandLine/InputPatterns.hs | 32 +++++++++++++++++-- unison-src/transcripts/fix5055.output.md | 10 ++---- 4 files changed, 34 insertions(+), 14 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 9949ef7a42..c8a3fed40c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -695,7 +695,7 @@ loop e = do pathArgAbs <- Cli.resolvePath' pathArg entries <- liftIO (Backend.lsAtPath codebase Nothing pathArgAbs) - Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArg) entries + Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArgAbs) entries pped <- Cli.currentPrettyPrintEnvDecl let suffixifiedPPE = PPED.suffixifiedPPE pped -- This used to be a delayed action which only forced the loading of the root diff --git a/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs index eda42c6107..740fed6c14 100644 --- a/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs +++ b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs @@ -3,7 +3,7 @@ module Unison.Codebase.Editor.StructuredArgument where import GHC.Generics (Generic) import U.Codebase.HashTags (CausalHash) import Unison.Codebase.Editor.Input -import Unison.Codebase.Path (Path, Path') +import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' @@ -24,6 +24,6 @@ data StructuredArgument | Namespace CausalHash | NameWithBranchPrefix AbsBranchId Name | HashQualifiedWithBranchPrefix AbsBranchId (HQ'.HashQualified Name) - | ShallowListEntry Path' (ShallowListEntry Symbol Ann) + | ShallowListEntry Path.Absolute (ShallowListEntry Symbol Ann) | SearchResult (Maybe Path) SearchResult deriving (Eq, Generic, Show) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 78cb3d0914..b12fe817db 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -139,6 +139,7 @@ where import Control.Lens (preview, review) import Control.Lens.Cons qualified as Cons +import Data.Bitraversable (bitraverse) import Data.List (intercalate) import Data.List.Extra qualified as List import Data.List.NonEmpty qualified as NE @@ -180,7 +181,7 @@ import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.Codebase.Editor.UriParser (readRemoteNamespaceParser) import Unison.Codebase.Editor.UriParser qualified as UriParser -import Unison.Codebase.Path (Path, Path') +import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path import Unison.Codebase.PushBehavior qualified as PushBehavior @@ -250,7 +251,7 @@ formatStructuredArgument schLength = \case Left sch -> "#" <> SCH.toText sch <> ":" <> Name.toText (Name.makeAbsolute name) Right pathPrefix -> Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name) - entryToHQText :: Path' -> ShallowListEntry v Ann -> Text + entryToHQText :: Path.Absolute -> ShallowListEntry v Ann -> Text entryToHQText pathArg = fixup . \case ShallowTypeEntry te -> Backend.typeEntryDisplayName te @@ -283,6 +284,13 @@ showPatternHelp i = I.help i ] +shallowListEntryToHQ' :: ShallowListEntry v Ann -> HQ'.HashQualified Name +shallowListEntryToHQ' = \case + ShallowTermEntry termEntry -> Backend.termEntryHQName termEntry + ShallowTypeEntry typeEntry -> Backend.typeEntryHQName typeEntry + ShallowBranchEntry ns _ _ -> HQ'.fromName $ Name.fromSegment ns + ShallowPatchEntry ns -> HQ'.fromName $ Name.fromSegment ns + -- | restores the full hash to these search results, for _numberedArgs purposes searchResultToHQ :: Maybe Path -> SearchResult -> HQ.HashQualified Name searchResultToHQ oprefix = \case @@ -322,7 +330,7 @@ wrongStructuredArgument expected actual = SA.HashQualified _ -> "a hash-qualified name" SA.NameWithBranchPrefix _ _ -> "a name" SA.HashQualifiedWithBranchPrefix _ _ -> "a hash-qualified name" - SA.ShallowListEntry _ _ -> "an annotated symbol" + SA.ShallowListEntry _ _ -> "a name" SA.SearchResult _ _ -> "a search result" patternName :: InputPattern -> P.Pretty P.ColorText @@ -396,6 +404,8 @@ handleHashQualifiedNameArg = SA.HashQualified hqname -> pure hqname SA.HashQualifiedWithBranchPrefix mprefix hqname -> pure . HQ'.toHQ $ foldr (\prefix -> fmap $ Name.makeAbsolute . Path.prefixName prefix) hqname mprefix + SA.ShallowListEntry prefix entry -> + pure . HQ'.toHQ . fmap (Path.prefixName prefix) $ shallowListEntryToHQ' entry SA.SearchResult mpath result -> pure $ searchResultToHQ mpath result otherArgType -> Left $ wrongStructuredArgument "a hash-qualified name" otherArgType @@ -564,10 +574,13 @@ handleHashQualifiedSplit'Arg = either (first P.text . Path.parseHQSplit') \case + SA.Name name -> pure $ Path.hqSplitFromName' name hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit' name SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit' hqname SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . hq'NameToSplit' $ Name.makeAbsolute . Path.prefixName prefix <$> hqname + SA.ShallowListEntry prefix entry -> + pure . hq'NameToSplit' . fmap (Path.prefixName prefix) $ shallowListEntryToHQ' entry sr@(SA.SearchResult mpath result) -> first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit' $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg @@ -577,10 +590,19 @@ handleHashQualifiedSplitArg = either (first P.text . Path.parseHQSplit) \case + n@(SA.Name name) -> + bitraverse + ( \case + Path.AbsolutePath' _ -> Left $ expectedButActually "a relative name" n "an absolute name" + Path.RelativePath' p -> pure $ Path.unrelative p + ) + pure + $ Path.hqSplitFromName' name hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit name SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit hqname SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . hq'NameToSplit $ Name.makeAbsolute . Path.prefixName prefix <$> hqname + SA.ShallowListEntry _ entry -> pure . hq'NameToSplit $ shallowListEntryToHQ' entry sr@(SA.SearchResult mpath result) -> first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg @@ -603,6 +625,8 @@ handleShortHashOrHQSplit'Arg = SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure . pure $ hq'NameToSplit' hqname SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . pure $ hq'NameToSplit' (Name.makeAbsolute . Path.prefixName prefix <$> hqname) + SA.ShallowListEntry prefix entry -> + pure . pure . hq'NameToSplit' . fmap (Path.prefixName prefix) $ shallowListEntryToHQ' entry SA.SearchResult mpath result -> pure . hqNameToSplit' $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a hash or name" otherNumArg @@ -626,6 +650,8 @@ handleNameArg = SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . Name.makeAbsolute . Path.prefixName prefix $ HQ'.toName hqname + SA.ShallowListEntry prefix entry -> + pure . HQ'.toName . fmap (Path.prefixName prefix) $ shallowListEntryToHQ' entry SA.SearchResult mpath result -> maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg diff --git a/unison-src/transcripts/fix5055.output.md b/unison-src/transcripts/fix5055.output.md index f7c982029d..9a094f8e8a 100644 --- a/unison-src/transcripts/fix5055.output.md +++ b/unison-src/transcripts/fix5055.output.md @@ -88,12 +88,6 @@ .> view 1 -``` - - + -- builtin.Any is built-in. -🛑 - -The transcript failed due to an error in the stanza above. The error is: - -Expected a hash-qualified name, but the numbered arg resulted in builtin.Any, which is an annotated symbol. +``` From 4c12fe8a47ca30ef2b3d16933b919d1eee6034c0 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 5 Jun 2024 11:07:55 -0600 Subject: [PATCH 094/631] Make the transcript for #5055 more stable --- unison-src/transcripts/fix5055.md | 13 ++- unison-src/transcripts/fix5055.output.md | 118 +++++++---------------- 2 files changed, 48 insertions(+), 83 deletions(-) diff --git a/unison-src/transcripts/fix5055.md b/unison-src/transcripts/fix5055.md index 38a63838f8..a248a1d948 100644 --- a/unison-src/transcripts/fix5055.md +++ b/unison-src/transcripts/fix5055.md @@ -1,5 +1,16 @@ ```ucm .> builtins.merge -.> ls builtin +``` + +```unison +foo.add x y = x Int.+ y + +foo.subtract x y = x Int.- y +``` + +```ucm +.> add +.> ls foo .> view 1 ``` + diff --git a/unison-src/transcripts/fix5055.output.md b/unison-src/transcripts/fix5055.output.md index 9a094f8e8a..f6734da5a7 100644 --- a/unison-src/transcripts/fix5055.output.md +++ b/unison-src/transcripts/fix5055.output.md @@ -3,91 +3,45 @@ Done. -.> ls builtin +``` +```unison +foo.add x y = x Int.+ y + +foo.subtract x y = x Int.- y +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + foo.add : Int -> Int -> Int + foo.subtract : Int -> Int -> Int + +``` +```ucm +.> add + + ⍟ I've added these definitions: + + foo.add : Int -> Int -> Int + foo.subtract : Int -> Int -> Int + +.> ls foo - 1. Any (builtin type) - 2. Any/ (2 terms) - 3. Boolean (builtin type) - 4. Boolean/ (1 term) - 5. Bytes (builtin type) - 6. Bytes/ (34 terms) - 7. Char (builtin type) - 8. Char/ (22 terms, 1 type) - 9. ClientSockAddr (builtin type) - 10. Code (builtin type) - 11. Code/ (9 terms) - 12. Debug/ (3 terms) - 13. Doc (type) - 14. Doc/ (6 terms) - 15. Either (type) - 16. Either/ (2 terms) - 17. Exception (type) - 18. Exception/ (1 term) - 19. Float (builtin type) - 20. Float/ (38 terms) - 21. Handle/ (1 term) - 22. ImmutableArray (builtin type) - 23. ImmutableArray/ (3 terms) - 24. ImmutableByteArray (builtin type) - 25. ImmutableByteArray/ (8 terms) - 26. Int (builtin type) - 27. Int/ (31 terms) - 28. IsPropagated (type) - 29. IsPropagated/ (1 term) - 30. IsTest (type) - 31. IsTest/ (1 term) - 32. Link (type) - 33. Link/ (3 terms, 2 types) - 34. List (builtin type) - 35. List/ (10 terms) - 36. ListenSocket (builtin type) - 37. MutableArray (builtin type) - 38. MutableArray/ (6 terms) - 39. MutableByteArray (builtin type) - 40. MutableByteArray/ (14 terms) - 41. Nat (builtin type) - 42. Nat/ (28 terms) - 43. Optional (type) - 44. Optional/ (2 terms) - 45. Pattern (builtin type) - 46. Pattern/ (9 terms) - 47. Ref (builtin type) - 48. Ref/ (2 terms) - 49. Request (builtin type) - 50. RewriteCase (type) - 51. RewriteCase/ (1 term) - 52. RewriteSignature (type) - 53. RewriteSignature/ (1 term) - 54. RewriteTerm (type) - 55. RewriteTerm/ (1 term) - 56. Rewrites (type) - 57. Rewrites/ (1 term) - 58. Scope (builtin type) - 59. Scope/ (6 terms) - 60. SeqView (type) - 61. SeqView/ (2 terms) - 62. Socket/ (1 term) - 63. Test/ (2 terms, 1 type) - 64. Text (builtin type) - 65. Text/ (34 terms) - 66. ThreadId/ (1 term) - 67. Tuple (type) - 68. Tuple/ (1 term) - 69. UDPSocket (builtin type) - 70. Unit (type) - 71. Unit/ (1 term) - 72. Universal/ (7 terms) - 73. Value (builtin type) - 74. Value/ (5 terms) - 75. bug (a -> b) - 76. crypto/ (17 terms, 2 types) - 77. io2/ (146 terms, 32 types) - 78. metadata/ (2 terms) - 79. todo (a -> b) - 80. unsafe/ (1 term) + 1. add (Int -> Int -> Int) + 2. subtract (Int -> Int -> Int) .> view 1 - -- builtin.Any is built-in. + foo.add : Int -> Int -> Int + foo.add x y = + use Int + + x + y ``` From cf6ab11088cf4dd9874be4100067aba6f0b87193 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 5 Jun 2024 11:12:51 -0600 Subject: [PATCH 095/631] Ensure `Name`s are absolute after prefixing MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit In a separate part of the change this PR was extracted from, `Path.prefixName` ensures the result is absolute, but that is more involved than other changes here, so this uses the previous technique of calling `Name.makeAbsolute` afterward. I don’t think this changes anything important, but the `Name` _is_ always absolute after `Path.prefixName`, so this just ensures that it’s tracked. --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 8 ++++---- unison-src/transcripts/fix5055.output.md | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index b12fe817db..982894af9b 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -405,7 +405,7 @@ handleHashQualifiedNameArg = SA.HashQualifiedWithBranchPrefix mprefix hqname -> pure . HQ'.toHQ $ foldr (\prefix -> fmap $ Name.makeAbsolute . Path.prefixName prefix) hqname mprefix SA.ShallowListEntry prefix entry -> - pure . HQ'.toHQ . fmap (Path.prefixName prefix) $ shallowListEntryToHQ' entry + pure . HQ'.toHQ . fmap (Name.makeAbsolute . Path.prefixName prefix) $ shallowListEntryToHQ' entry SA.SearchResult mpath result -> pure $ searchResultToHQ mpath result otherArgType -> Left $ wrongStructuredArgument "a hash-qualified name" otherArgType @@ -580,7 +580,7 @@ handleHashQualifiedSplit'Arg = SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . hq'NameToSplit' $ Name.makeAbsolute . Path.prefixName prefix <$> hqname SA.ShallowListEntry prefix entry -> - pure . hq'NameToSplit' . fmap (Path.prefixName prefix) $ shallowListEntryToHQ' entry + pure . hq'NameToSplit' . fmap (Name.makeAbsolute . Path.prefixName prefix) $ shallowListEntryToHQ' entry sr@(SA.SearchResult mpath result) -> first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit' $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg @@ -626,7 +626,7 @@ handleShortHashOrHQSplit'Arg = SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . pure $ hq'NameToSplit' (Name.makeAbsolute . Path.prefixName prefix <$> hqname) SA.ShallowListEntry prefix entry -> - pure . pure . hq'NameToSplit' . fmap (Path.prefixName prefix) $ shallowListEntryToHQ' entry + pure . pure . hq'NameToSplit' . fmap (Name.makeAbsolute . Path.prefixName prefix) $ shallowListEntryToHQ' entry SA.SearchResult mpath result -> pure . hqNameToSplit' $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a hash or name" otherNumArg @@ -651,7 +651,7 @@ handleNameArg = SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> pure . Name.makeAbsolute . Path.prefixName prefix $ HQ'.toName hqname SA.ShallowListEntry prefix entry -> - pure . HQ'.toName . fmap (Path.prefixName prefix) $ shallowListEntryToHQ' entry + pure . HQ'.toName . fmap (Name.makeAbsolute . Path.prefixName prefix) $ shallowListEntryToHQ' entry SA.SearchResult mpath result -> maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg diff --git a/unison-src/transcripts/fix5055.output.md b/unison-src/transcripts/fix5055.output.md index f6734da5a7..b153ebc4dd 100644 --- a/unison-src/transcripts/fix5055.output.md +++ b/unison-src/transcripts/fix5055.output.md @@ -39,8 +39,8 @@ foo.subtract x y = x Int.- y .> view 1 - foo.add : Int -> Int -> Int - foo.add x y = + .foo.add : Int -> Int -> Int + .foo.add x y = use Int + x + y From 5ad808c9bdc5d7c24b2b0826a9e53c397dbc65a5 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 4 Jun 2024 10:09:02 -0700 Subject: [PATCH 096/631] Update MoveTerm, MoveType, MoveBranch --- .../src/Unison/Codebase/BranchUtil.hs | 9 ++++--- unison-cli/src/Unison/Cli/NamesUtils.hs | 9 +++++-- .../Codebase/Editor/HandleInput/MoveAll.hs | 6 ++--- .../Codebase/Editor/HandleInput/MoveBranch.hs | 25 +++++++++---------- .../Codebase/Editor/HandleInput/MoveTerm.hs | 4 +-- .../Codebase/Editor/HandleInput/MoveType.hs | 10 ++++---- .../src/Unison/Codebase/Editor/Propagate.hs | 4 +-- 7 files changed, 36 insertions(+), 31 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs index d0025cd87e..aff8f08c1b 100644 --- a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs +++ b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs @@ -26,6 +26,7 @@ import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.HashQualified' (HashQualified (HashQualified, NameOnly)) +import Unison.NameSegment (NameSegment) import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Prelude @@ -69,10 +70,10 @@ getBranch (p, seg) b = case Path.toList p of (Branch.head <$> Map.lookup h (b ^. Branch.children)) >>= getBranch (Path.fromList p, seg) -makeAddTermName :: Path.Split -> Referent -> (Path, Branch0 m -> Branch0 m) +makeAddTermName :: (p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m) makeAddTermName (p, name) r = (p, Branch.addTermName r name) -makeDeleteTermName :: Path.Split -> Referent -> (Path, Branch0 m -> Branch0 m) +makeDeleteTermName :: (p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m) makeDeleteTermName (p, name) r = (p, Branch.deleteTermName r name) makeAnnihilateTermName :: Path.Split -> (Path, Branch0 m -> Branch0 m) @@ -81,10 +82,10 @@ makeAnnihilateTermName (p, name) = (p, Branch.annihilateTermName name) makeAnnihilateTypeName :: Path.Split -> (Path, Branch0 m -> Branch0 m) makeAnnihilateTypeName (p, name) = (p, Branch.annihilateTypeName name) -makeAddTypeName :: Path.Split -> Reference -> (Path, Branch0 m -> Branch0 m) +makeAddTypeName :: (p, NameSegment) -> Reference -> (p, Branch0 m -> Branch0 m) makeAddTypeName (p, name) r = (p, Branch.addTypeName r name) -makeDeleteTypeName :: Path.Split -> Reference -> (Path, Branch0 m -> Branch0 m) +makeDeleteTypeName :: (p, NameSegment) -> Reference -> (p, Branch0 m -> Branch0 m) makeDeleteTypeName (p, name) r = (p, Branch.deleteTypeName r name) makeSetBranch :: Path.Split -> Branch m -> (Path, Branch0 m -> Branch0 m) diff --git a/unison-cli/src/Unison/Cli/NamesUtils.hs b/unison-cli/src/Unison/Cli/NamesUtils.hs index 8e36020459..0c8e5c1060 100644 --- a/unison-cli/src/Unison/Cli/NamesUtils.hs +++ b/unison-cli/src/Unison/Cli/NamesUtils.hs @@ -1,15 +1,20 @@ -- | Utilities that have to do with constructing names objects. module Unison.Cli.NamesUtils ( currentNames, + projectRootNames, ) where import Unison.Cli.Monad (Cli) -import Unison.Cli.MonadUtils (getCurrentBranch0) +import Unison.Cli.MonadUtils qualified as Cli import Unison.Codebase.Branch.Names qualified as Branch import Unison.Names (Names) -- | Produce a 'Names' object which contains names for the current branch. currentNames :: Cli Names currentNames = do - Branch.toNames <$> getCurrentBranch0 + Branch.toNames <$> Cli.getCurrentBranch0 + +projectRootNames :: Cli Names +projectRootNames = do + Branch.toNames <$> Cli.getCurrentProjectRoot0 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs index 77b4bc8514..49d525011d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs @@ -11,9 +11,9 @@ import Unison.Codebase.Path qualified as Path import Unison.HashQualified' qualified as HQ' import Unison.Prelude -handleMoveAll :: Bool -> Path.Path' -> Path.Path' -> Text -> Cli () -handleMoveAll hasConfirmed src' dest' description = do - moveBranchFunc <- moveBranchFunc hasConfirmed src' dest' +handleMoveAll :: Path.Path' -> Path.Path' -> Text -> Cli () +handleMoveAll src' dest' description = do + moveBranchFunc <- moveBranchFunc src' dest' moveTermTypeSteps <- case (,) <$> Path.toSplit' src' <*> Path.toSplit' dest' of Nothing -> pure [] Just (fmap HQ'.NameOnly -> src, dest) -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs index ad34073506..58e8e1a342 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs @@ -7,17 +7,16 @@ import Unison.Codebase.Branch (Branch) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Output (Output (..)) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Prelude -moveBranchFunc :: Bool -> Path.Path' -> Path.Path' -> Cli (Maybe (Path.Absolute, Branch IO -> Branch IO)) -moveBranchFunc hasConfirmed src' dest' = do - srcAbs <- Cli.resolvePath' src' - destAbs <- Cli.resolvePath' dest' +moveBranchFunc :: Path.Path' -> Path.Path' -> Cli (Maybe (PP.ProjectPath, Branch IO -> Branch IO)) +moveBranchFunc src' dest' = do + -- We currently only support moving within the same project branch. + srcPP@(PP.ProjectPath proj projBranch srcAbs) <- Cli.resolvePath' src' + PP.ProjectPath _ _ destAbs <- Cli.resolvePath' dest' destBranchExists <- Cli.branchExistsAtPath' dest' - let isRootMove = (Path.isRoot srcAbs || Path.isRoot destAbs) - when (isRootMove && not hasConfirmed) do - Cli.returnEarly MoveRootBranchConfirmation - Cli.getMaybeBranchFromProjectRootPath srcAbs >>= traverse \srcBranch -> do + Cli.getMaybeBranchFromProjectPath srcPP >>= traverse \srcBranch -> do -- We want the move to appear as a single step in the root namespace, but we need to make -- surgical changes in both the root and the destination, so we make our modifications at the shared parent of -- those changes such that they appear as a single change in the root. @@ -26,16 +25,16 @@ moveBranchFunc hasConfirmed src' dest' = do changeRoot & Branch.modifyAt srcLoc (const Branch.empty) & Branch.modifyAt destLoc (const srcBranch) - if (destBranchExists && not isRootMove) + if destBranchExists then Cli.respond (MovedOverExistingBranch dest') else pure () - pure (Path.Absolute changeRootPath, doMove) + pure (PP.ProjectPath proj projBranch $ Path.Absolute changeRootPath, doMove) -- | Moves a branch and its history from one location to another, and saves the new root -- branch. -doMoveBranch :: Text -> Bool -> Path.Path' -> Path.Path' -> Cli () -doMoveBranch actionDescription hasConfirmed src' dest' = do - moveBranchFunc hasConfirmed src' dest' >>= \case +doMoveBranch :: Text -> Path.Path' -> Path.Path' -> Cli () +doMoveBranch actionDescription src' dest' = do + moveBranchFunc src' dest' >>= \case Nothing -> Cli.respond (BranchNotFound src') Just (path, func) -> do _ <- Cli.updateAt actionDescription path func diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs index 86a5fa56aa..4ea6aa3489 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs @@ -1,6 +1,6 @@ module Unison.Codebase.Editor.HandleInput.MoveTerm (doMoveTerm, moveTermSteps) where -import Control.Lens (_2) +import Control.Lens (_1, _2) import Data.Set qualified as Set import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -34,7 +34,7 @@ moveTermSteps src' dest' = do pure [ -- Mitchell: throwing away any hash-qualification here seems wrong! BranchUtil.makeDeleteTermName (over _2 HQ'.toName p) srcTerm, - BranchUtil.makeAddTermName (Path.convert dest) srcTerm + BranchUtil.makeAddTermName (over _1 (view PP.absPath_) dest) srcTerm ] doMoveTerm :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli () diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs index 9800dd1946..c4ff4a5a01 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs @@ -1,6 +1,6 @@ module Unison.Codebase.Editor.HandleInput.MoveType (doMoveType, moveTypeSteps) where -import Control.Lens (_2) +import Control.Lens (_1, _2) import Data.Set qualified as Set import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -9,14 +9,14 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path (Path, Path') +import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.HashQualified' qualified as HQ' import Unison.NameSegment (NameSegment) import Unison.Prelude -moveTypeSteps :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Cli [(Path, Branch0 m -> Branch0 m)] +moveTypeSteps :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Cli [(Path.Absolute, Branch0 m -> Branch0 m)] moveTypeSteps src' dest' = do src <- Cli.resolveSplit' src' srcTypes <- Cli.getTypesAt src @@ -30,11 +30,11 @@ moveTypeSteps src' dest' = do destTypes <- Cli.getTypesAt (Path.convert dest) when (not (Set.null destTypes)) do Cli.returnEarly (Output.TypeAlreadyExists dest' destTypes) - let p = over _1 (view PP.path_) src + let p = over _1 (view PP.absPath_) src pure [ -- Mitchell: throwing away any hash-qualification here seems wrong! BranchUtil.makeDeleteTypeName (over _2 HQ'.toName p) srcType, - BranchUtil.makeAddTypeName (over _1 (view PP.path_) dest) srcType + BranchUtil.makeAddTypeName (over _1 (view PP.absPath_) dest) srcType ] doMoveType :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli () diff --git a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs index 7183bad84c..8e847190a6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs @@ -14,7 +14,7 @@ import U.Codebase.Reference qualified as Reference import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.NamesUtils qualified as Cli import Unison.Cli.TypeCheck qualified as Cli (computeTypecheckingEnvironment) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase @@ -241,7 +241,7 @@ propagate patch b = case validatePatch patch of pure noEdits Just (initialTermEdits, initialTypeEdits) -> do -- TODO: this can be removed once patches have term replacement of type `Referent -> Referent` - rootNames <- Branch.toNames <$> Cli.getProjectRoot0 + rootNames <- Cli.projectRootNames let -- TODO: these are just used for tracing, could be deleted if we don't care -- about printing meaningful names for definitions during propagation, or if From ce1c221bb02fc825347286ce036cc09d1461a746 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 5 Jun 2024 13:51:01 -0700 Subject: [PATCH 097/631] Fixup MoveAll --- unison-cli/src/Unison/Cli/MonadUtils.hs | 14 +++++++------- .../Unison/Codebase/Editor/HandleInput/MoveAll.hs | 3 ++- .../Codebase/Editor/HandleInput/MoveBranch.hs | 13 ++++++++----- 3 files changed, 17 insertions(+), 13 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 5fa5e4c601..52828233c7 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -108,7 +108,7 @@ import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path (Path, Path' (..)) import Unison.Codebase.Path qualified as Path -import Unison.Codebase.ProjectPath (ProjectPath, ProjectPathG (..)) +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH @@ -478,18 +478,18 @@ updateAt reason p f = do updateAtM reason p (pure . f) updateAndStepAt :: - (Foldable f, Foldable g) => + (Foldable f, Foldable g, Functor g) => Text -> + ProjectBranch -> f (Path.Absolute, Branch IO -> Branch IO) -> - g (Path, Branch0 IO -> Branch0 IO) -> + g (Path.Absolute, Branch0 IO -> Branch0 IO) -> Cli () -updateAndStepAt reason updates steps = do +updateAndStepAt reason projectBranch updates steps = do let f b = b & (\root -> foldl' (\b (Path.Absolute p, f) -> Branch.modifyAt p f b) root updates) - & (Branch.stepManyAt steps) - ProjectPath _ projBranch _ <- getCurrentProjectPath - updateProjectBranchRoot reason projBranch f + & (Branch.stepManyAt (first Path.unabsolute <$> steps)) + updateProjectBranchRoot reason projectBranch f updateCurrentProjectBranchRoot :: Text -> (Branch IO -> Branch IO) -> Cli () updateCurrentProjectBranchRoot reason f = do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs index 49d525011d..69b435529e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs @@ -23,5 +23,6 @@ handleMoveAll src' dest' description = do case (moveBranchFunc, moveTermTypeSteps) of (Nothing, []) -> Cli.respond (Output.MoveNothingFound src') (mupdates, steps) -> do - Cli.updateAndStepAt description (maybeToList mupdates) steps + pp <- Cli.getCurrentProjectPath + Cli.updateAndStepAt description (pp ^. #branch) (maybeToList mupdates) steps Cli.respond Output.Success diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs index 58e8e1a342..dc5b31cf80 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs @@ -10,10 +10,12 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.Prelude -moveBranchFunc :: Path.Path' -> Path.Path' -> Cli (Maybe (PP.ProjectPath, Branch IO -> Branch IO)) +-- | Note: Currently only allows moving within the same project-branch, should be easy to change in the future if +-- needed. +moveBranchFunc :: Path.Path' -> Path.Path' -> Cli (Maybe (Path.Absolute, Branch IO -> Branch IO)) moveBranchFunc src' dest' = do -- We currently only support moving within the same project branch. - srcPP@(PP.ProjectPath proj projBranch srcAbs) <- Cli.resolvePath' src' + srcPP@(PP.ProjectPath _proj _projBranch srcAbs) <- Cli.resolvePath' src' PP.ProjectPath _ _ destAbs <- Cli.resolvePath' dest' destBranchExists <- Cli.branchExistsAtPath' dest' Cli.getMaybeBranchFromProjectPath srcPP >>= traverse \srcBranch -> do @@ -28,7 +30,7 @@ moveBranchFunc src' dest' = do if destBranchExists then Cli.respond (MovedOverExistingBranch dest') else pure () - pure (PP.ProjectPath proj projBranch $ Path.Absolute changeRootPath, doMove) + pure (Path.Absolute changeRootPath, doMove) -- | Moves a branch and its history from one location to another, and saves the new root -- branch. @@ -36,6 +38,7 @@ doMoveBranch :: Text -> Path.Path' -> Path.Path' -> Cli () doMoveBranch actionDescription src' dest' = do moveBranchFunc src' dest' >>= \case Nothing -> Cli.respond (BranchNotFound src') - Just (path, func) -> do - _ <- Cli.updateAt actionDescription path func + Just (absPath, func) -> do + pp <- Cli.resolvePath' (Path.AbsolutePath' absPath) + _ <- Cli.updateAt actionDescription pp func Cli.respond Success From a46321faa463c018627f59468820c0ce43b470f0 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 5 Jun 2024 14:08:53 -0700 Subject: [PATCH 098/631] Fix up Branch.hs module --- .../src/Unison/Codebase/Editor/HandleInput/Branch.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 4da27dca65..1533d56ec6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -100,16 +100,16 @@ createBranchFromParent mayParentBranch project newBranchName = do -- `bar`, so the fork will succeed. newBranchId <- Sqlite.unsafeIO (ProjectBranchId <$> UUID.nextRandom) newBranchCausalHashId <- - (ProjectBranch.causalHashId <$> mayParentBranch) `whenNothing` do + (for mayParentBranch (\ProjectBranch {projectId, branchId} -> Q.expectProjectBranchHead projectId branchId)) `whenNothingM` do (_, causalHashId) <- Codebase.emptyCausalHash pure causalHashId Queries.insertProjectBranch + newBranchCausalHashId Sqlite.ProjectBranch { projectId, branchId = newBranchId, name = newBranchName, - parentBranchId = ProjectBranch.branchId <$> mayParentBranch, - causalHashId = newBranchCausalHashId + parentBranchId = ProjectBranch.branchId <$> mayParentBranch } pure newBranchId @@ -131,12 +131,12 @@ createBranchFromNamespace project getBranchName branch = do newProjectBranchId <- Sqlite.unsafeIO (ProjectBranchId <$> UUID.nextRandom) newBranchCausalHashId <- Q.expectCausalHashIdByCausalHash causalHash Queries.insertProjectBranch + newBranchCausalHashId Sqlite.ProjectBranch { projectId, branchId = newProjectBranchId, name = branchName, - parentBranchId = Nothing, - causalHashId = newBranchCausalHashId + parentBranchId = Nothing } pure newProjectBranchId From 0016706d1eb5861f1433196968081a80f580c30d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 5 Jun 2024 14:12:57 -0700 Subject: [PATCH 099/631] Pull cleanup --- .../Codebase/Editor/HandleInput/Pull.hs | 70 +++++++++---------- 1 file changed, 32 insertions(+), 38 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index 6165d60bc3..8ff8861dc1 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -41,6 +41,7 @@ import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.InputPattern qualified as InputPattern import Unison.CommandLine.InputPatterns qualified as InputPatterns import Unison.NameSegment qualified as NameSegment @@ -76,8 +77,7 @@ handlePull unresolvedSourceAndTarget pullMode = do when remoteBranchIsEmpty (Cli.respond (PulledEmptyBranch source)) - let targetAbsolutePath = - ProjectUtils.projectBranchPath (ProjectAndBranch target.project.projectId target.branch.branchId) + let targetProjectPath = PP.projectBranchRoot (ProjectAndBranch target.project target.branch) let description = Text.unwords @@ -92,9 +92,9 @@ handlePull unresolvedSourceAndTarget pullMode = do case pullMode of Input.PullWithHistory -> do - targetBranchObject <- Cli.getBranch0At targetAbsolutePath + targetBranch <- Cli.getBranchFromProjectPath targetProjectPath - if Branch.isEmpty0 targetBranchObject + if Branch.isEmpty0 $ Branch.head targetBranchObject then do Cli.Env {codebase} <- ask remoteBranchObject <- liftIO (Codebase.expectBranchForHash codebase remoteCausalHash) @@ -103,11 +103,7 @@ handlePull unresolvedSourceAndTarget pullMode = do else do Cli.respond AboutToMerge - aliceCausalHash <- - Cli.runTransaction do - causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute targetAbsolutePath) - pure causal.causalHash - + let aliceCausalHash = Branch.headHash targetBranch lcaCausalHash <- Cli.runTransaction (Operations.lca aliceCausalHash remoteCausalHash) doMerge @@ -167,30 +163,29 @@ resolveSourceAndTarget includeSquashed = \case pure (source, target) resolveImplicitSource :: Share.IncludeSquashedHead -> Cli (ReadRemoteNamespace Share.RemoteProjectBranch) -resolveImplicitSource includeSquashed = - ProjectUtils.getCurrentProjectBranch >>= \case - Nothing -> RemoteRepo.writeNamespaceToRead <$> resolveConfiguredUrl PushPull.Pull Path.currentPath - Just (localProjectAndBranch, _restPath) -> do - (remoteProjectId, remoteProjectName, remoteBranchId, remoteBranchName) <- - Cli.runTransactionWithRollback \rollback -> do - let localProjectId = localProjectAndBranch.project.projectId - let localBranchId = localProjectAndBranch.branch.branchId - Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId >>= \case - Just (remoteProjectId, Just remoteBranchId) -> do - remoteProjectName <- Queries.expectRemoteProjectName remoteProjectId Share.hardCodedUri - remoteBranchName <- - Queries.expectRemoteProjectBranchName - Share.hardCodedUri - remoteProjectId - remoteBranchId - pure (remoteProjectId, remoteProjectName, remoteBranchId, remoteBranchName) - _ -> rollback (Output.NoAssociatedRemoteProjectBranch Share.hardCodedUri localProjectAndBranch) - remoteBranch <- - ProjectUtils.expectRemoteProjectBranchById includeSquashed $ - ProjectAndBranch - (remoteProjectId, remoteProjectName) - (remoteBranchId, remoteBranchName) - pure (ReadShare'ProjectBranch remoteBranch) +resolveImplicitSource includeSquashed = do + pp <- Cli.getCurrentProjectPath + let localProjectAndBranch = pp ^. PP.asProjectAndBranch_ + (remoteProjectId, remoteProjectName, remoteBranchId, remoteBranchName) <- + Cli.runTransactionWithRollback \rollback -> do + let localProjectId = localProjectAndBranch.project.projectId + let localBranchId = localProjectAndBranch.branch.branchId + Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId >>= \case + Just (remoteProjectId, Just remoteBranchId) -> do + remoteProjectName <- Queries.expectRemoteProjectName remoteProjectId Share.hardCodedUri + remoteBranchName <- + Queries.expectRemoteProjectBranchName + Share.hardCodedUri + remoteProjectId + remoteBranchId + pure (remoteProjectId, remoteProjectName, remoteBranchId, remoteBranchName) + _ -> rollback (Output.NoAssociatedRemoteProjectBranch Share.hardCodedUri localProjectAndBranch) + remoteBranch <- + ProjectUtils.expectRemoteProjectBranchById includeSquashed $ + ProjectAndBranch + (remoteProjectId, remoteProjectName) + (remoteBranchId, remoteBranchName) + pure (ReadShare'ProjectBranch remoteBranch) resolveExplicitSource :: Share.IncludeSquashedHead -> @@ -208,7 +203,7 @@ resolveExplicitSource includeSquashed = \case (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName) pure (ReadShare'ProjectBranch remoteProjectBranch) ReadShare'ProjectBranch (That branchNameOrLatestRelease) -> do - (localProjectAndBranch, _restPath) <- ProjectUtils.expectCurrentProjectBranch + localProjectAndBranch <- view PP.asProjectAndBranch_ <$> Cli.getCurrentProjectPath let localProjectId = localProjectAndBranch.project.projectId let localBranchId = localProjectAndBranch.branch.branchId Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case @@ -243,8 +238,7 @@ resolveExplicitSource includeSquashed = \case resolveImplicitTarget :: Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) resolveImplicitTarget = do - (projectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch - pure projectAndBranch + view PP.asProjectAndBranch_ <$> Cli.getCurrentProjectPath -- | supply `dest0` if you want to print diff messages -- supply unchangedMessage if you want to display it if merge had no effect @@ -253,8 +247,8 @@ mergeBranchAndPropagateDefaultPatch :: Text -> Maybe Output -> Branch IO -> - Maybe (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) -> - Path.Absolute -> + Maybe (Either PP.ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) -> + PP.ProjectPath -> Cli () mergeBranchAndPropagateDefaultPatch mode inputDescription unchangedMessage srcb maybeDest0 dest = ifM From 0799264b540f6bebe07cd16dab1eb5d98d7a189b Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 5 Jun 2024 14:38:14 -0700 Subject: [PATCH 100/631] Remove NoSync primitive usages in Update/Propagate --- .../Codebase/Editor/HandleInput/Update.hs | 63 +++++++++++-------- .../src/Unison/Codebase/Editor/Propagate.hs | 11 ++-- 2 files changed, 41 insertions(+), 33 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs index b6bb301056..1f2538891a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs @@ -22,6 +22,7 @@ import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Branch.Names as Branch import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Input import Unison.Codebase.Editor.Output @@ -171,37 +172,46 @@ handleUpdate input optionalPatch requestedNames = do pure (updatePatch ye'ol'Patch, updatePatches, p) when (Slurp.hasAddsOrUpdates sr) $ do - -- take a look at the `updates` from the SlurpResult - -- and make a patch diff to record a replacement from the old to new references - Cli.stepManyAtMNoSync - ( [ ( Path.unabsolute currentPath', - pure . doSlurpUpdates typeEdits termEdits termDeprecations - ), - ( Path.unabsolute currentPath', - pure . doSlurpAdds addsAndUpdates (Slurp.originalFile sr) - ) - ] - ++ case patchOps of - Nothing -> [] - Just (_, update, p) -> [(Path.unabsolute p, update)] - ) + -- First add the new definitions to the codebase Cli.runTransaction . Codebase.addDefsToCodebase codebase . Slurp.filterUnisonFile sr $ Slurp.originalFile sr + currentBranch <- Cli.getCurrentBranch + -- take a look at the `updates` from the SlurpResult + -- and make a patch diff to record a replacement from the old to new references + updatedBranch <- + currentBranch + & Branch.stepManyAtM + ( [ ( Path.unabsolute currentPath', + pure . doSlurpUpdates typeEdits termEdits termDeprecations + ), + ( Path.unabsolute currentPath', + pure . doSlurpAdds addsAndUpdates (Slurp.originalFile sr) + ) + ] + ++ case patchOps of + Nothing -> [] + Just (_, update, p) -> [(Path.unabsolute p, update)] + ) + & liftIO + let codebaseAndFileNames = UF.addNamesFromTypeCheckedUnisonFile (Slurp.originalFile sr) currentCodebaseNames pped <- Cli.prettyPrintEnvDeclFromNames codebaseAndFileNames let suffixifiedPPE = PPE.suffixifiedPPE pped Cli.respond $ SlurpOutput input suffixifiedPPE sr - whenJust patchOps \(updatedPatch, _, _) -> - void $ propagatePatchNoSync updatedPatch currentPath' - Cli.syncRoot case patchPath of - Nothing -> "update.nopatch" - Just p -> - p - & Path.unsplit' - & Path.resolve @_ @_ @Path.Absolute currentPath' - & tShow + branchWithPropagatedPatch <- case patchOps of + Nothing -> pure updatedBranch + Just (updatedPatch, _, _) -> do + propagatePatch updatedPatch (Path.unabsolute currentPath') updatedBranch + let description = case patchPath of + Nothing -> "update.nopatch" + Just p -> + p + & Path.unsplit' + & Path.resolve @_ @_ @Path.Absolute currentPath' + & tShow + Cli.updateRoot branchWithPropagatedPatch description getSlurpResultForUpdate :: Set Name -> Names -> Cli SlurpResult getSlurpResultForUpdate requestedNames slurpCheckNames = do @@ -646,10 +656,11 @@ doSlurpUpdates typeEdits termEdits deprecated b0 = split = Path.splitFromName n -- Returns True if the operation changed the namespace, False otherwise. -propagatePatchNoSync :: Patch -> Path.Absolute -> Cli Bool -propagatePatchNoSync patch scopePath = +propagatePatch :: Patch -> Path.Path -> Branch.Branch IO -> Cli (Branch.Branch IO) +propagatePatch patch scopePath b = do Cli.time "propagatePatchNoSync" do - Cli.stepAtNoSync' (Path.unabsolute scopePath, Propagate.propagateAndApply patch) + let names = Branch.toNames $ Branch.head b + Branch.stepManyAtM [(scopePath, Propagate.propagateAndApply names patch)] b recomponentize :: [(Reference.Id, a)] -> [(Hash, [a])] recomponentize = diff --git a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs index f1bf65962c..813a6110ad 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs @@ -14,7 +14,6 @@ import U.Codebase.Reference qualified as Reference import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.TypeCheck qualified as Cli (computeTypecheckingEnvironment) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase @@ -82,10 +81,11 @@ noEdits :: Edits v noEdits = Edits mempty mempty mempty mempty mempty mempty mempty propagateAndApply :: + Names -> Patch -> Branch0 IO -> Cli (Branch0 IO) -propagateAndApply patch branch = do +propagateAndApply rootNames patch branch = do edits <- propagate patch branch let f = applyPropagate patch edits (pure . f . applyDeprecations patch) branch @@ -234,15 +234,12 @@ debugMode = False -- -- "dirty" means in need of update -- "frontier" means updated definitions responsible for the "dirty" -propagate :: Patch -> Branch0 IO -> Cli (Edits Symbol) -propagate patch b = case validatePatch patch of +propagate :: Names -> Patch -> Branch0 IO -> Cli (Edits Symbol) +propagate rootNames patch b = case validatePatch patch of Nothing -> do Cli.respond PatchNeedsToBeConflictFree pure noEdits Just (initialTermEdits, initialTypeEdits) -> do - -- TODO: this can be removed once patches have term replacement of type `Referent -> Referent` - rootNames <- Branch.toNames <$> Cli.getRootBranch0 - let -- TODO: these are just used for tracing, could be deleted if we don't care -- about printing meaningful names for definitions during propagation, or if -- we want to just remove the tracing. From 07f877481fa14ba07e042da2cbaee44600547bd2 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 5 Jun 2024 14:38:14 -0700 Subject: [PATCH 101/631] Remove nosync usages from AddRun --- unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs | 4 ++-- unison-cli/src/Unison/Codebase/Editor/Propagate.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs index e9d396cb29..7d24986d27 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs @@ -41,12 +41,12 @@ handleAddRun input resultName = do currentNames <- Cli.currentNames let sr = Slurp.slurpFile uf (Set.singleton resultVar) Slurp.AddOp currentNames let adds = SlurpResult.adds sr - Cli.stepAtNoSync (Path.unabsolute currentPath, doSlurpAdds adds uf) Cli.runTransaction . Codebase.addDefsToCodebase codebase . SlurpResult.filterUnisonFile sr $ uf + let description = (Text.pack (InputPattern.patternName InputPatterns.saveExecuteResult) <> " " <> Name.toText resultName) + Cli.stepAt description (Path.unabsolute currentPath, doSlurpAdds adds uf) let namesWithDefinitionsFromFile = UF.addNamesFromTypeCheckedUnisonFile uf currentNames pped <- Cli.prettyPrintEnvDeclFromNames namesWithDefinitionsFromFile let suffixifiedPPE = PPE.suffixifiedPPE pped - Cli.syncRoot (Text.pack (InputPattern.patternName InputPatterns.saveExecuteResult) <> " " <> Name.toText resultName) Cli.respond $ SlurpOutput input suffixifiedPPE sr addSavedTermToUnisonFile :: Name -> Cli (TypecheckedUnisonFile Symbol Ann) diff --git a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs index 813a6110ad..abea3e9901 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs @@ -86,7 +86,7 @@ propagateAndApply :: Branch0 IO -> Cli (Branch0 IO) propagateAndApply rootNames patch branch = do - edits <- propagate patch branch + edits <- propagate rootNames patch branch let f = applyPropagate patch edits (pure . f . applyDeprecations patch) branch From 14bd8018b37a9669e9e64e032baf46fd323dc3eb Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 5 Jun 2024 14:38:14 -0700 Subject: [PATCH 102/631] Remove NoSync primitive usages --- unison-cli/src/Unison/Codebase/Editor/HandleInput.hs | 3 +-- unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs | 4 +++- unison-cli/src/Unison/Codebase/Editor/Propagate.hs | 1 + 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 9949ef7a42..a52c5b4e21 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -719,12 +719,11 @@ loop e = do currentNames <- Branch.toNames <$> Cli.getCurrentBranch0 let sr = Slurp.slurpFile uf vars Slurp.AddOp currentNames let adds = SlurpResult.adds sr - Cli.stepAtNoSync (Path.unabsolute currentPath, doSlurpAdds adds uf) Cli.runTransaction . Codebase.addDefsToCodebase codebase . SlurpResult.filterUnisonFile sr $ uf + Cli.stepAt description (Path.unabsolute currentPath, doSlurpAdds adds uf) pped <- Cli.prettyPrintEnvDeclFromNames $ UF.addNamesFromTypeCheckedUnisonFile uf currentNames let suffixifiedPPE = PPED.suffixifiedPPE pped Cli.respond $ SlurpOutput input suffixifiedPPE sr - Cli.syncRoot description SaveExecuteResultI resultName -> handleAddRun input resultName PreviewAddI requestedNames -> do (sourceName, _) <- Cli.expectLatestFile diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index 6165d60bc3..890ad66463 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -28,6 +28,7 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch (..)) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Merge qualified as Branch +import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.HandleInput.Merge2 (AliceMergeInfo (..), BobMergeInfo (..), LcaMergeInfo (..), MergeInfo (..), doMerge) import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper) import Unison.Codebase.Editor.Input @@ -301,6 +302,7 @@ propagatePatch :: Cli Bool propagatePatch inputDescription patch scopePath = do Cli.time "propagatePatch" do + rootNames <- Branch.toNames <$> Cli.getRootBranch0 Cli.stepAt' (inputDescription <> " (applying patch)") - (Path.unabsolute scopePath, Propagate.propagateAndApply patch) + (Path.unabsolute scopePath, Propagate.propagateAndApply rootNames patch) diff --git a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs index abea3e9901..5864517034 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs @@ -240,6 +240,7 @@ propagate rootNames patch b = case validatePatch patch of Cli.respond PatchNeedsToBeConflictFree pure noEdits Just (initialTermEdits, initialTypeEdits) -> do + -- TODO: this can be removed once patches have term replacement of type `Referent -> Referent` let -- TODO: these are just used for tracing, could be deleted if we don't care -- about printing meaningful names for definitions during propagation, or if -- we want to just remove the tracing. From 8b5859c798983bcaf9c10a8f39f06227e72bf106 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 5 Jun 2024 14:38:14 -0700 Subject: [PATCH 103/631] Remove NoSync primitives --- unison-cli/src/Unison/Cli/MonadUtils.hs | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 5aa583ee4c..c814815a04 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -43,11 +43,7 @@ module Unison.Cli.MonadUtils stepAt', stepAt, stepAtM, - stepAtNoSync', - stepAtNoSync, stepManyAt, - stepManyAtMNoSync, - stepManyAtNoSync, syncRoot, updateRoot, updateAtM, @@ -351,16 +347,6 @@ stepAt' :: Cli Bool stepAt' cause = stepManyAt' @[] cause . pure -stepAtNoSync' :: - (Path, Branch0 IO -> Cli (Branch0 IO)) -> - Cli Bool -stepAtNoSync' = stepManyAtNoSync' @[] . pure - -stepAtNoSync :: - (Path, Branch0 IO -> Branch0 IO) -> - Cli () -stepAtNoSync = stepManyAtNoSync @[] . pure - stepAtM :: Text -> (Path, Branch0 IO -> IO (Branch0 IO)) -> From 87bd96963e58e673abf3f93d5f9b982813df82c3 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 5 Jun 2024 15:08:05 -0700 Subject: [PATCH 104/631] Inline nosync versions into their regular forms so people aren't tempted to use them. --- unison-cli/src/Unison/Cli/MonadUtils.hs | 30 +- ...ability-term-conflicts-on-update.output.md | 5 +- .../transcripts/cycle-update-5.output.md | 6 +- .../transcripts/diff-namespace.output.md | 390 +----------------- unison-src/transcripts/fix2254.output.md | 150 +------ unison-src/transcripts/propagate.output.md | 179 +------- unison-src/transcripts/todo.output.md | 252 +---------- 7 files changed, 42 insertions(+), 970 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index c814815a04..72fba2adce 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -44,6 +44,7 @@ module Unison.Cli.MonadUtils stepAt, stepAtM, stepManyAt, + stepManyAtM, syncRoot, updateRoot, updateAtM, @@ -359,7 +360,7 @@ stepManyAt :: f (Path, Branch0 IO -> Branch0 IO) -> Cli () stepManyAt reason actions = do - stepManyAtNoSync actions + void . modifyRootBranch $ Branch.stepManyAt actions syncRoot reason stepManyAt' :: @@ -368,45 +369,22 @@ stepManyAt' :: f (Path, Branch0 IO -> Cli (Branch0 IO)) -> Cli Bool stepManyAt' reason actions = do - res <- stepManyAtNoSync' actions - syncRoot reason - pure res - -stepManyAtNoSync' :: - (Foldable f) => - f (Path, Branch0 IO -> Cli (Branch0 IO)) -> - Cli Bool -stepManyAtNoSync' actions = do origRoot <- getRootBranch newRoot <- Branch.stepManyAtM actions origRoot setRootBranch newRoot + syncRoot reason pure (origRoot /= newRoot) --- Like stepManyAt, but doesn't update the last saved root -stepManyAtNoSync :: - (Foldable f) => - f (Path, Branch0 IO -> Branch0 IO) -> - Cli () -stepManyAtNoSync actions = - void . modifyRootBranch $ Branch.stepManyAt actions - stepManyAtM :: (Foldable f) => Text -> f (Path, Branch0 IO -> IO (Branch0 IO)) -> Cli () stepManyAtM reason actions = do - stepManyAtMNoSync actions - syncRoot reason - -stepManyAtMNoSync :: - (Foldable f) => - f (Path, Branch0 IO -> IO (Branch0 IO)) -> - Cli () -stepManyAtMNoSync actions = do oldRoot <- getRootBranch newRoot <- liftIO (Branch.stepManyAtM actions oldRoot) setRootBranch newRoot + syncRoot reason -- | Sync the in-memory root branch. syncRoot :: Text -> Cli () diff --git a/unison-src/transcripts/ability-term-conflicts-on-update.output.md b/unison-src/transcripts/ability-term-conflicts-on-update.output.md index 901446e8d4..0430088f08 100644 --- a/unison-src/transcripts/ability-term-conflicts-on-update.output.md +++ b/unison-src/transcripts/ability-term-conflicts-on-update.output.md @@ -81,12 +81,9 @@ These should fail with a term/ctor conflict since we exclude the ability from th ⍟ I've added these definitions: + ability Channels Channels.send : a -> () thing : '{Channels} () - - ⍟ I've updated these names to your new definition: - - ability Channels ``` If however, `Channels.send` and `thing` _depend_ on `Channels`, updating them should succeed since it pulls in the ability as a dependency. diff --git a/unison-src/transcripts/cycle-update-5.output.md b/unison-src/transcripts/cycle-update-5.output.md index 3e3361f70c..6f9f4ebff4 100644 --- a/unison-src/transcripts/cycle-update-5.output.md +++ b/unison-src/transcripts/cycle-update-5.output.md @@ -62,10 +62,8 @@ inner.ping _ = !pong + 3 .> view inner.ping - inner.ping : 'Nat - inner.ping _ = - use Nat + - !pong + 1 + inner.inner.ping : '##Nat + inner.inner.ping _ = ##Nat.+ !#4t465jk908 3 ``` The bug here is that `inner.ping` still refers to `pong` by name. But if we properly identified the nameless (in the diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md index cacb9d1fc4..d0699527da 100644 --- a/unison-src/transcripts/diff-namespace.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -213,399 +213,23 @@ unique type Y a b = Y a b .> diff.namespace ns1 ns2 - Resolved name conflicts: - - 1. ┌ fromJust#gjmq673r1v : Nat - 2. └ fromJust#rnbo52q2sh : Text - ↓ - 3. fromJust#6gn1k53ie0 : Nat - - Updates: - - 4. b : Nat - ↓ - 5. b : Text - - 6. fromJust' : Nat - ↓ - 7. fromJust' : Nat - - Added definitions: - - 8. type Y a b - 9. Y.Y : a -> b -> Y a b - 10. d : Nat - 11. e : Nat - 12. f : Nat - - 13. patch patch (added 2 updates) - -.> alias.term ns2.d ns2.d' - - Done. - -.> alias.type ns2.A ns2.A' - - Done. - -.> alias.type ns2.X ns2.X' - - Done. - -.> diff.namespace ns1 ns2 - - Resolved name conflicts: - - 1. ┌ fromJust#gjmq673r1v : Nat - 2. └ fromJust#rnbo52q2sh : Text - ↓ - 3. fromJust#6gn1k53ie0 : Nat - - Updates: - - 4. b : Nat - ↓ - 5. b : Text - - 6. fromJust' : Nat - ↓ - 7. fromJust' : Nat - - Added definitions: - - 8. type Y a b - 9. Y.Y : a -> b -> Y a b - 10. ┌ d : Nat - 11. └ d' : Nat - 12. e : Nat - 13. f : Nat - - 14. patch patch (added 2 updates) - - Name changes: - - Original Changes - 15. A 16. A' (added) - - 17. X 18. X' (added) - -.> alias.type ns1.X ns1.X2 - - Done. - -.> alias.type ns2.A' ns2.A'' - - Done. - -.> fork ns2 ns3 - - Done. - -.> alias.term ns2.fromJust' ns2.yoohoo - - Done. - -.> delete.term.verbose ns2.fromJust' - - Name changes: - - Original Changes - 1. ns2.fromJust ┐ 2. ns2.fromJust' (removed) - 3. ns2.fromJust' │ - 4. ns2.yoohoo │ - 5. ns3.fromJust │ - 6. ns3.fromJust' ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.> diff.namespace ns3 ns2 - - Name changes: - - Original Changes - 1. fromJust ┐ 2. yoohoo (added) - 3. fromJust' ┘ 4. fromJust' (removed) - -``` -```unison -bdependent = "banana" -``` - -```ucm -.ns3> update.old - - ⍟ I've updated these names to your new definition: - - bdependent : ##Text - -.> diff.namespace ns2 ns3 - - Updates: - - 1. bdependent : Nat - ↓ - 2. bdependent : Text - - 3. patch patch (added 1 updates) - - Name changes: - - Original Changes - 4. fromJust ┐ 5. fromJust' (added) - 6. yoohoo ┘ 7. yoohoo (removed) - -``` -## Two different auto-propagated changes creating a name conflict -Currently, the auto-propagated name-conflicted definitions are not explicitly -shown, only their also-conflicted dependency is shown. -```unison -a = 333 -b = a + 1 -``` - -```ucm - ☝️ The namespace .nsx is empty. - -.nsx> add - - ⍟ I've added these definitions: - - a : ##Nat - b : ##Nat - -.> fork nsx nsy - - Done. - -.> fork nsx nsz - - Done. - -``` -```unison -a = 444 -``` - -```ucm -.nsy> update.old - - ⍟ I've updated these names to your new definition: - - a : ##Nat - -``` -```unison -a = 555 -``` - -```ucm -.nsz> update.old - - ⍟ I've updated these names to your new definition: - - a : ##Nat - -.> merge.old nsy nsw - - Here's what's changed in nsw after the merge: - - Added definitions: - - 1. a : Nat - 2. b : Nat - - 3. patch patch (added 1 updates) - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` -```ucm -.> merge.old nsz nsw - - Here's what's changed in nsw after the merge: - - New name conflicts: - - 1. a#mdl4vqtu00 : Nat - ↓ - 2. ┌ a#mdl4vqtu00 : Nat - 3. └ a#vrs8gtkl2t : Nat - - 4. b#unkqhuu66p : Nat - ↓ - 5. ┌ b#aapqletas7 : Nat - 6. └ b#unkqhuu66p : Nat - - Updates: - - 7. patch patch (added 1 updates) - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - - I tried to auto-apply the patch, but couldn't because it - contained contradictory entries. - -``` -```ucm -.> diff.namespace nsx nsw - - New name conflicts: - - 1. a#uiiiv8a86s : Nat - ↓ - 2. ┌ a#mdl4vqtu00 : Nat - 3. └ a#vrs8gtkl2t : Nat - - 4. b#lhigeb1let : Nat - ↓ - 5. ┌ b#aapqletas7 : Nat - 6. └ b#unkqhuu66p : Nat - - Added definitions: - - 7. patch patch (added 2 updates) - -.nsw> view a b - - a#mdl4vqtu00 : ##Nat - a#mdl4vqtu00 = 444 - - a#vrs8gtkl2t : ##Nat - a#vrs8gtkl2t = 555 - - b#aapqletas7 : ##Nat - b#aapqletas7 = ##Nat.+ a#vrs8gtkl2t 1 - - b#unkqhuu66p : ##Nat - b#unkqhuu66p = ##Nat.+ a#mdl4vqtu00 1 - -``` -## Should be able to diff a namespace hash from history. - -```unison -x = 1 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - x : ##Nat - -``` -```ucm - ☝️ The namespace .hashdiff is empty. - -.hashdiff> add - - ⍟ I've added these definitions: + ⚠️ - x : ##Nat + The namespace .ns1 is empty. Was there a typo? ``` -```unison -y = 2 -``` ```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - y : ##Nat - +.ns2> update.old.> diff.namespace ns1 ns2.> alias.term ns2.d ns2.d'.> alias.type ns2.A ns2.A'.> alias.type ns2.X ns2.X'.> diff.namespace ns1 ns2.> alias.type ns1.X ns1.X2.> alias.type ns2.A' ns2.A''.> fork ns2 ns3.> alias.term ns2.fromJust' ns2.yoohoo.> delete.term.verbose ns2.fromJust'.> diff.namespace ns3 ns2 ``` -```ucm -.hashdiff> add - ⍟ I've added these definitions: - - y : ##Nat -.hashdiff> history +🛑 - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #ru1hnjofdj - - + Adds / updates: - - y - - □ 2. #i52j9fd57b (start of history) +The transcript failed due to an error in the stanza above. The error is: -.hashdiff> diff.namespace 2 1 - Added definitions: + ⚠️ - 1. y : ##Nat + The namespace .ns1 is empty. Was there a typo? -``` -## - -Updates: -- 1 to 1 - -New name conflicts: -- updates where RHS has multiple hashes (excluding when RHS=LHS) - - 1. foo#jk19sm5bf8 : Nat - do we want to force a hashqualified? Arya thinks so - ↓ - 2. ┌ foo#0ja1qfpej6 : Nat - 3. └ foo#jk19sm5bf8 : Nat - -Resolved name conflicts: -- updates where LHS had multiple hashes and RHS has one - - 4. ┌ bar#0ja1qfpej6 : Nat - 5. └ bar#jk19sm5bf8 : Nat - ↓ - 6. bar#jk19sm5bf8 : Nat - -## Display issues to fixup - -- [d] Do we want to surface new edit conflicts in patches? -- [t] two different auto-propagated changes creating a name conflict should show - up somewhere besides the auto-propagate count -- [t] Things look screwy when the type signature doesn't fit and has to get broken - up into multiple lines. Maybe just disallow that? -- [d] Delete blank line in between copies / renames entries if all entries are 1 to 1 - see todo in the code -- [x] incorrectly calculated bracket alignment on hashqualified "Name changes" (delete.output.md) -- [x] just handle deletion of isPropagated in propagate function, leave HandleInput alone (assuming this does the trick) -- [x] might want unqualified names to be qualified sometimes: -- [x] if a name is updated to a not-yet-named reference, it's shown as both an update and an add -- [x] similarly, if a conflicted name is resolved by deleting the last name to - a reference, I (arya) suspect it will show up as a Remove -- [d] Maybe group and/or add headings to the types, constructors, terms -- [x] add tagging of propagated updates to test propagated updates output -- [x] missing old names in deletion ppe (delete.output.md) (superseded by \#1143) -- [x] delete.term has some bonkers output -- [x] Make a decision about how we want to show constructors in the diff -- [x] 12.patch patch needs a space -- [x] This looks like garbage -- [x] Extra 2 blank lines at the end of the add section -- [x] Fix alignment issues with buildTable, convert to column3M (to be written) -- [x] adding an alias is showing up as an Add and a Copy; should just show as Copy -- [x] removing one of multiple aliases appears in removes + moves + copies section -- [x] some overlapping cases between Moves and Copies^ -- [x] Maybe don't list the type signature twice for aliases? diff --git a/unison-src/transcripts/fix2254.output.md b/unison-src/transcripts/fix2254.output.md index 61af269b2c..f5993c0f8e 100644 --- a/unison-src/transcripts/fix2254.output.md +++ b/unison-src/transcripts/fix2254.output.md @@ -72,149 +72,35 @@ Let's do the update now, and verify that the definitions all look good and there .a2> view A NeedsA f f2 f3 g - type A a b c d - = B b - | D d - | E a d - | C c - | A a - - structural type NeedsA a b - = Zoink Text - | NeedsA (A a b Nat Nat) - - f : A Nat Nat Nat Nat -> Nat - f = cases - A n -> n - _ -> 42 - - f2 : A Nat Nat Nat Nat -> Nat - f2 a = - use Nat + - n = f a - n + 1 - - f3 : NeedsA Nat Nat -> Nat - f3 = cases - NeedsA a -> f a Nat.+ 20 - _ -> 0 - - g : A Nat Nat Nat Nat -> Nat - g = cases - D n -> n - _ -> 43 + type A a b c d = B b | D d | E a d | C c | A a -.a2> todo - - ✅ + ⚠️ - No conflicts or edits in progress. - -``` -## Record updates - -Here's a test of updating a record: - -```unison -structural type Rec = { uno : Nat, dos : Nat } + The following names were not found in the codebase. Check your spelling. + NeedsA + f + f2 + f3 + g -combine r = uno r + dos r ``` ```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec - combine : Rec -> Nat - +.a2> update.old.a2> view A NeedsA f f2 f3 g.a2> todo ``` -```ucm -.a3> add - ⍟ I've added these definitions: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec - combine : Rec -> Nat -``` -```unison -structural type Rec = { uno : Nat, dos : Nat, tres : Text } -``` +🛑 -```ucm +The transcript failed due to an error in the stanza above. The error is: - Loading changes detected in scratch.u. - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: + ⚠️ - ⍟ These new definitions are ok to `add`: - - Rec.tres : Rec -> Text - Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec - Rec.tres.set : Text -> Rec -> Rec - - ⍟ These names already exist. You can `update` them to your - new definition: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec - -``` -And checking that after updating this record, there's nothing `todo`: - -```ucm -.> fork a3 a4 - - Done. + The following names were not found in the codebase. Check your spelling. + NeedsA + f + f2 + f3 + g -.a4> update.old - - ⍟ I've added these definitions: - - Rec.tres : Rec -> Text - Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec - Rec.tres.set : Text -> Rec -> Rec - - ⍟ I've updated these names to your new definition: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec - -.a4> todo - - ✅ - - No conflicts or edits in progress. - -``` diff --git a/unison-src/transcripts/propagate.output.md b/unison-src/transcripts/propagate.output.md index 5f0b72bb35..ce3d37dcdf 100644 --- a/unison-src/transcripts/propagate.output.md +++ b/unison-src/transcripts/propagate.output.md @@ -87,185 +87,22 @@ and update the codebase to use the new type `Foo`... ```ucm .subpath> view fooToInt - fooToInt : Foo -> Int - fooToInt _ = +42 - -``` -### Preserving user type variables - -We make a term that has a dependency on another term and also a non-redundant -user-provided type signature. - -```unison -preserve.someTerm : Optional foo -> Optional foo -preserve.someTerm x = x - -preserve.otherTerm : Optional baz -> Optional baz -preserve.otherTerm y = someTerm y -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - preserve.otherTerm : Optional baz -> Optional baz - preserve.someTerm : Optional foo -> Optional foo - -``` -Add that to the codebase: - -```ucm -.subpath> add - - ⍟ I've added these definitions: + ⚠️ - preserve.otherTerm : Optional baz -> Optional baz - preserve.someTerm : Optional foo -> Optional foo - -``` -Let's now edit the dependency: + The following names were not found in the codebase. Check your spelling. + fooToInt -```unison -preserve.someTerm : Optional x -> Optional x -preserve.someTerm _ = None ``` -```ucm - Loading changes detected in scratch.u. - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These names already exist. You can `update` them to your - new definition: - - preserve.someTerm : Optional x -> Optional x +🛑 -``` -Update... +The transcript failed due to an error in the stanza above. The error is: -```ucm -.subpath> update.old - ⍟ I've updated these names to your new definition: + ⚠️ - preserve.someTerm : Optional x -> Optional x - -``` -Now the type of `someTerm` should be `Optional x -> Optional x` and the -type of `otherTerm` should remain the same. - -```ucm -.subpath> view preserve.someTerm - - preserve.someTerm : Optional x -> Optional x - preserve.someTerm _ = None - -.subpath> view preserve.otherTerm - - preserve.otherTerm : Optional baz -> Optional baz - preserve.otherTerm y = someTerm y - -``` -### Propagation only applies to the local branch - -Cleaning up a bit... - -```ucm -.> delete.namespace subpath - - Done. - - ☝️ The namespace .subpath.lib is empty. - -.subpath.lib> builtins.merge + The following names were not found in the codebase. Check your spelling. + fooToInt - Done. - -``` -Now, we make two terms, where one depends on the other. - -```unison -one.someTerm : Optional foo -> Optional foo -one.someTerm x = x - -one.otherTerm : Optional baz -> Optional baz -one.otherTerm y = someTerm y -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - one.otherTerm : Optional baz -> Optional baz - one.someTerm : Optional foo -> Optional foo - -``` -We'll make two copies of this namespace. - -```ucm -.subpath> add - - ⍟ I've added these definitions: - - one.otherTerm : Optional baz -> Optional baz - one.someTerm : Optional foo -> Optional foo - -.subpath> fork one two - - Done. - -``` -Now let's edit one of the terms... - -```unison -someTerm : Optional x -> Optional x -someTerm _ = None -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - someTerm : Optional x -> Optional x - -``` -... in one of the namespaces... - -```ucm -.subpath.one> update.old - - ⍟ I've updated these names to your new definition: - - someTerm : #nirp5os0q6 x -> #nirp5os0q6 x - -``` -The other namespace should be left alone. - -```ucm -.subpath> view two.someTerm - - two.someTerm : Optional foo -> Optional foo - two.someTerm x = x - -``` diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index b0a9d69c6d..9a38511690 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -29,264 +29,16 @@ type MyType = MyType Text .simple> todo - 🚧 - - The namespace has 2 transitive dependent(s) left to upgrade. - Your edit frontier is the dependents of these definitions: - - type #vijug0om28 - #gjmq673r1v : Nat - - I recommend working on them in the following order: - - 1. useMyType : Nat - 2. useX : Nat - - - -``` -## A merge with conflicting updates. - -```unison -x = 1 -type MyType = MyType -``` - -Set up two branches with the same starting point. - -Update `x` to a different term in each branch. - -```unison -x = 2 -type MyType = MyType Nat -``` - -```unison -x = 3 -type MyType = MyType Int -``` - -```ucm -.mergeA> merge.old .mergeB - - Here's what's changed in the current namespace after the - merge: - - New name conflicts: - - 1. type MyType#ig1g2ka7lv - ↓ - 2. ┌ type MyType#8c6f40i3tj - 3. └ type MyType#ig1g2ka7lv - - 4. MyType.MyType#ig1g2ka7lv#0 : Nat -> MyType#ig1g2ka7lv - ↓ - 5. ┌ MyType.MyType#8c6f40i3tj#0 : Int -> MyType#8c6f40i3tj - 6. └ MyType.MyType#ig1g2ka7lv#0 : Nat -> MyType#ig1g2ka7lv - - 7. x#dcgdua2lj6 : Nat - ↓ - 8. ┌ x#dcgdua2lj6 : Nat - 9. └ x#f3lgjvjqoo : Nat - - Updates: - - 10. patch patch (added 2 updates) - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - - I tried to auto-apply the patch, but couldn't because it - contained contradictory entries. - -.mergeA> todo - - ❓ - - These definitions were edited differently in namespaces that - have been merged into this one. You'll have to tell me what to - use as the new definition: - - The type 1. #8h7qq3ougl was replaced with - 2. MyType#8c6f40i3tj - 3. MyType#ig1g2ka7lv - The term 4. #gjmq673r1v was replaced with - 5. x#dcgdua2lj6 - 6. x#f3lgjvjqoo - ❓ - - The term MyType.MyType has conflicting definitions: - 7. MyType.MyType#8c6f40i3tj#0 - 8. MyType.MyType#ig1g2ka7lv#0 - - Tip: This occurs when merging branches that both independently - introduce the same name. Use `move.term` or `delete.term` - to resolve the conflicts. - -``` -## A named value that appears on the LHS of a patch isn't shown - -```unison -foo = 801 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - foo : Nat - -``` -```ucm -.lhs> add - - ⍟ I've added these definitions: - - foo : Nat - -``` -```unison -foo = 802 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These names already exist. You can `update` them to your - new definition: - - foo : Nat - -``` -```ucm -.lhs> update.old - - ⍟ I've updated these names to your new definition: - - foo : Nat - -``` -```unison -oldfoo = 801 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - oldfoo : Nat - -``` -```ucm -.lhs> add - - ⍟ I've added these definitions: - - oldfoo : Nat - -.lhs> todo - ✅ No conflicts or edits in progress. ``` -## A type-changing update to one element of a cycle, which doesn't propagate to the other - -```unison -even = cases - 0 -> true - n -> odd (drop 1 n) -odd = cases - 0 -> false - n -> even (drop 1 n) ``` -```ucm - Loading changes detected in scratch.u. - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - even : Nat -> Boolean - odd : Nat -> Boolean +🛑 -``` -```ucm -.cycle2> add - - ⍟ I've added these definitions: - - even : Nat -> Boolean - odd : Nat -> Boolean - -``` -```unison -even = 17 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These names already exist. You can `update` them to your - new definition: - - even : Nat - -``` -```ucm -.cycle2> update.old - - ⍟ I've updated these names to your new definition: - - even : Nat - -``` -```ucm -.cycle2> todo - - 🚧 - - The namespace has 1 transitive dependent(s) left to upgrade. - Your edit frontier is the dependents of these definitions: - - #kkohl7ba1e : Nat -> Boolean - - I recommend working on them in the following order: - - 1. odd : Nat -> Boolean - - - -``` +The transcript was expecting an error in the stanza above, but did not encounter one. From 9f7b82533e63428bf42fad83ab750b85885126e3 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 5 Jun 2024 14:12:57 -0700 Subject: [PATCH 105/631] Tweaks --- unison-cli/src/Unison/Cli/MonadUtils.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 52828233c7..e780089ad3 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -433,9 +433,10 @@ stepManyAtNoSync actions = do stepManyAtM :: (Foldable f) => Text -> + ProjectBranch -> f (Path.Absolute, Branch0 IO -> IO (Branch0 IO)) -> Cli () -stepManyAtM reason actions = do +stepManyAtM pb reason actions = do stepManyAtMNoSync actions syncRoot reason @@ -449,8 +450,8 @@ stepManyAtMNoSync actions = do setCurrentProjectRoot newRoot -- | Sync the in-memory root branch. -syncRoot :: Text -> Cli () -syncRoot description = do +syncRoot :: ProjectBranch -> Text -> Cli () +syncRoot pb description = do rootBranch <- getCurrentProjectRoot updateCurrentProjectBranchRoot description (const rootBranch) From 6518e3f3fc4a34ef2673d99581436c9793fa3ed6 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 6 Jun 2024 10:41:01 -0700 Subject: [PATCH 106/631] Deleting a bunch of stuff to do with push/pull loose code --- unison-cli/src/Unison/Cli/MonadUtils.hs | 12 +++ .../src/Unison/Cli/UnisonConfigUtils.hs | 90 ------------------- .../Codebase/Editor/HandleInput/Pull.hs | 1 - .../Codebase/Editor/HandleInput/Push.hs | 32 ++----- .../src/Unison/Codebase/Editor/Output.hs | 2 - unison-cli/unison-cli.cabal | 1 - 6 files changed, 18 insertions(+), 120 deletions(-) delete mode 100644 unison-cli/src/Unison/Cli/UnisonConfigUtils.hs diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 01ad211d2e..6f104bf8ce 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -13,6 +13,10 @@ module Unison.Cli.MonadUtils resolvePath', resolveSplit', + -- * Project and branch resolution + getCurrentProjectAndBranch, + getCurrentProjectBranch, + -- * Branches -- ** Resolving branch identifiers @@ -151,6 +155,14 @@ getCurrentProjectPath = do pure (project, branch) pure (PP.ProjectPath proj branch path) +getCurrentProjectAndBranch :: Cli (ProjectAndBranch Project ProjectBranch) +getCurrentProjectAndBranch = do + view PP.asProjectAndBranch_ <$> getCurrentProjectPath + +getCurrentProjectBranch :: Cli ProjectBranch +getCurrentProjectBranch = do + view #branch <$> getCurrentProjectPath + -- | Get the current path relative to the current project. getCurrentPath :: Cli Path.Absolute getCurrentPath = do diff --git a/unison-cli/src/Unison/Cli/UnisonConfigUtils.hs b/unison-cli/src/Unison/Cli/UnisonConfigUtils.hs deleted file mode 100644 index c062c7b476..0000000000 --- a/unison-cli/src/Unison/Cli/UnisonConfigUtils.hs +++ /dev/null @@ -1,90 +0,0 @@ --- | @.unisonConfig@ file utilities -module Unison.Cli.UnisonConfigUtils - ( remoteMappingKey, - resolveConfiguredUrl, - ) -where - -import Control.Lens -import Data.Foldable.Extra qualified as Foldable -import Data.Sequence (Seq (..)) -import Data.Sequence qualified as Seq -import Data.Text qualified as Text -import Text.Megaparsec qualified as P -import Unison.Cli.Monad (Cli) -import Unison.Cli.Monad qualified as Cli -import Unison.Cli.MonadUtils qualified as Cli -import Unison.Codebase.Editor.Output -import Unison.Codebase.Editor.Output.PushPull (PushPull) -import Unison.Codebase.Editor.RemoteRepo (WriteRemoteNamespace (..)) -import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo -import Unison.Codebase.Editor.UriParser qualified as UriParser -import Unison.Codebase.Path (Path' (..)) -import Unison.Codebase.Path qualified as Path -import Unison.Prelude -import Unison.Syntax.NameSegment qualified as NameSegment - -configKey :: Text -> Path.Absolute -> Text -configKey k p = - Text.intercalate "." . toList $ - k - :<| fmap - NameSegment.toEscapedText - (Path.toSeq $ Path.unabsolute p) - -remoteMappingKey :: Path.Absolute -> Text -remoteMappingKey = configKey "RemoteMapping" - --- Takes a maybe (namespace address triple); returns it as-is if `Just`; --- otherwise, tries to load a value from .unisonConfig, and complains --- if needed. -resolveConfiguredUrl :: PushPull -> Path' -> Cli (WriteRemoteNamespace Void) -resolveConfiguredUrl pushPull destPath' = do - destPath <- Cli.resolvePath' destPath' - whenNothingM (remoteMappingForPath pushPull destPath) do - Cli.returnEarly (NoConfiguredRemoteMapping pushPull destPath) - --- | Tries to look up a remote mapping for a given path. --- Will also resolve paths relative to any mapping which is configured for a parent of that --- path. --- --- E.g. --- --- A config which maps: --- --- .myshare.foo -> .me.public.foo --- --- Will resolve the following local paths into share paths like so: --- --- .myshare.foo -> .me.public.foo --- .myshare.foo.bar -> .me.public.foo.bar --- .myshare.foo.bar.baz -> .me.public.foo.bar.baz --- .myshare -> -remoteMappingForPath :: PushPull -> Path.Absolute -> Cli (Maybe (WriteRemoteNamespace Void)) -remoteMappingForPath pushPull dest = do - pathPrefixes dest & Foldable.firstJustM \(prefix, suffix) -> do - let remoteMappingConfigKey = remoteMappingKey prefix - Cli.getConfig remoteMappingConfigKey >>= \case - Just url -> do - let parseResult = P.parse (UriParser.writeRemoteNamespaceWith empty) (Text.unpack remoteMappingConfigKey) url - in case parseResult of - Left err -> Cli.returnEarly (ConfiguredRemoteMappingParseError pushPull dest url (show err)) - Right wrp -> do - let remote = wrp & RemoteRepo.remotePath_ %~ \p -> Path.resolve p suffix - in pure $ Just remote - Nothing -> pure Nothing - where - -- Produces a list of path prefixes and suffixes, from longest prefix to shortest - -- - -- E.g. - -- - -- >>> pathPrefixes ("a" :< "b" :< Path.absoluteEmpty) - -- fromList [(.a.b,),(.a,b),(.,a.b)] - pathPrefixes :: Path.Absolute -> Seq (Path.Absolute, Path.Path) - pathPrefixes p = - Path.unabsolute p - & Path.toSeq - & \seq -> - Seq.zip (Seq.inits seq) (Seq.tails seq) - & Seq.reverse - <&> bimap (Path.Absolute . Path.Path) (Path.Path) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index dd644b41b8..fec305abd3 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -23,7 +23,6 @@ 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.Cli.UnisonConfigUtils (resolveConfiguredUrl) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch (..)) import Unison.Codebase.Branch qualified as Branch diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs index 25c7bdf25a..46b05773e0 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs @@ -23,7 +23,6 @@ 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.Cli.UnisonConfigUtils qualified as UnisonConfigUtils import Unison.Codebase.Editor.HandleInput.AuthLogin qualified as AuthLogin import Unison.Codebase.Editor.Input ( PushRemoteBranchInput (..), @@ -67,31 +66,17 @@ handlePushRemoteBranch :: PushRemoteBranchInput -> Cli () handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do case sourceTarget of -- push to - PushSourceTarget0 -> - ProjectUtils.getCurrentProjectBranch >>= \case - Nothing -> do - localPath <- Cli.getCurrentPath - UnisonConfigUtils.resolveConfiguredUrl Push Path.currentPath >>= \case - WriteRemoteNamespaceShare namespace -> pushLooseCodeToShareLooseCode localPath namespace pushBehavior - WriteRemoteProjectBranch v -> absurd v - Just (localProjectAndBranch, _restPath) -> - pushProjectBranchToProjectBranch - force - localProjectAndBranch - Nothing + PushSourceTarget0 -> do + localProjectAndBranch <- Cli.getCurrentProjectAndBranch + pushProjectBranchToProjectBranch force localProjectAndBranch Nothing -- push to .some.path (share) PushSourceTarget1 (WriteRemoteNamespaceShare namespace) -> do localPath <- Cli.getCurrentPath pushLooseCodeToShareLooseCode localPath namespace pushBehavior -- push to @some/project - PushSourceTarget1 (WriteRemoteProjectBranch remoteProjectAndBranch0) -> - ProjectUtils.getCurrentProjectBranch >>= \case - Nothing -> do - localPath <- Cli.getCurrentPath - remoteProjectAndBranch <- ProjectUtils.hydrateNames remoteProjectAndBranch0 - pushLooseCodeToProjectBranch force localPath remoteProjectAndBranch - Just (localProjectAndBranch, _restPath) -> - pushProjectBranchToProjectBranch force localProjectAndBranch (Just remoteProjectAndBranch0) + PushSourceTarget1 (WriteRemoteProjectBranch remoteProjectAndBranch0) -> do + localProjectAndBranch <- Cli.getCurrentProjectAndBranch + pushProjectBranchToProjectBranch force localProjectAndBranch (Just remoteProjectAndBranch0) -- push .some.path to .some.path (share) PushSourceTarget2 (PathySource localPath0) (WriteRemoteNamespaceShare namespace) -> do localPath <- Cli.resolvePath' localPath0 @@ -119,11 +104,6 @@ handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do PushBehavior.RequireEmpty -> False PushBehavior.RequireNonEmpty -> False --- Push a local namespace ("loose code") to a Share-hosted remote namespace ("loose code"). -pushLooseCodeToShareLooseCode :: Path.Absolute -> WriteShareRemoteNamespace -> PushBehavior -> Cli () -pushLooseCodeToShareLooseCode _ _ _ = do - Cli.returnEarly LooseCodePushDeprecated - -- Push a local namespace ("loose code") to a remote project branch. pushLooseCodeToProjectBranch :: Bool -> Path.Absolute -> ProjectAndBranch ProjectName ProjectBranchName -> Cli () pushLooseCodeToProjectBranch force localPath remoteProjectAndBranch = do diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index e6b5608e26..caaad9e9c8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -391,7 +391,6 @@ data Output | UpdateIncompleteConstructorSet UpdateOrUpgrade Name (Map ConstructorId Name) (Maybe Int) | UpgradeFailure !ProjectBranchName !ProjectBranchName !FilePath !NameSegment !NameSegment | UpgradeSuccess !NameSegment !NameSegment - | LooseCodePushDeprecated | MergeFailure !FilePath !MergeSourceAndTarget | MergeSuccess !MergeSourceAndTarget | MergeSuccessFastForward !MergeSourceAndTarget @@ -630,7 +629,6 @@ isFailure o = case o of ProjectHasNoReleases {} -> True UpgradeFailure {} -> True UpgradeSuccess {} -> False - LooseCodePushDeprecated -> True MergeFailure {} -> True MergeSuccess {} -> False MergeSuccessFastForward {} -> False diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 403d2f7e73..b1e9514515 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -47,7 +47,6 @@ library Unison.Cli.Share.Projects.Types Unison.Cli.TypeCheck Unison.Cli.UniqueTypeGuidLookup - Unison.Cli.UnisonConfigUtils Unison.Codebase.Editor.AuthorInfo Unison.Codebase.Editor.HandleInput Unison.Codebase.Editor.HandleInput.AddRun From 3c197c51c80fc7d3af4c0cac5eaf70fb1bc6ae6c Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 6 Jun 2024 23:17:49 -0500 Subject: [PATCH 107/631] Use a project in fix5055 transcript This makes the absolute path problem more obvious. --- unison-src/transcripts/fix5055.md | 10 ++++---- unison-src/transcripts/fix5055.output.md | 30 +++++++++++++++++++----- 2 files changed, 29 insertions(+), 11 deletions(-) diff --git a/unison-src/transcripts/fix5055.md b/unison-src/transcripts/fix5055.md index a248a1d948..b0218766a1 100644 --- a/unison-src/transcripts/fix5055.md +++ b/unison-src/transcripts/fix5055.md @@ -1,5 +1,6 @@ ```ucm -.> builtins.merge +.> project.create-empty test-5055 +test-5055/main> builtins.merge ``` ```unison @@ -9,8 +10,7 @@ foo.subtract x y = x Int.- y ``` ```ucm -.> add -.> ls foo -.> view 1 +test-5055/main> add +test-5055/main> ls foo +test-5055/main> view 1 ``` - diff --git a/unison-src/transcripts/fix5055.output.md b/unison-src/transcripts/fix5055.output.md index b153ebc4dd..05506bac00 100644 --- a/unison-src/transcripts/fix5055.output.md +++ b/unison-src/transcripts/fix5055.output.md @@ -1,5 +1,21 @@ ```ucm -.> builtins.merge +.> project.create-empty test-5055 + + 🎉 I've created the project test-5055. + + 🎨 Type `ui` to explore this project's code in your browser. + 🔭 Discover libraries at https://share.unison-lang.org + 📖 Use `help-topic projects` to learn more about projects. + + Write your first Unison code with UCM: + + 1. Open scratch.u. + 2. Write some Unison code and save the file. + 3. In UCM, type `add` to save it to your new project. + + 🎉 🥳 Happy coding! + +test-5055/main> builtins.merge Done. @@ -25,22 +41,24 @@ foo.subtract x y = x Int.- y ``` ```ucm -.> add +test-5055/main> add ⍟ I've added these definitions: foo.add : Int -> Int -> Int foo.subtract : Int -> Int -> Int -.> ls foo +test-5055/main> ls foo 1. add (Int -> Int -> Int) 2. subtract (Int -> Int -> Int) -.> view 1 +test-5055/main> view 1 - .foo.add : Int -> Int -> Int - .foo.add x y = + .__projects._8e3f0836_9520_436c_bc83_398857c869a7.branches._6fb370f4_774e_495a_a8ff_caec833fdcc8.foo.add : + Int -> Int -> Int + .__projects._8e3f0836_9520_436c_bc83_398857c869a7.branches._6fb370f4_774e_495a_a8ff_caec833fdcc8.foo.add + x y = use Int + x + y From ce3305738564864ac54fc6c4e651262cb114b00e Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 6 Jun 2024 23:29:15 -0500 Subject: [PATCH 108/631] Refine Path-prefixing operations MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This replaces `prefix :: Absolute -> Path' -> Path` with a couple alternatives: - `prefixAbs :: Absolute -> Relative -> Absolute`, - `maybePrefix :: Path' -> Path' -> Maybe Path'`, and - `prefix :: Path' -> Relative -> Path'`. The previous `prefix` could fail to prefix (covered by either the new `prefix` or `maybePrefix`, depending on whether you want to guarantee success or capture failure), always threw away the knowledge that the result was necessarily `Absolute` (covered by `prefixAbs`), and then always returned an ambiguous result type (covered by all three replacements). Then it also provides `prefixRel` as the complement of `prefixAbs` (both of which are used in the implementation of `prefix`). Similar changes are made in the replacements for `prefixName :: Absolute -> Name -> Name`. First, we don’t currently have absolute/relative variants of `Name`, so we can generalize the first argument to `Path'`. Then `maybePrefixName :: Path' -> Name -> Maybe Name` exposes the case where prefixing can’t succeed, and `prefixNameIfRel :: Path' -> Name -> Name` handles the common case of using the original `Name` if it can’t be prefixed. Both of these new functions also preserve the `Position` of the new `Name`, whereas the old implementation always returned a `Relative` `Name`, despite knowing when it was `Absolute`. And `prefixName2 :: Path -> Name -> Name` has been removed as there is no ambiguous variant of `Name` (as `Split` is to `Split'`), so prefixing with a `Path` isn’t particularly meaningful. Finally, `nameFromSplit'` is added as a dual to `splitFromName'` to make it possible to operate on the `Path'` portion of a `Name` without introducing partiality. These new operations are then propagated through the code, and enable a couple other type changes: `StructuredArgument.ShallowListEntry` and `StructuredArgument.SearchResult` now take a `Path'` prefix rather than the `Path.Absolute` and `Path` prefixes they took previously. This fixes the absolute `Name` issue in `ls` results. --- .../src/Unison/Codebase/Path.hs | 53 +++++++++----- .../src/Unison/Codebase/Editor/HandleInput.hs | 6 +- .../src/Unison/Codebase/Editor/Input.hs | 4 +- .../Codebase/Editor/StructuredArgument.hs | 6 +- .../src/Unison/CommandLine/InputPatterns.hs | 72 +++++++++---------- unison-share-api/src/Unison/Server/Local.hs | 2 +- .../src/Unison/Server/NameSearch/Sqlite.hs | 3 +- unison-src/transcripts/fix5055.output.md | 6 +- 8 files changed, 84 insertions(+), 68 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Path.hs b/parser-typechecker/src/Unison/Codebase/Path.hs index 7fbab07c6e..516a6c86f6 100644 --- a/parser-typechecker/src/Unison/Codebase/Path.hs +++ b/parser-typechecker/src/Unison/Codebase/Path.hs @@ -22,9 +22,12 @@ module Unison.Codebase.Path relativeEmpty', currentPath, prefix, + prefixAbs, + prefixRel, + maybePrefix, unprefix, - prefixName, - prefixName2, + maybePrefixName, + prefixNameIfRel, unprefixName, HQSplit, Split, @@ -62,8 +65,7 @@ module Unison.Codebase.Path unsplitAbsolute, unsplitHQ, unsplitHQ', - - -- * things that could be replaced with `Parse` instances + nameFromSplit', splitFromName, splitFromName', hqSplitFromName', @@ -81,6 +83,7 @@ where import Control.Lens hiding (cons, snoc, unsnoc, pattern Empty) import Control.Lens qualified as Lens +import Data.Bitraversable (bitraverse) import Data.Foldable qualified as Foldable import Data.List.Extra (dropPrefix) import Data.List.NonEmpty (NonEmpty ((:|))) @@ -187,16 +190,25 @@ unprefix (Absolute prefix) = \case AbsolutePath' abs -> unabsolute abs RelativePath' rel -> fromList $ dropPrefix (toList prefix) (toList (unrelative rel)) --- too many types -prefix :: Absolute -> Path' -> Path -prefix (Absolute (Path prefix)) = \case - AbsolutePath' abs -> unabsolute abs - RelativePath' rel -> Path $ prefix <> toSeq (unrelative rel) +prefixAbs :: Absolute -> Relative -> Absolute +prefixAbs prefix = Absolute . Path . (toSeq (unabsolute prefix) <>) . toSeq . unrelative -prefix2 :: Path -> Path' -> Path -prefix2 (Path prefix) = \case - AbsolutePath' abs -> unabsolute abs - RelativePath' rel -> Path $ prefix <> toSeq (unrelative rel) +prefixRel :: Relative -> Relative -> Relative +prefixRel prefix = Relative . Path . (toSeq (unrelative prefix) <>) . toSeq . unrelative + +-- | This always prefixes, since the secend argument can never be Absolute. +prefix :: Path' -> Relative -> Path' +prefix prefix = + Path' . case prefix of + AbsolutePath' abs -> Left . prefixAbs abs + RelativePath' rel -> pure . prefixRel rel + +-- | Returns `Nothing` if the second argument is absolute. A common pattern is +-- @fromMaybe path $ maybePrefix prefix path@ to use the unmodified path in that case. +maybePrefix :: Path' -> Path' -> Maybe Path' +maybePrefix pre = \case + AbsolutePath' _ -> Nothing + RelativePath' rel -> pure $ prefix pre rel -- | Finds the longest shared path prefix of two paths. -- Returns (shared prefix, path to first location from shared prefix, path to second location from shared prefix) @@ -268,6 +280,11 @@ splitFromName' name = seg ) +nameFromSplit' :: Split' -> Name +nameFromSplit' (path', seg) = case path' of + AbsolutePath' abs -> Name.makeAbsolute . Name.fromReverseSegments $ seg :| reverse (toList $ unabsolute abs) + RelativePath' rel -> Name.makeRelative . Name.fromReverseSegments $ seg :| reverse (toList $ unrelative rel) + -- | Remove a path prefix from a name. -- Returns 'Nothing' if there are no remaining segments to construct the name from. -- @@ -276,11 +293,13 @@ splitFromName' name = unprefixName :: Absolute -> Name -> Maybe Name unprefixName prefix = toName . unprefix prefix . fromName' -prefixName :: Absolute -> Name -> Name -prefixName p n = fromMaybe n . toName . prefix p . fromName' $ n +-- | Returns `Nothing` if the second argument is absolute. A common pattern is +-- @fromMaybe name $ maybePrefixName prefix name@ to use the unmodified path in that case. +maybePrefixName :: Path' -> Name -> Maybe Name +maybePrefixName pre = fmap nameFromSplit' . bitraverse (maybePrefix pre) pure . splitFromName' -prefixName2 :: Path -> Name -> Name -prefixName2 p n = fromMaybe n . toName . prefix2 p . fromName' $ n +prefixNameIfRel :: Path' -> Name -> Name +prefixNameIfRel p name = fromMaybe name $ maybePrefixName p name singleton :: NameSegment -> Path singleton n = fromList [n] diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index c8a3fed40c..30d241b40f 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -695,7 +695,7 @@ loop e = do pathArgAbs <- Cli.resolvePath' pathArg entries <- liftIO (Backend.lsAtPath codebase Nothing pathArgAbs) - Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArgAbs) entries + Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArg) entries pped <- Cli.currentPrettyPrintEnvDecl let suffixifiedPPE = PPED.suffixifiedPPE pped -- This used to be a delayed action which only forced the loading of the root @@ -1181,7 +1181,7 @@ handleFindI isVerbose fscope ws input = do Cli.Env {codebase} <- ask (pped, names, searchRoot, branch0) <- case fscope of FindLocal p -> do - searchRoot <- Cli.resolvePath p + searchRoot <- Cli.resolvePath' p branch0 <- Cli.getBranch0At searchRoot let names = Branch.toNames (Branch.withoutLib branch0) -- Don't exclude anything from the pretty printer, since the type signatures we print for @@ -1189,7 +1189,7 @@ handleFindI isVerbose fscope ws input = do pped <- Cli.currentPrettyPrintEnvDecl pure (pped, names, Just p, branch0) FindLocalAndDeps p -> do - searchRoot <- Cli.resolvePath p + searchRoot <- Cli.resolvePath' p branch0 <- Cli.getBranch0At searchRoot let names = Branch.toNames (Branch.withoutTransitiveLibs branch0) -- Don't exclude anything from the pretty printer, since the type signatures we print for diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 8edb5317cb..a29d2ac660 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -284,8 +284,8 @@ data OutputLocation deriving (Eq, Show) data FindScope - = FindLocal Path - | FindLocalAndDeps Path + = FindLocal Path' + | FindLocalAndDeps Path' | FindGlobal deriving stock (Eq, Show) diff --git a/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs index 740fed6c14..33dbddf9b8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs +++ b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs @@ -3,7 +3,7 @@ module Unison.Codebase.Editor.StructuredArgument where import GHC.Generics (Generic) import U.Codebase.HashTags (CausalHash) import Unison.Codebase.Editor.Input -import Unison.Codebase.Path (Path) +import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' @@ -24,6 +24,6 @@ data StructuredArgument | Namespace CausalHash | NameWithBranchPrefix AbsBranchId Name | HashQualifiedWithBranchPrefix AbsBranchId (HQ'.HashQualified Name) - | ShallowListEntry Path.Absolute (ShallowListEntry Symbol Ann) - | SearchResult (Maybe Path) SearchResult + | ShallowListEntry Path' (ShallowListEntry Symbol Ann) + | SearchResult (Maybe Path') SearchResult deriving (Eq, Generic, Show) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 982894af9b..ac1dcb4f44 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -181,7 +181,7 @@ import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.Codebase.Editor.UriParser (readRemoteNamespaceParser) import Unison.Codebase.Editor.UriParser qualified as UriParser -import Unison.Codebase.Path (Path) +import Unison.Codebase.Path (Path, Path') import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path import Unison.Codebase.PushBehavior qualified as PushBehavior @@ -249,9 +249,9 @@ formatStructuredArgument schLength = \case prefixBranchId :: Input.AbsBranchId -> Name -> Text prefixBranchId branchId name = case branchId of Left sch -> "#" <> SCH.toText sch <> ":" <> Name.toText (Name.makeAbsolute name) - Right pathPrefix -> Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name) + Right pathPrefix -> Name.toText (Path.prefixNameIfRel (Path.AbsolutePath' pathPrefix) name) - entryToHQText :: Path.Absolute -> ShallowListEntry v Ann -> Text + entryToHQText :: Path' -> ShallowListEntry v Ann -> Text entryToHQText pathArg = fixup . \case ShallowTypeEntry te -> Backend.typeEntryDisplayName te @@ -292,14 +292,14 @@ shallowListEntryToHQ' = \case ShallowPatchEntry ns -> HQ'.fromName $ Name.fromSegment ns -- | restores the full hash to these search results, for _numberedArgs purposes -searchResultToHQ :: Maybe Path -> SearchResult -> HQ.HashQualified Name +searchResultToHQ :: Maybe Path' -> SearchResult -> HQ.HashQualified Name searchResultToHQ oprefix = \case SR.Tm' n r _ -> HQ.requalify (addPrefix <$> n) r SR.Tp' n r _ -> HQ.requalify (addPrefix <$> n) (Referent.Ref r) _ -> error "impossible match failure" where addPrefix :: Name -> Name - addPrefix = maybe id Path.prefixName2 oprefix + addPrefix = maybe id Path.prefixNameIfRel oprefix unsupportedStructuredArgument :: Text -> I.Argument -> Either (P.Pretty CT.ColorText) String unsupportedStructuredArgument expected = @@ -400,25 +400,25 @@ handleHashQualifiedNameArg = \case SA.Name name -> pure $ HQ.NameOnly name SA.NameWithBranchPrefix mprefix name -> - pure . HQ.NameOnly $ foldr (\prefix -> Name.makeAbsolute . Path.prefixName prefix) name mprefix + pure . HQ.NameOnly $ foldr (Path.prefixNameIfRel . Path.AbsolutePath') name mprefix SA.HashQualified hqname -> pure hqname SA.HashQualifiedWithBranchPrefix mprefix hqname -> - pure . HQ'.toHQ $ foldr (\prefix -> fmap $ Name.makeAbsolute . Path.prefixName prefix) hqname mprefix + pure . HQ'.toHQ $ foldr (\prefix -> fmap $ Path.prefixNameIfRel (Path.AbsolutePath' prefix)) hqname mprefix SA.ShallowListEntry prefix entry -> - pure . HQ'.toHQ . fmap (Name.makeAbsolute . Path.prefixName prefix) $ shallowListEntryToHQ' entry + pure . HQ'.toHQ . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry SA.SearchResult mpath result -> pure $ searchResultToHQ mpath result otherArgType -> Left $ wrongStructuredArgument "a hash-qualified name" otherArgType -handlePathArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path +handlePathArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path handlePathArg = either (first P.text . Path.parsePath) \case SA.Name name -> pure $ Path.fromName name - SA.NameWithBranchPrefix mprefix name -> pure . Path.fromName $ foldr Path.prefixName name mprefix + SA.NameWithBranchPrefix _ name -> pure $ Path.fromName name otherArgType -> Left $ wrongStructuredArgument "a relative path" otherArgType -handlePath'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path' +handlePath'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path' handlePath'Arg = either (first P.text . Path.parsePath') @@ -426,7 +426,7 @@ handlePath'Arg = SA.AbsolutePath path -> pure $ Path.absoluteToPath' path SA.Name name -> pure $ Path.fromName' name SA.NameWithBranchPrefix mprefix name -> - pure . Path.fromName' $ foldr (\prefix -> Name.makeAbsolute . Path.prefixName prefix) name mprefix + pure . Path.fromName' $ foldr (Path.prefixNameIfRel . Path.AbsolutePath') name mprefix otherArgType -> Left $ wrongStructuredArgument "a namespace" otherArgType handleNewName :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split' @@ -435,7 +435,7 @@ handleNewName = (first P.text . Path.parseSplit') (const . Left $ "can’t use a numbered argument for a new name") -handleNewPath :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path' +handleNewPath :: I.Argument -> Either (P.Pretty CT.ColorText) Path' handleNewPath = either (first P.text . Path.parsePath') @@ -448,9 +448,7 @@ handleSplitArg = (first P.text . Path.parseSplit) \case SA.Name name | Name.isRelative name -> pure $ Path.splitFromName name - SA.NameWithBranchPrefix (Left _) name | Name.isRelative name -> pure $ Path.splitFromName name - SA.NameWithBranchPrefix (Right prefix) name - | Name.isRelative name -> pure . Path.splitFromName . Name.makeAbsolute $ Path.prefixName prefix name + SA.NameWithBranchPrefix _ name | Name.isRelative name -> pure $ Path.splitFromName name otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg handleSplit'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split' @@ -461,7 +459,7 @@ handleSplit'Arg = SA.Name name -> pure $ Path.splitFromName' name SA.NameWithBranchPrefix (Left _) name -> pure $ Path.splitFromName' name SA.NameWithBranchPrefix (Right prefix) name -> - pure . Path.splitFromName' . Name.makeAbsolute $ Path.prefixName prefix name + pure . Path.splitFromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg handleProjectBranchNameArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectBranchName @@ -480,7 +478,7 @@ handleBranchIdArg = SA.AbsolutePath path -> pure . pure $ Path.absoluteToPath' path SA.Name name -> pure . pure $ Path.fromName' name SA.NameWithBranchPrefix mprefix name -> - pure . pure . Path.fromName' $ either (const name) (Name.makeAbsolute . flip Path.prefixName name) mprefix + pure . pure . Path.fromName' $ foldr (Path.prefixNameIfRel . Path.AbsolutePath') name mprefix SA.Namespace hash -> pure . Left $ SCH.fromFullHash hash otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg @@ -496,7 +494,7 @@ handleBranchIdOrProjectArg = SA.Name name -> pure . This . pure $ Path.fromName' name SA.NameWithBranchPrefix (Left _) name -> pure . This . pure $ Path.fromName' name SA.NameWithBranchPrefix (Right prefix) name -> - pure . This . pure . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + pure . This . pure . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name SA.ProjectBranch pb -> pure $ pure pb otherArgType -> Left $ wrongStructuredArgument "a branch" otherArgType where @@ -528,7 +526,7 @@ handleBranchId2Arg = SA.Name name -> pure . pure . LoosePath $ Path.fromName' name SA.NameWithBranchPrefix (Left _) name -> pure . pure . LoosePath $ Path.fromName' name SA.NameWithBranchPrefix (Right prefix) name -> - pure . pure . LoosePath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + pure . pure . LoosePath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name SA.ProjectBranch (ProjectAndBranch mproject branch) -> pure . pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg @@ -542,7 +540,7 @@ handleBranchRelativePathArg = SA.Name name -> pure . LoosePath $ Path.fromName' name SA.NameWithBranchPrefix (Left _) name -> pure . LoosePath $ Path.fromName' name SA.NameWithBranchPrefix (Right prefix) name -> - pure . LoosePath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + pure . LoosePath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name SA.ProjectBranch (ProjectAndBranch mproject branch) -> pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg @@ -578,9 +576,9 @@ handleHashQualifiedSplit'Arg = hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit' name SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit' hqname SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> - pure . hq'NameToSplit' $ Name.makeAbsolute . Path.prefixName prefix <$> hqname + pure . hq'NameToSplit' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) <$> hqname SA.ShallowListEntry prefix entry -> - pure . hq'NameToSplit' . fmap (Name.makeAbsolute . Path.prefixName prefix) $ shallowListEntryToHQ' entry + pure . hq'NameToSplit' . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry sr@(SA.SearchResult mpath result) -> first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit' $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg @@ -601,7 +599,7 @@ handleHashQualifiedSplitArg = hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit name SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit hqname SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> - pure . hq'NameToSplit $ Name.makeAbsolute . Path.prefixName prefix <$> hqname + pure . hq'NameToSplit $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) <$> hqname SA.ShallowListEntry _ entry -> pure . hq'NameToSplit $ shallowListEntryToHQ' entry sr@(SA.SearchResult mpath result) -> first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit $ searchResultToHQ mpath result @@ -624,9 +622,9 @@ handleShortHashOrHQSplit'Arg = SA.HashQualified name -> pure $ hqNameToSplit' name SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure . pure $ hq'NameToSplit' hqname SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> - pure . pure $ hq'NameToSplit' (Name.makeAbsolute . Path.prefixName prefix <$> hqname) + pure . pure $ hq'NameToSplit' (Path.prefixNameIfRel (Path.AbsolutePath' prefix) <$> hqname) SA.ShallowListEntry prefix entry -> - pure . pure . hq'NameToSplit' . fmap (Name.makeAbsolute . Path.prefixName prefix) $ shallowListEntryToHQ' entry + pure . pure . hq'NameToSplit' . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry SA.SearchResult mpath result -> pure . hqNameToSplit' $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a hash or name" otherNumArg @@ -645,13 +643,13 @@ handleNameArg = \case SA.Name name -> pure name SA.NameWithBranchPrefix (Left _) name -> pure name - SA.NameWithBranchPrefix (Right prefix) name -> pure . Name.makeAbsolute $ Path.prefixName prefix name + SA.NameWithBranchPrefix (Right prefix) name -> pure $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name SA.HashQualified hqname -> maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> - pure . Name.makeAbsolute . Path.prefixName prefix $ HQ'.toName hqname + pure . Path.prefixNameIfRel (Path.AbsolutePath' prefix) $ HQ'.toName hqname SA.ShallowListEntry prefix entry -> - pure . HQ'.toName . fmap (Name.makeAbsolute . Path.prefixName prefix) $ shallowListEntryToHQ' entry + pure . HQ'.toName . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry SA.SearchResult mpath result -> maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg @@ -690,7 +688,7 @@ handlePushSourceArg = SA.Name name -> pure . Input.PathySource $ Path.fromName' name SA.NameWithBranchPrefix (Left _) name -> pure . Input.PathySource $ Path.fromName' name SA.NameWithBranchPrefix (Right prefix) name -> - pure . Input.PathySource . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + pure . Input.PathySource . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name SA.Project project -> pure . Input.ProjySource $ This project SA.ProjectBranch (ProjectAndBranch project branch) -> pure . Input.ProjySource $ maybe That These project branch otherNumArg -> Left $ wrongStructuredArgument "a source to push from" otherNumArg @@ -1071,7 +1069,7 @@ sfind = InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse where parse [q] = - Input.StructuredFindI (Input.FindLocal Path.empty) + Input.StructuredFindI (Input.FindLocal Path.relativeEmpty') <$> handleHashQualifiedNameArg q parse _ = Left "expected exactly one argument" msg = @@ -1130,10 +1128,10 @@ sfindReplace = ] find :: InputPattern -find = find' "find" (Input.FindLocal Path.empty) +find = find' "find" (Input.FindLocal Path.relativeEmpty') findAll :: InputPattern -findAll = find' "find.all" (Input.FindLocalAndDeps Path.empty) +findAll = find' "find.all" (Input.FindLocalAndDeps Path.relativeEmpty') findGlobal :: InputPattern findGlobal = find' "find.global" Input.FindGlobal @@ -1142,7 +1140,7 @@ findIn, findInAll :: InputPattern findIn = findIn' "find-in" Input.FindLocal findInAll = findIn' "find-in.all" Input.FindLocalAndDeps -findIn' :: String -> (Path.Path -> Input.FindScope) -> InputPattern +findIn' :: String -> (Path' -> Input.FindScope) -> InputPattern findIn' cmd mkfscope = InputPattern cmd @@ -1151,7 +1149,7 @@ findIn' cmd mkfscope = [("namespace", Required, namespaceArg), ("query", ZeroPlus, exactDefinitionArg)] findHelp \case - p : args -> Input.FindI False . mkfscope <$> handlePathArg p <*> pure (unifyArgument <$> args) + p : args -> Input.FindI False . mkfscope <$> handlePath'Arg p <*> pure (unifyArgument <$> args) _ -> Left findHelp findHelp :: P.Pretty CT.ColorText @@ -1229,7 +1227,7 @@ findVerbose = ( "`find.verbose` searches for definitions like `find`, but includes hashes " <> "and aliases in the results." ) - (pure . Input.FindI True (Input.FindLocal Path.empty) . fmap unifyArgument) + (pure . Input.FindI True (Input.FindLocal Path.relativeEmpty') . fmap unifyArgument) findVerboseAll :: InputPattern findVerboseAll = @@ -1241,7 +1239,7 @@ findVerboseAll = ( "`find.all.verbose` searches for definitions like `find.all`, but includes hashes " <> "and aliases in the results." ) - (pure . Input.FindI True (Input.FindLocalAndDeps Path.empty) . fmap unifyArgument) + (pure . Input.FindI True (Input.FindLocalAndDeps Path.relativeEmpty') . fmap unifyArgument) renameTerm :: InputPattern renameTerm = diff --git a/unison-share-api/src/Unison/Server/Local.hs b/unison-share-api/src/Unison/Server/Local.hs index 91ba6269f4..f5c3525f46 100644 --- a/unison-share-api/src/Unison/Server/Local.hs +++ b/unison-share-api/src/Unison/Server/Local.hs @@ -45,7 +45,7 @@ relocateToNameRoot perspective query rootBranch = do (_sharedPrefix, remainder, Path.Empty) -> do -- Since the project is higher up, we need to prefix the query -- with the remainder of the path - pure . Right $ (projectRoot, query <&> Path.prefixName (Path.Absolute remainder)) + pure $ Right (projectRoot, query <&> Path.prefixNameIfRel (Path.AbsolutePath' $ Path.Absolute remainder)) -- The namesRoot and project root are disjoint, this shouldn't ever happen. (_, _, _) -> pure $ Left (DisjointProjectAndPerspective perspective projectRoot) diff --git a/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs b/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs index 3ee32ec101..527c8bd634 100644 --- a/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs +++ b/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs @@ -130,7 +130,8 @@ nameSearchForPerspective codebase namesPerspective@Ops.NamesPerspective {pathToM -- Fully qualify a name by prepending the current namespace perspective's path fullyQualifyName :: Name -> Name - fullyQualifyName name = Path.prefixName (Path.Absolute (Path.fromList . coerce $ pathToMountedNameLookup)) name + fullyQualifyName = + Path.prefixNameIfRel (Path.AbsolutePath' . Path.Absolute . Path.fromList $ coerce pathToMountedNameLookup) -- | Look up types in the codebase by short hash, and include builtins. typeReferencesByShortHash :: SH.ShortHash -> Sqlite.Transaction (Set Reference) diff --git a/unison-src/transcripts/fix5055.output.md b/unison-src/transcripts/fix5055.output.md index 05506bac00..8dc31da207 100644 --- a/unison-src/transcripts/fix5055.output.md +++ b/unison-src/transcripts/fix5055.output.md @@ -55,10 +55,8 @@ test-5055/main> ls foo test-5055/main> view 1 - .__projects._8e3f0836_9520_436c_bc83_398857c869a7.branches._6fb370f4_774e_495a_a8ff_caec833fdcc8.foo.add : - Int -> Int -> Int - .__projects._8e3f0836_9520_436c_bc83_398857c869a7.branches._6fb370f4_774e_495a_a8ff_caec833fdcc8.foo.add - x y = + foo.add : Int -> Int -> Int + foo.add x y = use Int + x + y From 24ff8b5cb01d998a95369a578d5e1fe238add7e9 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 7 Jun 2024 00:17:44 -0500 Subject: [PATCH 109/631] =?UTF-8?q?Show=20that=20you=20can=E2=80=99t=20`ls?= =?UTF-8?q?`=20the=20results=20of=20`ls`?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- unison-src/transcripts/fix-ls.md | 16 ++++++ unison-src/transcripts/fix-ls.output.md | 65 +++++++++++++++++++++++++ 2 files changed, 81 insertions(+) create mode 100644 unison-src/transcripts/fix-ls.md create mode 100644 unison-src/transcripts/fix-ls.output.md diff --git a/unison-src/transcripts/fix-ls.md b/unison-src/transcripts/fix-ls.md new file mode 100644 index 0000000000..3bd9fe5349 --- /dev/null +++ b/unison-src/transcripts/fix-ls.md @@ -0,0 +1,16 @@ +```ucm +.> project.create-empty test-ls +test-ls/main> builtins.merge +``` + +```unison +foo.bar.add x y = x Int.+ y + +foo.bar.subtract x y = x Int.- y +``` + +```ucm +test-ls/main> add +test-ls/main> ls foo +test-ls/main> ls 1 +``` diff --git a/unison-src/transcripts/fix-ls.output.md b/unison-src/transcripts/fix-ls.output.md new file mode 100644 index 0000000000..48a4d5fc9c --- /dev/null +++ b/unison-src/transcripts/fix-ls.output.md @@ -0,0 +1,65 @@ +```ucm +.> project.create-empty test-ls + + 🎉 I've created the project test-ls. + + 🎨 Type `ui` to explore this project's code in your browser. + 🔭 Discover libraries at https://share.unison-lang.org + 📖 Use `help-topic projects` to learn more about projects. + + Write your first Unison code with UCM: + + 1. Open scratch.u. + 2. Write some Unison code and save the file. + 3. In UCM, type `add` to save it to your new project. + + 🎉 🥳 Happy coding! + +test-ls/main> builtins.merge + + Done. + +``` +```unison +foo.bar.add x y = x Int.+ y + +foo.bar.subtract x y = x Int.- y +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + foo.bar.add : Int -> Int -> Int + foo.bar.subtract : Int -> Int -> Int + +``` +```ucm +test-ls/main> add + + ⍟ I've added these definitions: + + foo.bar.add : Int -> Int -> Int + foo.bar.subtract : Int -> Int -> Int + +test-ls/main> ls foo + + 1. bar/ (2 terms) + +test-ls/main> ls 1 + +``` + + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + +Expected a namespace, but the numbered arg resulted in foo.bar, which is a name. From e32138c2153ccc567c5f687bf9cbd6ded9399e06 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 7 Jun 2024 00:40:16 -0500 Subject: [PATCH 110/631] Treat `Name` as `Path'` in `InputPattern` handlers MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This fixes an issue where `ls` results couldn’t be used as numbered args by commands which expected a `Path`. --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 14 ++++++++++++-- unison-src/transcripts/fix-ls.output.md | 11 +++-------- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index ac1dcb4f44..e56b5c8ace 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -416,7 +416,16 @@ handlePathArg = \case SA.Name name -> pure $ Path.fromName name SA.NameWithBranchPrefix _ name -> pure $ Path.fromName name - otherArgType -> Left $ wrongStructuredArgument "a relative path" otherArgType + otherArgType -> + either + (const . Left $ wrongStructuredArgument "a relative path" otherArgType) + ( \name -> + if Name.isRelative name + then pure $ Path.fromName name + else Left $ wrongStructuredArgument "a relative path" otherArgType + ) + . handleNameArg + $ pure otherArgType handlePath'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path' handlePath'Arg = @@ -427,7 +436,8 @@ handlePath'Arg = SA.Name name -> pure $ Path.fromName' name SA.NameWithBranchPrefix mprefix name -> pure . Path.fromName' $ foldr (Path.prefixNameIfRel . Path.AbsolutePath') name mprefix - otherArgType -> Left $ wrongStructuredArgument "a namespace" otherArgType + otherArgType -> + bimap (const $ wrongStructuredArgument "a path" otherArgType) Path.fromName' . handleNameArg $ pure otherArgType handleNewName :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split' handleNewName = diff --git a/unison-src/transcripts/fix-ls.output.md b/unison-src/transcripts/fix-ls.output.md index 48a4d5fc9c..0f6b6ff1f5 100644 --- a/unison-src/transcripts/fix-ls.output.md +++ b/unison-src/transcripts/fix-ls.output.md @@ -54,12 +54,7 @@ test-ls/main> ls foo test-ls/main> ls 1 -``` - - + 1. add (Int -> Int -> Int) + 2. subtract (Int -> Int -> Int) -🛑 - -The transcript failed due to an error in the stanza above. The error is: - -Expected a namespace, but the numbered arg resulted in foo.bar, which is a name. +``` From 3f44257cd879e81d089f40199790fa1013f7264d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 09:47:09 -0700 Subject: [PATCH 111/631] Better project-branch centric utils --- unison-cli/src/Unison/Cli/MonadUtils.hs | 44 +++++++++---------- unison-cli/src/Unison/Cli/NamesUtils.hs | 13 ++++-- unison-cli/src/Unison/Cli/PrettyPrintUtils.hs | 7 +++ 3 files changed, 37 insertions(+), 27 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 6f104bf8ce..883113ca32 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -108,7 +108,6 @@ import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path (Path, Path' (..)) import Unison.Codebase.Path qualified as Path -import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH @@ -398,7 +397,7 @@ stepManyAt :: [(Path.Absolute, Branch0 IO -> Branch0 IO)] -> Cli () stepManyAt pb reason actions = do - updateProjectBranchRoot_ reason pb $ Branch.stepManyAt (makeActionsUnabsolute actions) + updateProjectBranchRoot_ pb reason $ Branch.stepManyAt (makeActionsUnabsolute actions) stepManyAt' :: ProjectBranch -> @@ -408,7 +407,7 @@ stepManyAt' :: stepManyAt' pb reason actions = do origRoot <- getProjectBranchRoot pb newRoot <- Branch.stepManyAtM (makeActionsUnabsolute actions) origRoot - didChange <- updateProjectBranchRoot reason pb (\oldRoot -> pure (newRoot, oldRoot /= newRoot)) + didChange <- updateProjectBranchRoot pb reason (\oldRoot -> pure (newRoot, oldRoot /= newRoot)) pure didChange -- Like stepManyAt, but doesn't update the last saved root @@ -418,32 +417,34 @@ stepManyAtM :: [(Path.Absolute, Branch0 IO -> IO (Branch0 IO))] -> Cli () stepManyAtM pb reason actions = do - updateProjectBranchRoot reason pb \oldRoot -> do + updateProjectBranchRoot pb reason \oldRoot -> do newRoot <- liftIO (Branch.stepManyAtM (makeActionsUnabsolute actions) oldRoot) pure (newRoot, ()) -- | Update a branch at the given path, returning `True` if -- an update occurred and false otherwise updateAtM :: + ProjectBranch -> Text -> - ProjectPath -> + Path.Absolute -> (Branch IO -> Cli (Branch IO)) -> Cli Bool -updateAtM reason pp f = do - old <- getBranchFromProjectPath (pp & PP.absPath_ .~ Path.absoluteEmpty) - new <- Branch.modifyAtM (pp ^. PP.path_) f old - updateCurrentProjectBranchRoot reason (const new) - pure $ old /= new +updateAtM pb reason path f = do + oldRootBranch <- getProjectBranchRoot pb + newRootBranch <- Branch.modifyAtM (Path.unabsolute path) f oldRootBranch + updateProjectBranchRoot_ pb reason (const newRootBranch) + pure $ oldRootBranch /= newRootBranch -- | Update a branch at the given path, returning `True` if -- an update occurred and false otherwise updateAt :: + ProjectBranch -> Text -> - ProjectPath -> + Path.Absolute -> (Branch IO -> Branch IO) -> Cli Bool -updateAt reason p f = do - updateAtM reason p (pure . f) +updateAt pb reason p f = do + updateAtM pb reason p (pure . f) updateAndStepAt :: (Foldable f, Foldable g, Functor g) => @@ -457,15 +458,10 @@ updateAndStepAt reason projectBranch updates steps = do b & (\root -> foldl' (\b (Path.Absolute p, f) -> Branch.modifyAt p f b) root updates) & (Branch.stepManyAt (first Path.unabsolute <$> steps)) - updateProjectBranchRoot_ reason projectBranch f - -updateCurrentProjectBranchRoot :: Text -> (Branch IO -> Branch IO) -> Cli () -updateCurrentProjectBranchRoot reason f = do - pp <- getCurrentProjectPath - updateProjectBranchRoot_ reason (pp ^. #branch) f + updateProjectBranchRoot_ projectBranch reason f -updateProjectBranchRoot :: Text -> ProjectBranch -> (Branch IO -> Cli (Branch IO, r)) -> Cli r -updateProjectBranchRoot reason projectBranch f = do +updateProjectBranchRoot :: ProjectBranch -> Text -> (Branch IO -> Cli (Branch IO, r)) -> Cli r +updateProjectBranchRoot projectBranch reason f = do error "implement project-branch reflog" reason Cli.Env {codebase} <- ask Cli.time "updateProjectBranchRoot" do @@ -478,9 +474,9 @@ updateProjectBranchRoot reason projectBranch f = do setCurrentProjectRoot new pure result -updateProjectBranchRoot_ :: Text -> ProjectBranch -> (Branch IO -> Branch IO) -> Cli () -updateProjectBranchRoot_ reason projectBranch f = do - updateProjectBranchRoot reason projectBranch (\b -> pure (f b, ())) +updateProjectBranchRoot_ :: ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli () +updateProjectBranchRoot_ projectBranch reason f = do + updateProjectBranchRoot projectBranch reason (\b -> pure (f b, ())) ------------------------------------------------------------------------------------------------------------------------ -- Getting terms diff --git a/unison-cli/src/Unison/Cli/NamesUtils.hs b/unison-cli/src/Unison/Cli/NamesUtils.hs index 0c8e5c1060..889e055bdf 100644 --- a/unison-cli/src/Unison/Cli/NamesUtils.hs +++ b/unison-cli/src/Unison/Cli/NamesUtils.hs @@ -1,12 +1,15 @@ -- | Utilities that have to do with constructing names objects. module Unison.Cli.NamesUtils ( currentNames, - projectRootNames, + currentProjectRootNames, + projectBranchNames, ) where +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch) import Unison.Cli.Monad (Cli) import Unison.Cli.MonadUtils qualified as Cli +import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Names (Names) @@ -15,6 +18,10 @@ currentNames :: Cli Names currentNames = do Branch.toNames <$> Cli.getCurrentBranch0 -projectRootNames :: Cli Names -projectRootNames = do +currentProjectRootNames :: Cli Names +currentProjectRootNames = do Branch.toNames <$> Cli.getCurrentProjectRoot0 + +projectBranchNames :: ProjectBranch -> Cli Names +projectBranchNames pb = do + Branch.toNames . Branch.head <$> Cli.getProjectBranchRoot pb diff --git a/unison-cli/src/Unison/Cli/PrettyPrintUtils.hs b/unison-cli/src/Unison/Cli/PrettyPrintUtils.hs index 17abdd49c5..8ee18756f4 100644 --- a/unison-cli/src/Unison/Cli/PrettyPrintUtils.hs +++ b/unison-cli/src/Unison/Cli/PrettyPrintUtils.hs @@ -3,9 +3,11 @@ module Unison.Cli.PrettyPrintUtils ( prettyPrintEnvDeclFromNames, currentPrettyPrintEnvDecl, + projectBranchPPED, ) where +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.NamesUtils qualified as Cli @@ -14,6 +16,7 @@ import Unison.Names (Names) import Unison.Prelude import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo) +import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.PrettyPrintEnvDecl.Names qualified as PPED -- | Builds a pretty print env decl from a names object. @@ -30,3 +33,7 @@ prettyPrintEnvDeclFromNames ns = currentPrettyPrintEnvDecl :: Cli PPE.PrettyPrintEnvDecl currentPrettyPrintEnvDecl = do Cli.currentNames >>= prettyPrintEnvDeclFromNames + +projectBranchPPED :: ProjectBranch -> Cli PPED.PrettyPrintEnvDecl +projectBranchPPED pb = do + Cli.projectBranchNames pb >>= prettyPrintEnvDeclFromNames From 276758fee39541d454bcea3efc84d43246830950 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 09:47:09 -0700 Subject: [PATCH 112/631] More command cleanups --- unison-cli/src/Unison/Cli/MonadUtils.hs | 19 +++++++++---------- unison-cli/src/Unison/Cli/Pretty.hs | 5 ++++- .../Codebase/Editor/HandleInput/InstallLib.hs | 7 +++++-- .../HandleInput/NamespaceDependencies.hs | 19 +++++++------------ .../Editor/HandleInput/ProjectClone.hs | 1 - .../Codebase/Editor/HandleInput/Update2.hs | 3 ++- .../src/Unison/Codebase/Editor/Output.hs | 5 +++-- .../src/Unison/CommandLine/OutputMessages.hs | 12 +----------- 8 files changed, 31 insertions(+), 40 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 883113ca32..a947d1e3f9 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -108,6 +108,7 @@ import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path (Path, Path' (..)) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH @@ -424,27 +425,25 @@ stepManyAtM pb reason actions = do -- | Update a branch at the given path, returning `True` if -- an update occurred and false otherwise updateAtM :: - ProjectBranch -> Text -> - Path.Absolute -> + ProjectPath -> (Branch IO -> Cli (Branch IO)) -> Cli Bool -updateAtM pb reason path f = do - oldRootBranch <- getProjectBranchRoot pb - newRootBranch <- Branch.modifyAtM (Path.unabsolute path) f oldRootBranch - updateProjectBranchRoot_ pb reason (const newRootBranch) +updateAtM reason pp f = do + oldRootBranch <- getProjectBranchRoot (pp ^. #branch) + newRootBranch <- Branch.modifyAtM (pp ^. PP.path_) f oldRootBranch + updateProjectBranchRoot_ (pp ^. #branch) reason (const newRootBranch) pure $ oldRootBranch /= newRootBranch -- | Update a branch at the given path, returning `True` if -- an update occurred and false otherwise updateAt :: - ProjectBranch -> Text -> - Path.Absolute -> + ProjectPath -> (Branch IO -> Branch IO) -> Cli Bool -updateAt pb reason p f = do - updateAtM pb reason p (pure . f) +updateAt reason pp f = do + updateAtM reason pp (pure . f) updateAndStepAt :: (Foldable f, Foldable g, Functor g) => diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index aa78c1ffcf..c45ca85011 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -346,7 +346,10 @@ prettyTypeName ppe r = prettyWhichBranchEmpty :: WhichBranchEmpty -> Pretty prettyWhichBranchEmpty = \case WhichBranchEmptyHash hash -> P.shown hash - WhichBranchEmptyPath path -> prettyPath' path + WhichBranchEmptyPath p -> + case p of + Left pp -> prettyProjectPath pp + Right path' -> prettyPath' path' -- | Displays a full, non-truncated Branch.CausalHash to a string, e.g. #abcdef displayBranchHash :: CausalHash -> Text diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs index 426a457f66..52e70188c8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs @@ -20,6 +20,7 @@ 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.Codebase.ProjectPath qualified as PP import Unison.Core.Project (ProjectBranchName) import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment (libSegment) @@ -69,7 +70,7 @@ handleInstallLib remind (ProjectAndBranch libdepProjectName unresolvedLibdepBran -- -- 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.getProjectRoot0 + currentBranchObject <- Cli.getCurrentProjectRoot0 pure $ fresh (\i -> NameSegment.unsafeParseText . (<> "__" <> tShow i) . NameSegment.toUnescapedText) @@ -83,7 +84,9 @@ handleInstallLib remind (ProjectAndBranch libdepProjectName unresolvedLibdepBran libdepPath = Path.Absolute $ Path.fromList [NameSegment.libSegment, libdepNameSegment] let reflogDescription = "lib.install " <> into @Text libdepProjectAndBranchNames - _didUpdate <- Cli.updateAt reflogDescription libdepPath (\_empty -> remoteBranchObject) + pp <- Cli.getCurrentProjectPath + let libDepPP = pp & PP.absPath_ .~ libdepPath + _didUpdate <- Cli.updateAt reflogDescription libDepPP (\_empty -> remoteBranchObject) Cli.respond (Output.InstalledLibdep libdepProjectAndBranchNames libdepNameSegment) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs index 098870a301..66f3f0c3af 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs @@ -14,7 +14,6 @@ import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch -import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path import Unison.DataDeclaration qualified as DD @@ -22,7 +21,6 @@ import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.NameSegment qualified as NameSegment -import Unison.Names qualified as Names import Unison.Prelude import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.Reference qualified as Reference @@ -35,19 +33,16 @@ import Unison.Util.Relation qualified as Relation handleNamespaceDependencies :: Maybe Path.Path' -> Cli.Cli () handleNamespaceDependencies namespacePath' = do Cli.Env {codebase} <- ask - path <- maybe Cli.getCurrentPath Cli.resolvePath' namespacePath' + pp <- maybe Cli.getCurrentProjectPath Cli.resolvePath' namespacePath' + let pb = pp ^. #branch branch <- - Cli.getMaybeBranch0FromProjectRootPath path & onNothingM do - Cli.returnEarly (Output.BranchEmpty (Output.WhichBranchEmptyPath (Path.absoluteToPath' path))) + Cli.getMaybeBranch0FromProjectPath pp & onNothingM do + Cli.returnEarly (Output.BranchEmpty (Output.WhichBranchEmptyPath (Left pp))) externalDependencies <- Cli.runTransaction (namespaceDependencies codebase branch) - currentPPED <- Cli.currentPrettyPrintEnvDecl - rootNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getProjectRoot0 - rootPPED <- Cli.prettyPrintEnvDeclFromNames rootNames - -- We explicitly include a global unsuffixified fallback on namespace dependencies since - -- the things we want names for are obviously outside of our scope. - let ppeWithFallback = PPED.unsuffixifiedPPE $ PPED.addFallback rootPPED currentPPED - Cli.respondNumbered $ Output.ListNamespaceDependencies ppeWithFallback path externalDependencies + pped <- Cli.projectBranchPPED pb + let ppe = PPED.unsuffixifiedPPE pped + Cli.respondNumbered $ Output.ListNamespaceDependencies ppe pp externalDependencies -- | Check the dependencies of all types and terms in the current namespace, -- returns a map of dependencies which do not have a name within the current namespace, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs index 5e9de5085a..6a611c913c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs @@ -17,7 +17,6 @@ import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli (updateAt) -import Unison.Cli.ProjectUtils (projectBranchPath) import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Cli.Share.Projects qualified as Share import Unison.Codebase qualified as Codebase diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 93c3a29b93..d7ee79afd1 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -205,7 +205,8 @@ saveTuf getConstructors tuf = do Cli.runTransactionWithRollback \abort -> do Codebase.addDefsToCodebase codebase tuf typecheckedUnisonFileToBranchUpdates abort getConstructors tuf - Cli.stepAt "update" (currentPath, Branch.batchUpdates branchUpdates) + pb <- Cli.getCurrentProjectBranch + Cli.stepAt pb "update" (currentPath, Branch.batchUpdates branchUpdates) -- @typecheckedUnisonFileToBranchUpdates getConstructors file@ returns a list of branch updates (suitable for passing -- along to `batchUpdates` or some "step at" combinator) that corresponds to using all of the contents of @file@. diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index caaad9e9c8..ff7f44c325 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -41,6 +41,7 @@ import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Codebase.IntegrityCheck (IntegrityResult (..)) import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.PushBehavior (PushBehavior) import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash (ShortCausalHash) @@ -138,7 +139,7 @@ data NumberedOutput | -- | List all direct dependencies which don't have any names in the current branch ListNamespaceDependencies PPE.PrettyPrintEnv -- PPE containing names for everything from the root namespace. - Path.Absolute -- The namespace we're checking dependencies for. + ProjectPath -- The namespace we're checking dependencies for. (Map LabeledDependency (Set Name)) -- Mapping of external dependencies to their local dependents. data AmbiguousReset'Argument @@ -425,7 +426,7 @@ data CreatedProjectBranchFrom -- | A branch was empty. But how do we refer to that branch? data WhichBranchEmpty = WhichBranchEmptyHash ShortCausalHash - | WhichBranchEmptyPath Path' + | WhichBranchEmptyPath (Either ProjectPath Path') data ShareError = ShareErrorCheckAndSetPush Sync.CheckAndSetPushError diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index b9d50a373d..5645ce7458 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -494,7 +494,7 @@ notifyNumbered = \case absPath0 = Path.Absolute path ListNamespaceDependencies _ppe _path Empty -> ("This namespace has no external dependencies.", mempty) ListNamespaceDependencies ppe path' externalDependencies -> - ( P.column2Header (P.hiBlack "External dependency") ("Dependents in " <> prettyAbsolute path') $ + ( P.column2Header (P.hiBlack "External dependency") ("Dependents in " <> prettyProjectPath path') $ List.intersperse spacer (externalDepsTable externalDependencies), numberedArgs ) @@ -2068,16 +2068,6 @@ notifyUser dir = \case <> P.group (P.text (NameSegment.toEscapedText new) <> ",") <> "and removed" <> P.group (P.text (NameSegment.toEscapedText old) <> ".") - LooseCodePushDeprecated -> - pure . P.warnCallout $ - P.lines $ - [ P.wrap $ "Unison Share's projects are now the new preferred way to store code, and storing code outside of a project has been deprecated.", - "", - P.wrap $ "Learn how to convert existing code into a project using this guide: ", - "https://www.unison-lang.org/docs/tooling/projects-library-migration/", - "", - "Your non-project code is still available to pull from Share, and you can pull it into a local namespace using `pull myhandle.public`" - ] MergeFailure path aliceAndBob -> pure . P.wrap $ "I couldn't automatically merge" From 3aa8fccea61eff31c34d1c3a498ad5ab8849eecc Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 10:12:01 -0700 Subject: [PATCH 113/631] Fix up Project Clone --- .../U/Codebase/Sqlite/Queries.hs | 5 +- .../Editor/HandleInput/ProjectClone.hs | 140 ++++++++---------- 2 files changed, 66 insertions(+), 79 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index a896cbcea8..80fcc36ae7 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3687,8 +3687,9 @@ loadProjectAndBranchNames projectId branchId = |] -- | Insert a project branch. -insertProjectBranch :: CausalHashId -> ProjectBranch -> Transaction () -insertProjectBranch causalHashId (ProjectBranch projectId branchId branchName maybeParentBranchId) = do +insertProjectBranch :: Text -> CausalHashId -> ProjectBranch -> Transaction () +insertProjectBranch description causalHashId (ProjectBranch projectId branchId branchName maybeParentBranchId) = do + error "Implement Project Reflog on creation" description execute [sql| INSERT INTO project_branch (project_id, branch_id, name, causal_hash_id) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs index 6a611c913c..c3d5f25cd6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs @@ -5,23 +5,21 @@ module Unison.Codebase.Editor.HandleInput.ProjectClone where import Control.Lens (_2) -import Control.Monad.Reader (ask) import Data.These (These (..)) import Data.UUID.V4 qualified as UUID import U.Codebase.Sqlite.DbId (ProjectBranchId (..), ProjectId (..)) import U.Codebase.Sqlite.DbId qualified as Sqlite import U.Codebase.Sqlite.Project qualified as Sqlite (Project (..)) import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite +import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.MonadUtils qualified as Cli (updateAt) +import Unison.Cli.MonadUtils qualified as Cli (getCurrentProjectAndBranch) import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Cli.Share.Projects qualified as Share -import Unison.Codebase qualified as Codebase import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path (Path) import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (..), ProjectBranchName, ProjectName, projectNameUserSlug) import Unison.Sqlite qualified as Sqlite @@ -38,9 +36,9 @@ data RemoteProjectKey -- | Clone a remote branch. handleClone :: ProjectAndBranchNames -> Maybe ProjectAndBranchNames -> Cli () handleClone remoteNames0 maybeLocalNames0 = do - maybeCurrentProjectBranch <- ProjectUtils.getCurrentProjectBranch - resolvedRemoteNames <- resolveRemoteNames Share.NoSquashedHead maybeCurrentProjectBranch remoteNames0 - localNames1 <- resolveLocalNames maybeCurrentProjectBranch resolvedRemoteNames maybeLocalNames0 + currentProjectBranch <- Cli.getCurrentProjectAndBranch + resolvedRemoteNames <- resolveRemoteNames Share.NoSquashedHead currentProjectBranch remoteNames0 + localNames1 <- resolveLocalNames currentProjectBranch resolvedRemoteNames maybeLocalNames0 cloneInto localNames1 resolvedRemoteNames.branch data ResolvedRemoteNames = ResolvedRemoteNames @@ -77,63 +75,59 @@ data ResolvedRemoteNamesFrom -- otherwise abort resolveRemoteNames :: Share.IncludeSquashedHead -> - Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch, Path) -> + (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -> ProjectAndBranchNames -> Cli ResolvedRemoteNames -resolveRemoteNames includeSquashed maybeCurrentProjectBranch = \case - ProjectAndBranchNames'Ambiguous remoteProjectName remoteBranchName -> - case maybeCurrentProjectBranch of - Nothing -> resolveP remoteProjectName - Just (currentProjectAndBranch, _path) -> - case projectNameUserSlug remoteProjectName of - Nothing -> resolveB remoteBranchName - Just _ -> - Cli.runTransaction (loadAssociatedRemoteProjectId currentProjectAndBranch) >>= \case - Nothing -> resolveP remoteProjectName - Just remoteBranchProjectId -> do - -- Fetching these in parallel would be an improvement - maybeRemoteProject <- Share.getProjectByName remoteProjectName - maybeRemoteBranch <- - Share.getProjectBranchByName includeSquashed (ProjectAndBranch remoteBranchProjectId remoteBranchName) <&> \case - Share.GetProjectBranchResponseBranchNotFound -> Nothing - Share.GetProjectBranchResponseProjectNotFound -> Nothing - Share.GetProjectBranchResponseSuccess remoteBranch -> Just remoteBranch - case (maybeRemoteProject, maybeRemoteBranch) of - (Just remoteProject, Nothing) -> do - let remoteProjectId = remoteProject.projectId - let remoteProjectName = remoteProject.projectName - let remoteBranchName = unsafeFrom @Text "main" - remoteBranch <- - ProjectUtils.expectRemoteProjectBranchByName - includeSquashed - (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName) - pure - ResolvedRemoteNames - { branch = remoteBranch, - from = ResolvedRemoteNamesFrom'Project - } - (Nothing, Just remoteBranch) -> - pure - ResolvedRemoteNames - { branch = remoteBranch, - from = ResolvedRemoteNamesFrom'Branch - } - -- Treat neither existing and both existing uniformly as "ambiguous input" - -- Alternatively, if neither exist, we could instead say "although your input was ambiguous, disambuating - -- wouldn't help, because we did enough work to know neither thing exists" - _ -> do - branchProjectName <- - Cli.runTransaction (Queries.expectRemoteProjectName remoteBranchProjectId Share.hardCodedUri) - Cli.returnEarly $ - Output.AmbiguousCloneRemote - remoteProjectName - (ProjectAndBranch branchProjectName remoteBranchName) +resolveRemoteNames includeSquashed currentProjectAndBranch = \case + ProjectAndBranchNames'Ambiguous remoteProjectName remoteBranchName -> do + case projectNameUserSlug remoteProjectName of + Nothing -> resolveB remoteBranchName + Just _ -> + Cli.runTransaction (loadAssociatedRemoteProjectId currentProjectAndBranch) >>= \case + Nothing -> resolveP remoteProjectName + Just remoteBranchProjectId -> do + -- Fetching these in parallel would be an improvement + maybeRemoteProject <- Share.getProjectByName remoteProjectName + maybeRemoteBranch <- + Share.getProjectBranchByName includeSquashed (ProjectAndBranch remoteBranchProjectId remoteBranchName) <&> \case + Share.GetProjectBranchResponseBranchNotFound -> Nothing + Share.GetProjectBranchResponseProjectNotFound -> Nothing + Share.GetProjectBranchResponseSuccess remoteBranch -> Just remoteBranch + case (maybeRemoteProject, maybeRemoteBranch) of + (Just remoteProject, Nothing) -> do + let remoteProjectId = remoteProject.projectId + let remoteProjectName = remoteProject.projectName + let remoteBranchName = unsafeFrom @Text "main" + remoteBranch <- + ProjectUtils.expectRemoteProjectBranchByName + includeSquashed + (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName) + pure + ResolvedRemoteNames + { branch = remoteBranch, + from = ResolvedRemoteNamesFrom'Project + } + (Nothing, Just remoteBranch) -> + pure + ResolvedRemoteNames + { branch = remoteBranch, + from = ResolvedRemoteNamesFrom'Branch + } + -- Treat neither existing and both existing uniformly as "ambiguous input" + -- Alternatively, if neither exist, we could instead say "although your input was ambiguous, disambuating + -- wouldn't help, because we did enough work to know neither thing exists" + _ -> do + branchProjectName <- + Cli.runTransaction (Queries.expectRemoteProjectName remoteBranchProjectId Share.hardCodedUri) + Cli.returnEarly $ + Output.AmbiguousCloneRemote + remoteProjectName + (ProjectAndBranch branchProjectName remoteBranchName) ProjectAndBranchNames'Unambiguous (This p) -> resolveP p ProjectAndBranchNames'Unambiguous (That b) -> resolveB b ProjectAndBranchNames'Unambiguous (These p b) -> resolvePB p b where resolveB branchName = do - (currentProjectAndBranch, _path) <- maybeCurrentProjectBranch & onNothing (Cli.returnEarly Output.NotOnProjectBranch) remoteProjectId <- Cli.runTransaction (loadAssociatedRemoteProjectId currentProjectAndBranch) & onNothingM do Cli.returnEarly (Output.NoAssociatedRemoteProjectBranch Share.hardCodedUri currentProjectAndBranch) @@ -180,11 +174,11 @@ resolveRemoteNames includeSquashed maybeCurrentProjectBranch = \case -- `clone @foo/bar` resulted in treating `@foo/bar` as a contributor branch of the current project, then it is as if -- the user typed `clone /@foo/bar` instead, which is equivalent to the two-arg `clone /@foo/bar /@foo/bar`. resolveLocalNames :: - Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch, Path) -> + (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -> ResolvedRemoteNames -> Maybe ProjectAndBranchNames -> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName) -resolveLocalNames maybeCurrentProjectBranch resolvedRemoteNames maybeLocalNames = +resolveLocalNames (ProjectAndBranch currentProject _) resolvedRemoteNames maybeLocalNames = resolve case maybeLocalNames of Nothing -> ProjectAndBranchNames'Unambiguous case resolvedRemoteNames.from of @@ -198,14 +192,11 @@ resolveLocalNames maybeCurrentProjectBranch resolvedRemoteNames maybeLocalNames resolve names = case names of - ProjectAndBranchNames'Ambiguous localProjectName localBranchName -> - case maybeCurrentProjectBranch of - Nothing -> resolveP localProjectName - Just (ProjectAndBranch currentProject _, _path) -> do - Cli.returnEarly $ - Output.AmbiguousCloneLocal - (ProjectAndBranch localProjectName remoteBranchName) - (ProjectAndBranch currentProject.name localBranchName) + ProjectAndBranchNames'Ambiguous localProjectName localBranchName -> do + Cli.returnEarly $ + Output.AmbiguousCloneLocal + (ProjectAndBranch localProjectName remoteBranchName) + (ProjectAndBranch currentProject.name localBranchName) ProjectAndBranchNames'Unambiguous (This localProjectName) -> resolveP localProjectName ProjectAndBranchNames'Unambiguous (That localBranchName) -> resolveB localBranchName ProjectAndBranchNames'Unambiguous (These localProjectName localBranchName) -> resolvePB localProjectName localBranchName @@ -214,8 +205,6 @@ resolveLocalNames maybeCurrentProjectBranch resolvedRemoteNames maybeLocalNames go (LocalProjectKey'Name localProjectName) remoteBranchName resolveB localBranchName = do - (ProjectAndBranch currentProject _, _path) <- - maybeCurrentProjectBranch & onNothing (Cli.returnEarly Output.NotOnProjectBranch) go (LocalProjectKey'Project currentProject) localBranchName resolvePB localProjectName localBranchName = @@ -253,13 +242,14 @@ cloneInto localProjectBranch remoteProjectBranch = do pure (localProjectId, localProjectName) Right localProject -> pure (localProject.projectId, localProject.name) localBranchId <- Sqlite.unsafeIO (ProjectBranchId <$> UUID.nextRandom) + causalHashId <- Q.expectCausalHashIdByCausalHash branchHead Queries.insertProjectBranch + causalHashId Sqlite.ProjectBranch { projectId = localProjectId, branchId = localBranchId, name = localProjectBranch.branch, - parentBranchId = Nothing, - rootCausalHash = error "Add causal hash id in cloneInto" + parentBranchId = Nothing } Queries.insertBranchRemoteMapping localProjectId @@ -277,12 +267,8 @@ cloneInto localProjectBranch remoteProjectBranch = do localProjectBranch.branch ) - -- Manipulate the root namespace and cd - Cli.Env {codebase} <- ask - theBranch <- liftIO (Codebase.expectBranchForHash codebase branchHead) - let path = projectBranchPath (over #project fst localProjectAndBranch) - Cli.updateAt ("clone " <> into @Text remoteProjectBranchNames) path (const theBranch) - Cli.cd path + let newProjectAndBranch = (over #project fst localProjectAndBranch) + Cli.switchProject newProjectAndBranch -- Return the remote project id associated with the given project branch loadAssociatedRemoteProjectId :: From c42d128371767d49a94c303caeb6641d3974f9e2 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 10:19:51 -0700 Subject: [PATCH 114/631] Fix up ProjectCreate --- .../U/Codebase/Sqlite/Queries.hs | 15 ++++-- .../Editor/HandleInput/ProjectCreate.hs | 53 +++++++++---------- 2 files changed, 37 insertions(+), 31 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 80fcc36ae7..08cd1fe977 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3688,8 +3688,12 @@ loadProjectAndBranchNames projectId branchId = -- | Insert a project branch. insertProjectBranch :: Text -> CausalHashId -> ProjectBranch -> Transaction () -insertProjectBranch description causalHashId (ProjectBranch projectId branchId branchName maybeParentBranchId) = do - error "Implement Project Reflog on creation" description +insertProjectBranch _description causalHashId (ProjectBranch projectId branchId branchName maybeParentBranchId) = do + -- Ensure we never point at a causal we don't have the branch for. + _ <- expectBranchObjectIdByCausalHashId causalHashId + + error "Implement project branch reflog" + execute [sql| INSERT INTO project_branch (project_id, branch_id, name, causal_hash_id) @@ -3774,8 +3778,11 @@ deleteProjectBranch projectId branchId = do |] -- | Set project branch HEAD -setProjectBranchHead :: ProjectId -> ProjectBranchId -> CausalHashId -> Transaction () -setProjectBranchHead projectId branchId causalHashId = +setProjectBranchHead :: Text -> ProjectId -> ProjectBranchId -> CausalHashId -> Transaction () +setProjectBranchHead _description projectId branchId causalHashId = do + error "Implement project branch reflog" + -- Ensure we never point at a causal we don't have the branch for. + _ <- expectBranchObjectIdByCausalHashId causalHashId execute [sql| UPDATE project_branch diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs index d986ee68ee..f2c72f3371 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs @@ -4,23 +4,23 @@ module Unison.Codebase.Editor.HandleInput.ProjectCreate ) where +import Control.Lens import Control.Monad.Reader (ask) -import Data.Map.Strict qualified as Map import Data.Text qualified as Text import Data.UUID.V4 qualified as UUID import System.Random.Shuffle qualified as RandomShuffle import U.Codebase.Sqlite.DbId import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite +import U.Codebase.Sqlite.Queries (expectCausalHashIdByCausalHash) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.MonadUtils qualified as Cli (stepAt) import Unison.Cli.Share.Projects qualified as Share import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Causal qualified as Causal import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Path qualified as Path import Unison.NameSegment qualified as NameSegment import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) @@ -126,42 +126,41 @@ projectCreate tryDownloadingBase maybeProjectName = do pure maybeBaseLatestReleaseBranchObject else pure Nothing - let projectBranchObject = - case maybeBaseLatestReleaseBranchObject of - Nothing -> Branch.empty0 - Just baseLatestReleaseBranchObject -> - let -- lib.base - projectBranchLibBaseObject = - over - Branch.children - (Map.insert NameSegment.baseSegment baseLatestReleaseBranchObject) - Branch.empty0 - projectBranchLibObject = Branch.cons projectBranchLibBaseObject Branch.empty - in over - Branch.children - (Map.insert NameSegment.libSegment projectBranchLibObject) - Branch.empty0 - - Cli.stepAt reflogDescription (Path.absoluteEmpty, const projectBranchObject) + for_ maybeBaseLatestReleaseBranchObject \baseLatestReleaseBranchObject -> do + -- lib.base + let projectBranchLibBaseObject = + Branch.empty0 + & Branch.children + . at NameSegment.baseSegment + .~ Just baseLatestReleaseBranchObject + projectBranchLibObject = Branch.cons projectBranchLibBaseObject Branch.empty + let branchWithBase = + Branch.empty + & Branch.history + . Causal.head_ + . Branch.children + . at NameSegment.libSegment + .~ Just projectBranchLibObject + Cli.Env {codebase} <- ask + liftIO $ Codebase.putBranch codebase branchWithBase + Cli.runTransaction $ do + baseBranchCausalHashId <- expectCausalHashIdByCausalHash (Branch.headHash branchWithBase) + Queries.setProjectBranchHead "Include latest base library" projectId branchId baseBranchCausalHashId Cli.respond Output.HappyCoding pure ProjectAndBranch {project = projectId, branch = branchId} - where - reflogDescription = - case maybeProjectName of - Nothing -> "project.create" - Just projectName -> "project.create " <> into @Text projectName insertProjectAndBranch :: ProjectId -> ProjectName -> ProjectBranchId -> ProjectBranchName -> CausalHashId -> Sqlite.Transaction () insertProjectAndBranch projectId projectName branchId branchName chId = do Queries.insertProject projectId projectName Queries.insertProjectBranch + "Project Created" + chId Sqlite.ProjectBranch { projectId, branchId, name = branchName, - parentBranchId = Nothing, - causalHashId = chId + parentBranchId = Nothing } Queries.setMostRecentBranch projectId branchId From b663d44b50039d0c188dfb68a9b0e55fbe9ffe63 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 10:45:20 -0700 Subject: [PATCH 115/631] Finish cleaning up create branch --- unison-cli/src/Unison/Cli/MonadUtils.hs | 3 +- .../Codebase/Editor/HandleInput/Branch.hs | 79 +++++++++---------- .../Codebase/Editor/HandleInput/Upgrade.hs | 28 +++---- 3 files changed, 53 insertions(+), 57 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index a947d1e3f9..94ec894c04 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -461,7 +461,6 @@ updateAndStepAt reason projectBranch updates steps = do updateProjectBranchRoot :: ProjectBranch -> Text -> (Branch IO -> Cli (Branch IO, r)) -> Cli r updateProjectBranchRoot projectBranch reason f = do - error "implement project-branch reflog" reason Cli.Env {codebase} <- ask Cli.time "updateProjectBranchRoot" do old <- getProjectBranchRoot projectBranch @@ -469,7 +468,7 @@ updateProjectBranchRoot projectBranch reason f = do liftIO $ Codebase.putBranch codebase new Cli.runTransaction $ do causalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash new) - Q.setProjectBranchHead (projectBranch ^. #projectId) (projectBranch ^. #branchId) causalHashId + Q.setProjectBranchHead reason (projectBranch ^. #projectId) (projectBranch ^. #branchId) causalHashId setCurrentProjectRoot new pure result diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 1533d56ec6..bfd5efbd09 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -1,8 +1,7 @@ -- | @branch@ input handler module Unison.Codebase.Editor.HandleInput.Branch ( handleBranch, - createBranchFromParent, - createBranchFromNamespace, + createBranch, ) where @@ -11,7 +10,6 @@ import Data.UUID.V4 qualified as UUID import U.Codebase.Sqlite.DbId import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) -import U.Codebase.Sqlite.ProjectBranch qualified as ProjectBranch import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries @@ -29,6 +27,12 @@ import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectBranchNameKind (..), ProjectName, classifyProjectBranchName) import Unison.Sqlite qualified as Sqlite +data CreateFrom + = CreateFrom'NamespaceWithParent Sqlite.ProjectBranch (Branch IO) + | CreateFrom'ParentBranch Sqlite.ProjectBranch + | CreateFrom'Namespace (Branch IO) + | CreateFrom'Nothingness + -- | Create a new project branch from an existing project branch or namespace. handleBranch :: Input.BranchSourceI -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newBranchName) = do @@ -61,7 +65,13 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB pp <- Cli.getCurrentProjectPath Just <$> ProjectUtils.resolveProjectBranch (pp ^. #project) (unresolvedProjectBranch & #branch %~ Just) - _ <- createBranchFromParent (view #branch <$> maySrcProjectAndBranch) destProject newBranchName + case maySrcProjectAndBranch of + Just srcProjectAndBranch -> do + let description = "Branch created from " <> into @Text (srcProjectAndBranch & bimap (view #name) (view #name)) + void $ createBranch description (CreateFrom'ParentBranch (view #branch srcProjectAndBranch)) destProject newBranchName + Nothing -> do + let description = "Empty branch created" + void $ createBranch description CreateFrom'Nothingness destProject newBranchName Cli.respond $ Output.CreatedProjectBranch @@ -83,14 +93,33 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB -- @release.draft@ command, which essentially just creates a branch, but with some different output for the user. -- -- Returns the branch id of the newly-created branch. -createBranchFromParent :: - -- If no parent branch is provided, make an empty branch. - Maybe Sqlite.ProjectBranch -> +createBranch :: + Text -> + CreateFrom -> Sqlite.Project -> ProjectBranchName -> Cli ProjectBranchId -createBranchFromParent mayParentBranch project newBranchName = do +createBranch description createFrom project newBranchName = do let projectId = project ^. #projectId + Cli.Env {codebase} <- ask + (mayParentBranchId, newBranchCausalHashId) <- case createFrom of + CreateFrom'ParentBranch parentBranch -> Cli.runTransaction do + Q.expectProjectBranchHead projectId (parentBranch ^. #branchId) + newBranchCausalHashId <- Q.expectProjectBranchHead projectId (parentBranch ^. #branchId) + pure (Just (parentBranch ^. #branchId), newBranchCausalHashId) + CreateFrom'Nothingness -> Cli.runTransaction do + (_, causalHashId) <- Codebase.emptyCausalHash + pure (Nothing, causalHashId) + CreateFrom'NamespaceWithParent parentBranch namespace -> do + liftIO $ Codebase.putBranch codebase namespace + Cli.runTransaction $ do + newBranchCausalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash namespace) + pure (Just (parentBranch ^. #branchId), newBranchCausalHashId) + CreateFrom'Namespace branch -> do + liftIO $ Codebase.putBranch codebase branch + Cli.runTransaction $ do + newBranchCausalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash branch) + pure (Nothing, newBranchCausalHashId) newBranchId <- Cli.runTransactionWithRollback \rollback -> do Queries.projectBranchExistsByName projectId newBranchName >>= \case @@ -99,46 +128,16 @@ createBranchFromParent mayParentBranch project newBranchName = do -- Here, we are forking to `foo/bar`, where project `foo` does exist, and it does not have a branch named -- `bar`, so the fork will succeed. newBranchId <- Sqlite.unsafeIO (ProjectBranchId <$> UUID.nextRandom) - newBranchCausalHashId <- - (for mayParentBranch (\ProjectBranch {projectId, branchId} -> Q.expectProjectBranchHead projectId branchId)) `whenNothingM` do - (_, causalHashId) <- Codebase.emptyCausalHash - pure causalHashId Queries.insertProjectBranch + description newBranchCausalHashId Sqlite.ProjectBranch { projectId, branchId = newBranchId, name = newBranchName, - parentBranchId = ProjectBranch.branchId <$> mayParentBranch + parentBranchId = mayParentBranchId } pure newBranchId Cli.switchProject (ProjectAndBranch projectId newBranchId) pure newBranchId - -createBranchFromNamespace :: Sqlite.Project -> Sqlite.Transaction ProjectBranchName -> Branch IO -> Cli ProjectBranchId -createBranchFromNamespace project getBranchName branch = do - let projectId = project ^. #projectId - Cli.Env {codebase} <- ask - let causalHash = Branch.headHash branch - liftIO $ Codebase.putBranch codebase branch - newBranchId <- - Cli.runTransactionWithRollback \rollback -> do - branchName <- getBranchName - Queries.projectBranchExistsByName projectId branchName >>= \case - True -> rollback (Output.ProjectAndBranchNameAlreadyExists (ProjectAndBranch (project ^. #name) branchName)) - False -> do - newProjectBranchId <- Sqlite.unsafeIO (ProjectBranchId <$> UUID.nextRandom) - newBranchCausalHashId <- Q.expectCausalHashIdByCausalHash causalHash - Queries.insertProjectBranch - newBranchCausalHashId - Sqlite.ProjectBranch - { projectId, - branchId = newProjectBranchId, - name = branchName, - parentBranchId = Nothing - } - pure newProjectBranchId - - Cli.switchProject (ProjectAndBranch projectId newBranchId) - pure newBranchId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index 9a5cd88787..5b816c87b7 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -11,8 +11,6 @@ import Data.Set qualified as Set import Data.Text qualified as Text import Text.Builder qualified import U.Codebase.Sqlite.DbId (ProjectId) -import U.Codebase.Sqlite.Project qualified -import U.Codebase.Sqlite.ProjectBranch qualified import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli @@ -34,6 +32,7 @@ import Unison.Codebase.Editor.HandleInput.Update2 ) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.HashQualified' qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name @@ -46,7 +45,7 @@ import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.PrettyPrintEnvDecl qualified as PPED (addFallback) -import Unison.Project (ProjectAndBranch (..), ProjectBranchName) +import Unison.Project (ProjectBranchName) import Unison.Reference (TermReference, TypeReference) import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -69,7 +68,7 @@ handleUpgrade oldName newName = do let oldPath = Path.Absolute (Path.fromList [NameSegment.libSegment, oldName]) let newPath = Path.Absolute (Path.fromList [NameSegment.libSegment, newName]) - currentNamespace <- Cli.getProjectRoot0 + currentNamespace <- Cli.getCurrentProjectRoot0 let currentNamespaceSansOld = Branch.deleteLibdep oldName currentNamespace let currentDeepTermsSansOld = Branch.deepTerms currentNamespaceSansOld let currentDeepTypesSansOld = Branch.deepTypes currentNamespaceSansOld @@ -77,7 +76,7 @@ handleUpgrade oldName newName = do let currentLocalConstructorNames = forwardCtorNames currentLocalNames let currentDeepNamesSansOld = Branch.toNames currentNamespaceSansOld - oldNamespace <- Cli.expectBranch0AtPath' oldPath + oldNamespace <- Cli.expectBranch0AtPath' (Path.AbsolutePath' oldPath) let oldLocalNamespace = Branch.deleteLibdeps oldNamespace let oldLocalTerms = Branch.deepTerms oldLocalNamespace let oldLocalTypes = Branch.deepTypes oldLocalNamespace @@ -85,7 +84,7 @@ handleUpgrade oldName newName = do let oldDeepMinusLocalTerms = Branch.deepTerms oldNamespaceMinusLocal let oldDeepMinusLocalTypes = Branch.deepTypes oldNamespaceMinusLocal - newNamespace <- Cli.expectBranch0AtPath' newPath + newNamespace <- Cli.expectBranch0AtPath' (Path.AbsolutePath' newPath) let newLocalNamespace = Branch.deleteLibdeps newNamespace let newLocalTerms = Branch.deepTerms newLocalNamespace let newLocalTypes = Branch.deepTypes newLocalNamespace @@ -149,27 +148,26 @@ handleUpgrade oldName newName = do `PPED.addFallback` makeComplicatedPPE hashLength currentDeepNamesSansOld mempty dependents ) - parsingEnv <- makeParsingEnv projectPath currentDeepNamesSansOld + pp@(PP.ProjectPath project branch pathInProject) <- Cli.getCurrentProjectPath + parsingEnv <- makeParsingEnv pathInProject currentDeepNamesSansOld typecheckedUnisonFile <- prettyParseTypecheck unisonFile printPPE parsingEnv & onLeftM \prettyUnisonFile -> do -- Small race condition: since picking a branch name and creating the branch happen in different -- transactions, creating could fail. - temporaryBranchName <- Cli.runTransaction (findTemporaryBranchName projectId oldName newName) + temporaryBranchName <- Cli.runTransaction (findTemporaryBranchName (project ^. #projectId) oldName newName) temporaryBranchId <- - HandleInput.Branch.doCreateBranch - (HandleInput.Branch.CreateFrom'Branch projectAndBranch) - projectAndBranch.project - temporaryBranchName + HandleInput.Branch.createBranchFromParent textualDescriptionOfUpgrade - let temporaryBranchPath = Path.unabsolute (Cli.projectBranchPath (ProjectAndBranch projectId temporaryBranchId)) - Cli.stepAt textualDescriptionOfUpgrade (temporaryBranchPath, \_ -> currentNamespaceSansOld) + (Just branch) + project + temporaryBranchName scratchFilePath <- Cli.getLatestFile <&> \case Nothing -> "scratch.u" Just (file, _) -> file liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) Cli.returnEarly $ - Output.UpgradeFailure projectAndBranch.branch.name temporaryBranchName scratchFilePath oldName newName + Output.UpgradeFailure branch.name temporaryBranchName scratchFilePath oldName newName branchUpdates <- Cli.runTransactionWithRollback \abort -> do From 16dea7af6f7452cc655975a5b0175a3062586a2d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 11:37:21 -0700 Subject: [PATCH 116/631] Fix up Merge --- unison-cli/src/Unison/Cli/MonadUtils.hs | 1 + .../Unison/Codebase/Editor/HandleInput/Branch.hs | 12 +++++++----- .../Unison/Codebase/Editor/HandleInput/Merge2.hs | 16 ++++++++-------- 3 files changed, 16 insertions(+), 13 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 94ec894c04..f80a916a0a 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -52,6 +52,7 @@ module Unison.Cli.MonadUtils stepManyAt, stepManyAtM, updateProjectBranchRoot, + updateProjectBranchRoot_, updateAtM, updateAt, updateAndStepAt, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index bfd5efbd09..d320fe04b3 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -1,6 +1,7 @@ -- | @branch@ input handler module Unison.Codebase.Editor.HandleInput.Branch - ( handleBranch, + ( CreateFrom (..), + handleBranch, createBranch, ) where @@ -68,10 +69,10 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB case maySrcProjectAndBranch of Just srcProjectAndBranch -> do let description = "Branch created from " <> into @Text (srcProjectAndBranch & bimap (view #name) (view #name)) - void $ createBranch description (CreateFrom'ParentBranch (view #branch srcProjectAndBranch)) destProject newBranchName + void $ createBranch description (CreateFrom'ParentBranch (view #branch srcProjectAndBranch)) destProject (pure newBranchName) Nothing -> do let description = "Empty branch created" - void $ createBranch description CreateFrom'Nothingness destProject newBranchName + void $ createBranch description CreateFrom'Nothingness destProject (pure newBranchName) Cli.respond $ Output.CreatedProjectBranch @@ -97,9 +98,9 @@ createBranch :: Text -> CreateFrom -> Sqlite.Project -> - ProjectBranchName -> + Sqlite.Transaction ProjectBranchName -> Cli ProjectBranchId -createBranch description createFrom project newBranchName = do +createBranch description createFrom project getNewBranchName = do let projectId = project ^. #projectId Cli.Env {codebase} <- ask (mayParentBranchId, newBranchCausalHashId) <- case createFrom of @@ -122,6 +123,7 @@ createBranch description createFrom project newBranchName = do pure (Nothing, newBranchCausalHashId) newBranchId <- Cli.runTransactionWithRollback \rollback -> do + newBranchName <- getNewBranchName Queries.projectBranchExistsByName projectId newBranchName >>= \case True -> rollback (Output.ProjectAndBranchNameAlreadyExists (ProjectAndBranch (project ^. #name) newBranchName)) False -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 82a82ee74e..1837bbf459 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -42,7 +42,6 @@ import U.Codebase.Sqlite.DbId (ProjectId) import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) -import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Builtin.Decls qualified as Builtin.Decls import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceAndTarget (..), MergeSourceOrTarget (..)) @@ -411,10 +410,12 @@ doMerge info = do Nothing -> do Cli.Env {writeSource} <- ask _temporaryBranchId <- - HandleInput.Branch.createBranchFromNamespace + HandleInput.Branch.createBranch + info.description + (HandleInput.Branch.CreateFrom'Namespace (Branch.mergeNode stageOneBranch parents.alice parents.bob)) info.alice.projectAndBranch.project (findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget) - (Branch.mergeNode stageOneBranch parents.alice parents.bob) + scratchFilePath <- Cli.getLatestFile <&> \case Nothing -> "scratch.u" @@ -424,11 +425,10 @@ doMerge info = do Just tuf -> do Cli.runTransaction (Codebase.addDefsToCodebase codebase tuf) let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch - _ <- - Cli.updateProjectBranchRoot - info.alice.projectAndBranch - (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) - info.description + Cli.updateProjectBranchRoot_ + info.alice.projectAndBranch.branch + info.description + (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) Cli.respond (Output.MergeSuccess mergeSourceAndTarget) doMergeLocalBranch :: TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () From e24a5ee3275b31514591237662590b1f0ae83051 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 11:45:25 -0700 Subject: [PATCH 117/631] More command fixups --- unison-cli/src/Unison/Cli/ProjectUtils.hs | 1 + .../Codebase/Editor/HandleInput/MoveTerm.hs | 3 +- .../Codebase/Editor/HandleInput/MoveType.hs | 3 +- .../Editor/HandleInput/ProjectClone.hs | 2 + .../Editor/HandleInput/ProjectRename.hs | 11 ++--- .../Editor/HandleInput/ProjectSwitch.hs | 43 +++++++++---------- .../Unison/Codebase/Editor/HandleInput/UI.hs | 38 ++-------------- .../src/Unison/CommandLine/InputPatterns.hs | 1 - 8 files changed, 36 insertions(+), 66 deletions(-) diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index 37cb496811..11aeba7a00 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -11,6 +11,7 @@ module Unison.Cli.ProjectUtils -- * Loading local project info expectProjectAndBranchByIds, getProjectAndBranchByTheseNames, + getProjectAndBranchByNames, expectProjectAndBranchByTheseNames, getProjectBranchCausalHash, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs index 4ea6aa3489..145efcc826 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs @@ -42,5 +42,6 @@ doMoveTerm src' dest' description = do steps <- moveTermSteps src' dest' when (null steps) do Cli.returnEarly (Output.TermNotFound src') - Cli.stepManyAt description steps + pb <- Cli.getCurrentProjectBranch + Cli.stepManyAt pb description steps Cli.respond Output.Success diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs index c4ff4a5a01..8dfdf20a41 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs @@ -42,5 +42,6 @@ doMoveType src' dest' description = do steps <- moveTypeSteps src' dest' when (null steps) do Cli.returnEarly (Output.TypeNotFound src') - Cli.stepManyAt description steps + pb <- Cli.getCurrentProjectBranch + Cli.stepManyAt pb description steps Cli.respond Output.Success diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs index c3d5f25cd6..8a872d18b8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs @@ -243,7 +243,9 @@ cloneInto localProjectBranch remoteProjectBranch = do Right localProject -> pure (localProject.projectId, localProject.name) localBranchId <- Sqlite.unsafeIO (ProjectBranchId <$> UUID.nextRandom) causalHashId <- Q.expectCausalHashIdByCausalHash branchHead + let description = "Cloned from " <> into @Text (ProjectAndBranch remoteProjectName remoteBranchName) Queries.insertProjectBranch + description causalHashId Sqlite.ProjectBranch { projectId = localProjectId, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs index f7d960d2df..117f12bb80 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs @@ -4,21 +4,22 @@ module Unison.Codebase.Editor.HandleInput.ProjectRename ) where +import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.ProjectUtils qualified as ProjectUtils +import Unison.Cli.MonadUtils qualified as Cli import Unison.Codebase.Editor.Output qualified as Output import Unison.Prelude -import Unison.Project (ProjectName) +import Unison.Project (ProjectAndBranch (..), ProjectName) handleProjectRename :: ProjectName -> Cli () handleProjectRename newName = do - project <- ProjectUtils.expectCurrentProject - let oldName = project ^. #name + ProjectAndBranch project _branch <- Cli.getCurrentProjectAndBranch + let oldName = project.name when (oldName /= newName) do Cli.runTransactionWithRollback \rollback -> do Queries.loadProjectByName newName >>= \case Just _ -> rollback (Output.ProjectNameAlreadyExists newName) - Nothing -> Queries.renameProject (project ^. #projectId) newName + Nothing -> Queries.renameProject project.projectId newName Cli.respond (Output.RenamedProject oldName newName) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs index c2fcd4a260..3aaf801e8c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs @@ -1,16 +1,15 @@ -- | @switch@ input handler module Unison.Codebase.Editor.HandleInput.ProjectSwitch ( projectSwitch, - switchToProjectBranch, ) where import Data.These (These (..)) -import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) -import U.Codebase.Sqlite.Project qualified +import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Editor.Output qualified as Output import Unison.Prelude @@ -29,24 +28,22 @@ import Witch (unsafeFrom) projectSwitch :: ProjectAndBranchNames -> Cli () projectSwitch projectNames = do case projectNames of - ProjectAndBranchNames'Ambiguous projectName branchName -> - ProjectUtils.getCurrentProjectBranch >>= \case - Nothing -> switchToProjectAndBranchByTheseNames (This projectName) - Just (ProjectAndBranch currentProject _currentBranch, _restPath) -> do - (projectExists, branchExists) <- - Cli.runTransaction do - (,) - <$> Queries.projectExistsByName projectName - <*> Queries.projectBranchExistsByName currentProject.projectId branchName - case (projectExists, branchExists) of - (False, False) -> Cli.respond (Output.LocalProjectNorProjectBranchExist projectName branchName) - (False, True) -> switchToProjectAndBranchByTheseNames (These currentProject.name branchName) - (True, False) -> switchToProjectAndBranchByTheseNames (This projectName) - (True, True) -> - Cli.respondNumbered $ - Output.AmbiguousSwitch - projectName - (ProjectAndBranch currentProject.name branchName) + ProjectAndBranchNames'Ambiguous projectName branchName -> do + ProjectAndBranch currentProject _currentBranch <- Cli.getCurrentProjectAndBranch + (projectExists, branchExists) <- + Cli.runTransaction do + (,) + <$> Queries.projectExistsByName projectName + <*> Queries.projectBranchExistsByName currentProject.projectId branchName + case (projectExists, branchExists) of + (False, False) -> Cli.respond (Output.LocalProjectNorProjectBranchExist projectName branchName) + (False, True) -> switchToProjectAndBranchByTheseNames (These currentProject.name branchName) + (True, False) -> switchToProjectAndBranchByTheseNames (This projectName) + (True, True) -> + Cli.respondNumbered $ + Output.AmbiguousSwitch + projectName + (ProjectAndBranch currentProject.name branchName) ProjectAndBranchNames'Unambiguous projectAndBranchNames0 -> switchToProjectAndBranchByTheseNames projectAndBranchNames0 @@ -62,7 +59,7 @@ switchToProjectAndBranchByTheseNames projectAndBranchNames0 = do Nothing -> do let branchName = unsafeFrom @Text "main" Queries.loadProjectBranchByName (project ^. #projectId) branchName & onNothingM do - rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName)) + rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName)) Just branchId -> Queries.loadProjectBranch (project ^. #projectId) branchId >>= \case Nothing -> error "impossible" @@ -72,4 +69,4 @@ switchToProjectAndBranchByTheseNames projectAndBranchNames0 = do Cli.runTransactionWithRollback \rollback -> do Queries.loadProjectBranchByNames projectName branchName & onNothingM do rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) - Cli.switchProject (ProjectAndBranch (branch ^. #projectId) (branch ^. #branchId) + Cli.switchProject (ProjectAndBranch (branch ^. #projectId) (branch ^. #branchId)) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/UI.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/UI.hs index 9a6c5dcb3f..b80d161674 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/UI.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/UI.hs @@ -11,13 +11,10 @@ import U.Codebase.Reference qualified as V2 (Reference) import U.Codebase.Referent qualified as V2 (Referent) import U.Codebase.Referent qualified as V2.Referent import U.Codebase.Sqlite.Project qualified as Project -import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.ProjectBranch qualified as ProjectBranch -import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite 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 Project import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path @@ -42,10 +39,10 @@ openUI path' = do defnPath <- Cli.resolvePath' path' pp <- Cli.getCurrentProjectPath whenJust serverBaseUrl \url -> do - openUIForProject url pp defnPath + openUIForProject url pp (defnPath ^. PP.absPath_) openUIForProject :: Server.BaseUrl -> PP.ProjectPath -> Path.Absolute -> Cli () -openUIForProject url (PP.ProjectPath project projectBranch perspective) defnPath = do +openUIForProject url pp@(PP.ProjectPath project projectBranch perspective) defnPath = do mayDefinitionRef <- getDefinitionRef perspective let projectBranchNames = bimap Project.name ProjectBranch.name (ProjectAndBranch project projectBranch) _success <- liftIO . openBrowser . Text.unpack $ Server.urlFor (Server.ProjectBranchUI projectBranchNames perspective mayDefinitionRef) url @@ -59,7 +56,7 @@ openUIForProject url (PP.ProjectPath project projectBranch perspective) defnPath let defnNamespaceProjectPath = pp & PP.absPath_ .~ pathToDefinitionNamespace namespaceBranch <- lift . Cli.runTransaction $ Codebase.getShallowBranchAtProjectPath defnNamespaceProjectPath fqn <- hoistMaybe $ do - pathFromPerspective <- List.stripPrefix (Path.toList perspective) (Path.toList pathFromProjectRoot) + pathFromPerspective <- List.stripPrefix (Path.toList (Path.unabsolute perspective)) (Path.toList $ Path.unabsolute defnPath) Path.toName . Path.fromList $ pathFromPerspective def <- MaybeT $ getTermOrTypeRef codebase namespaceBranch fqn pure def @@ -77,35 +74,6 @@ getTermOrTypeRef codebase namespaceBranch fqn = runMaybeT $ do pure (toTypeReference fqn oneType) terms <|> types -openUIForLooseCode :: Server.BaseUrl -> Path.Path' -> Cli () -openUIForLooseCode url path' = do - Cli.Env {codebase} <- ask - currentPath <- Cli.getCurrentPath - (perspective, definitionRef) <- getUIUrlParts currentPath path' codebase - _success <- liftIO . openBrowser . Text.unpack $ Server.urlFor (Server.LooseCodeUI perspective definitionRef) url - pure () - -getUIUrlParts :: Path.Absolute -> Path.Path' -> Codebase m Symbol Ann -> Cli (Path.Absolute, Maybe (Server.DefinitionReference)) -getUIUrlParts startPath definitionPath' codebase = do - let absPath = Path.resolve startPath definitionPath' - let perspective = - if Path.isAbsolute definitionPath' - then Path.absoluteEmpty - else startPath - case Lens.unsnoc absPath of - Just (abs, _nameSeg) -> do - namespaceBranch <- - Cli.runTransaction - (Codebase.getShallowBranchAtPath (Path.unabsolute abs) Nothing) - mayDefRef <- runMaybeT do - name <- hoistMaybe $ Path.toName $ Path.fromPath' definitionPath' - MaybeT $ getTermOrTypeRef codebase namespaceBranch name - case mayDefRef of - Nothing -> pure (absPath, Nothing) - Just defRef -> pure (perspective, Just defRef) - Nothing -> - pure (absPath, Nothing) - toTypeReference :: Name -> V2.Reference -> Server.DefinitionReference toTypeReference name reference = Server.TypeReference $ diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 03d1343936..b5b2787344 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -165,7 +165,6 @@ import Unison.Cli.Pretty prettySlashProjectBranchName, prettyURI, ) -import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch.Merge qualified as Branch From e65f6e19685c679dec715ab88b6e555e23637e4e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 12:05:59 -0700 Subject: [PATCH 118/631] Remove ability to push loose code paths (local or on share) --- .../src/Unison/Codebase/Editor/RemoteRepo.hs | 41 +------------------ unison-cli/src/Unison/Cli/Pretty.hs | 17 +------- .../Codebase/Editor/HandleInput/Push.hs | 24 ++--------- .../src/Unison/Codebase/Editor/Input.hs | 6 +-- .../src/Unison/Codebase/Editor/Output.hs | 6 +-- .../src/Unison/Codebase/Editor/UriParser.hs | 28 +------------ 6 files changed, 11 insertions(+), 111 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs b/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs index a3d5c63f51..bd352cbc26 100644 --- a/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs +++ b/parser-typechecker/src/Unison/Codebase/Editor/RemoteRepo.hs @@ -1,8 +1,5 @@ module Unison.Codebase.Editor.RemoteRepo where -import Control.Lens (Lens') -import Control.Lens qualified as Lens -import Data.Void (absurd) import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.NameSegment qualified as NameSegment @@ -35,12 +32,6 @@ displayShareCodeserver cs shareUser path = CustomCodeserver cu -> "share(" <> tShow cu <> ")." in shareServer <> shareUserHandleToText shareUser <> maybePrintPath path -writeNamespaceToRead :: WriteRemoteNamespace Void -> ReadRemoteNamespace void -writeNamespaceToRead = \case - WriteRemoteNamespaceShare WriteShareRemoteNamespace {server, repo, path} -> - ReadShare'LooseCode ReadShareLooseCode {server, repo, path} - WriteRemoteProjectBranch v -> absurd v - -- | print remote namespace printReadRemoteNamespace :: (a -> Text) -> ReadRemoteNamespace a -> Text printReadRemoteNamespace printProject = \case @@ -48,11 +39,8 @@ printReadRemoteNamespace printProject = \case ReadShare'ProjectBranch project -> printProject project -- | Render a 'WriteRemoteNamespace' as text. -printWriteRemoteNamespace :: WriteRemoteNamespace (ProjectAndBranch ProjectName ProjectBranchName) -> Text -printWriteRemoteNamespace = \case - WriteRemoteNamespaceShare (WriteShareRemoteNamespace {server, repo, path}) -> - displayShareCodeserver server repo path - WriteRemoteProjectBranch projectAndBranch -> into @Text projectAndBranch +printWriteRemoteNamespace :: (ProjectAndBranch ProjectName ProjectBranchName) -> Text +printWriteRemoteNamespace projectAndBranch = into @Text projectAndBranch maybePrintPath :: Path -> Text maybePrintPath path = @@ -80,28 +68,3 @@ isPublic ReadShareLooseCode {path} = case path of (segment Path.:< _) -> segment == NameSegment.publicLooseCodeSegment _ -> False - -data WriteRemoteNamespace a - = WriteRemoteNamespaceShare !WriteShareRemoteNamespace - | WriteRemoteProjectBranch a - deriving stock (Eq, Functor, Show) - --- | A lens which focuses the path of a remote namespace. -remotePath_ :: Lens' (WriteRemoteNamespace Void) Path -remotePath_ = Lens.lens getter setter - where - getter = \case - WriteRemoteNamespaceShare (WriteShareRemoteNamespace _ _ path) -> path - WriteRemoteProjectBranch v -> absurd v - setter remote path = - case remote of - WriteRemoteNamespaceShare (WriteShareRemoteNamespace server repo _) -> - WriteRemoteNamespaceShare $ WriteShareRemoteNamespace server repo path - WriteRemoteProjectBranch v -> absurd v - -data WriteShareRemoteNamespace = WriteShareRemoteNamespace - { server :: !ShareCodeserver, - repo :: !ShareUserHandle, - path :: !Path - } - deriving stock (Eq, Show) diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index c45ca85011..0f18f47b09 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -33,7 +33,6 @@ module Unison.Cli.Pretty prettyRepoInfo, prettySCH, prettySemver, - prettyShareLink, prettySharePath, prettyShareURI, prettySlashProjectBranchName, @@ -57,12 +56,10 @@ import Control.Monad.Writer (Writer, runWriter) import Data.List qualified as List import Data.Map qualified as Map import Data.Set qualified as Set -import Data.Text qualified as Text import Data.Time (UTCTime) import Data.Time.Format.Human (HumanTimeLocale (..), defaultHumanTimeLocale, humanReadableTimeI18N') import Network.URI (URI) import Network.URI qualified as URI -import Network.URI.Encode qualified as URI import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Reference qualified as Reference import U.Codebase.Sqlite.Project qualified as Sqlite @@ -76,10 +73,6 @@ import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.RemoteRepo ( ReadRemoteNamespace (..), - ShareUserHandle (..), - WriteRemoteNamespace (..), - WriteShareRemoteNamespace (..), - shareUserHandleToText, ) import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Path (Path') @@ -150,7 +143,7 @@ prettyReadRemoteNamespaceWith :: (a -> Text) -> ReadRemoteNamespace a -> Pretty prettyReadRemoteNamespaceWith printProject = P.group . P.blue . P.text . RemoteRepo.printReadRemoteNamespace printProject -prettyWriteRemoteNamespace :: WriteRemoteNamespace (ProjectAndBranch ProjectName ProjectBranchName) -> Pretty +prettyWriteRemoteNamespace :: (ProjectAndBranch ProjectName ProjectBranchName) -> Pretty prettyWriteRemoteNamespace = P.group . P.blue . P.text . RemoteRepo.printWriteRemoteNamespace @@ -161,14 +154,6 @@ prettyRepoInfo :: Share.RepoInfo -> Pretty prettyRepoInfo (Share.RepoInfo repoInfo) = P.blue (P.text repoInfo) -prettyShareLink :: WriteShareRemoteNamespace -> Pretty -prettyShareLink WriteShareRemoteNamespace {repo, path} = - let encodedPath = - Path.toList path - & fmap (URI.encodeText . NameSegment.toUnescapedText) - & Text.intercalate "/" - in P.green . P.text $ shareOrigin <> "/@" <> shareUserHandleToText repo <> "/p/code/latest/namespaces/" <> encodedPath - prettySharePath :: Share.Path -> Pretty prettySharePath = prettyRelative diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs index 46b05773e0..0884efcb23 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs @@ -32,10 +32,6 @@ import Unison.Codebase.Editor.Input import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Editor.Output.PushPull (PushPull (Push)) -import Unison.Codebase.Editor.RemoteRepo - ( WriteRemoteNamespace (..), - WriteShareRemoteNamespace (..), - ) import Unison.Codebase.Path qualified as Path import Unison.Codebase.PushBehavior (PushBehavior) import Unison.Codebase.PushBehavior qualified as PushBehavior @@ -70,31 +66,17 @@ handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do localProjectAndBranch <- Cli.getCurrentProjectAndBranch pushProjectBranchToProjectBranch force localProjectAndBranch Nothing -- push to .some.path (share) - PushSourceTarget1 (WriteRemoteNamespaceShare namespace) -> do - localPath <- Cli.getCurrentPath - pushLooseCodeToShareLooseCode localPath namespace pushBehavior -- push to @some/project - PushSourceTarget1 (WriteRemoteProjectBranch remoteProjectAndBranch0) -> do + PushSourceTarget1 remoteProjectAndBranch0 -> do localProjectAndBranch <- Cli.getCurrentProjectAndBranch pushProjectBranchToProjectBranch force localProjectAndBranch (Just remoteProjectAndBranch0) - -- push .some.path to .some.path (share) - PushSourceTarget2 (PathySource localPath0) (WriteRemoteNamespaceShare namespace) -> do - localPath <- Cli.resolvePath' localPath0 - pushLooseCodeToShareLooseCode localPath namespace pushBehavior -- push .some.path to @some/project - PushSourceTarget2 (PathySource localPath0) (WriteRemoteProjectBranch remoteProjectAndBranch0) -> do + PushSourceTarget2 (PathySource localPath0) remoteProjectAndBranch0 -> do localPath <- Cli.resolvePath' localPath0 remoteProjectAndBranch <- ProjectUtils.hydrateNames remoteProjectAndBranch0 pushLooseCodeToProjectBranch force localPath remoteProjectAndBranch - -- push @some/project to .some.path (share) - PushSourceTarget2 (ProjySource localProjectAndBranch0) (WriteRemoteNamespaceShare namespace) -> do - ProjectAndBranch project branch <- ProjectUtils.expectProjectAndBranchByTheseNames localProjectAndBranch0 - pushLooseCodeToShareLooseCode - (ProjectUtils.projectBranchPath (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId))) - namespace - pushBehavior -- push @some/project to @some/project - PushSourceTarget2 (ProjySource localProjectAndBranch0) (WriteRemoteProjectBranch remoteProjectAndBranch) -> do + PushSourceTarget2 (ProjySource localProjectAndBranch0) remoteProjectAndBranch -> do localProjectAndBranch <- ProjectUtils.expectProjectAndBranchByTheseNames localProjectAndBranch0 pushProjectBranchToProjectBranch force localProjectAndBranch (Just remoteProjectAndBranch) where diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 1e33f62e8e..9f5e57f32d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -31,7 +31,7 @@ import Data.List.NonEmpty (NonEmpty) import Data.Text qualified as Text import Data.These (These) import Unison.Codebase.Branch.Merge qualified as Branch -import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteRemoteNamespace) +import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace) import Unison.Codebase.Path (Path, Path') import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path @@ -254,8 +254,8 @@ data PushSource -- | Push source and target: either neither is specified, or only a target, or both. data PushSourceTarget = PushSourceTarget0 - | PushSourceTarget1 (WriteRemoteNamespace (These ProjectName ProjectBranchName)) - | PushSourceTarget2 PushSource (WriteRemoteNamespace (These ProjectName ProjectBranchName)) + | PushSourceTarget1 (These ProjectName ProjectBranchName) + | PushSourceTarget2 PushSource (These ProjectName ProjectBranchName) deriving stock (Eq, Show) data PushRemoteBranchInput = PushRemoteBranchInput diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index ff7f44c325..090d78bc1e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -42,7 +42,6 @@ import Unison.Codebase.IntegrityCheck (IntegrityResult (..)) import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath (ProjectPath) -import Unison.Codebase.PushBehavior (PushBehavior) import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH @@ -268,7 +267,7 @@ data Output -- and a nicer render. BustedBuiltins (Set Reference) (Set Reference) | ShareError ShareError - | ViewOnShare (Either WriteShareRemoteNamespace (URI, ProjectName, ProjectBranchName)) + | ViewOnShare (URI, ProjectName, ProjectBranchName) | NoConfiguredRemoteMapping PushPull Path.Absolute | ConfiguredRemoteMappingParseError PushPull Path.Absolute Text String | TermMissingType Reference @@ -309,8 +308,6 @@ data Output | HelpMessage Input.InputPattern | NamespaceEmpty (NonEmpty AbsBranchId) | NoOp - | -- Refused to push, either because a `push` targeted an empty namespace, or a `push.create` targeted a non-empty namespace. - RefusedToPush PushBehavior (WriteRemoteNamespace Void) | -- | @GistCreated repo@ means a causal was just published to @repo@. GistCreated (ReadRemoteNamespace Void) | -- | Directs the user to URI to begin an authorization flow. @@ -566,7 +563,6 @@ isFailure o = case o of TermMissingType {} -> True DumpUnisonFileHashes _ x y z -> x == mempty && y == mempty && z == mempty NamespaceEmpty {} -> True - RefusedToPush {} -> True GistCreated {} -> False InitiateAuthFlow {} -> False UnknownCodeServer {} -> True diff --git a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs index cf7a99a8f9..d9520379f4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs +++ b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs @@ -1,7 +1,5 @@ module Unison.Codebase.Editor.UriParser ( readRemoteNamespaceParser, - writeRemoteNamespace, - writeRemoteNamespaceWith, parseReadShareLooseCode, ) where @@ -17,13 +15,11 @@ import Unison.Codebase.Editor.RemoteRepo ReadShareLooseCode (..), ShareCodeserver (DefaultCodeserver), ShareUserHandle (..), - WriteRemoteNamespace (..), - WriteShareRemoteNamespace (..), ) import Unison.Codebase.Path qualified as Path import Unison.NameSegment (NameSegment) import Unison.Prelude -import Unison.Project (ProjectBranchName, ProjectBranchSpecifier (..), ProjectName, projectAndBranchNamesParser) +import Unison.Project (ProjectBranchSpecifier (..), ProjectName, projectAndBranchNamesParser) import Unison.Syntax.Lexer qualified import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Util.Pretty qualified as P @@ -51,28 +47,6 @@ parseReadShareLooseCode label input = let printError err = P.lines [P.string "I couldn't parse this as a share path.", P.prettyPrintParseError input err] in first printError (P.parse readShareLooseCode label (Text.pack input)) --- >>> P.parseMaybe writeRemoteNamespace "unisonweb.base._releases.M4" --- Just (WriteRemoteNamespaceShare (WriteShareRemoteNamespace {server = ShareRepo, repo = "unisonweb", path = base._releases.M4})) -writeRemoteNamespace :: P (WriteRemoteNamespace (These ProjectName ProjectBranchName)) -writeRemoteNamespace = - writeRemoteNamespaceWith - (projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths ProjectBranchSpecifier'Name) - -writeRemoteNamespaceWith :: P a -> P (WriteRemoteNamespace a) -writeRemoteNamespaceWith projectBranchParser = - WriteRemoteProjectBranch <$> projectBranchParser - <|> WriteRemoteNamespaceShare <$> writeShareRemoteNamespace - --- >>> P.parseMaybe writeShareRemoteNamespace "unisonweb.base._releases.M4" --- Just (WriteShareRemoteNamespace {server = ShareRepo, repo = "unisonweb", path = base._releases.M4}) -writeShareRemoteNamespace :: P WriteShareRemoteNamespace -writeShareRemoteNamespace = - P.label "write share remote namespace" $ - WriteShareRemoteNamespace - <$> pure DefaultCodeserver - <*> shareUserHandle - <*> (Path.fromList <$> P.many (C.char '.' *> nameSegment)) - -- >>> P.parseMaybe readShareLooseCode ".unisonweb.base._releases.M4" -- >>> P.parseMaybe readShareLooseCode "unisonweb.base._releases.M4" -- Nothing From 9c17d14c9b54050f792ee1c32d3818fb00d95253 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 12:13:57 -0700 Subject: [PATCH 119/631] Remove ability to push to loose code or pull into loose code. --- Sync.hs | 930 ++++++++++++++++++ .../U/Codebase/Sqlite/Operations.hs | 6 + .../Codebase/Editor/HandleInput/Push.hs | 47 +- .../src/Unison/Codebase/Editor/Input.hs | 3 +- .../src/Unison/Codebase/Editor/Output.hs | 4 +- .../src/Unison/Codebase/Editor/UriParser.hs | 9 +- .../src/Unison/CommandLine/InputPatterns.hs | 14 +- .../src/Unison/CommandLine/OutputMessages.hs | 84 +- unison-cli/src/Unison/Share/Sync.hs | 326 +----- unison-cli/src/Unison/Share/Sync/Types.hs | 27 +- unison-share-api/src/Unison/Sync/API.hs | 10 - unison-share-api/src/Unison/Sync/Types.hs | 111 +-- 12 files changed, 967 insertions(+), 604 deletions(-) create mode 100644 Sync.hs diff --git a/Sync.hs b/Sync.hs new file mode 100644 index 0000000000..c81123fa39 --- /dev/null +++ b/Sync.hs @@ -0,0 +1,930 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} + +module Unison.Share.Sync + ( -- ** Get causal hash by path + getCausalHashByPath, + GetCausalHashByPathError (..), + + -- ** Push + checkAndSetPush, + CheckAndSetPushError (..), + uploadEntities, + + -- ** Pull + pull, + PullError (..), + downloadEntities, + ) +where + +import Control.Concurrent.STM +import Control.Lens +import Control.Monad.Except +import Control.Monad.Reader (ask) +import Control.Monad.Trans.Reader (ReaderT, runReaderT) +import Control.Monad.Trans.Reader qualified as Reader +import Data.Foldable qualified as Foldable (find) +import Data.List.NonEmpty (pattern (:|)) +import Data.List.NonEmpty qualified as List (NonEmpty) +import Data.List.NonEmpty qualified as List.NonEmpty +import Data.Map qualified as Map +import Data.Map.NonEmpty (NEMap) +import Data.Map.NonEmpty qualified as NEMap +import Data.Proxy +import Data.Sequence.NonEmpty (NESeq ((:<||))) +import Data.Sequence.NonEmpty qualified as NESeq (fromList, nonEmptySeq, (><|)) +import Data.Set qualified as Set +import Data.Set.NonEmpty (NESet) +import Data.Set.NonEmpty qualified as NESet +import Data.Text.Lazy qualified as Text.Lazy +import Data.Text.Lazy.Encoding qualified as Text.Lazy +import GHC.IO (unsafePerformIO) +import Ki qualified +import Network.HTTP.Client qualified as Http.Client +import Network.HTTP.Types qualified as HTTP +import Servant.API qualified as Servant ((:<|>) (..), (:>)) +import Servant.Client (BaseUrl) +import Servant.Client qualified as Servant +import System.Environment (lookupEnv) +import U.Codebase.HashTags (CausalHash) +import U.Codebase.Sqlite.Queries qualified as Q +import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle) +import Unison.Auth.HTTPClient (AuthenticatedHttpClient) +import Unison.Auth.HTTPClient qualified as Auth +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Debug qualified as Debug +import Unison.Hash32 (Hash32) +import Unison.Prelude +import Unison.Share.API.Hash qualified as Share +import Unison.Share.ExpectedHashMismatches (expectedCausalHashMismatches, expectedComponentHashMismatches) +import Unison.Share.Sync.Types +import Unison.Sqlite qualified as Sqlite +import Unison.Sync.API qualified as Share (API) +import Unison.Sync.Common (causalHashToHash32, entityToTempEntity, expectEntity, hash32ToCausalHash) +import Unison.Sync.EntityValidation qualified as EV +import Unison.Sync.Types qualified as Share +import Unison.Util.Monoid (foldMapM) + +------------------------------------------------------------------------------------------------------------------------ +-- Pile of constants + +-- | The maximum number of downloader threads, during a pull. +maxSimultaneousPullDownloaders :: Int +maxSimultaneousPullDownloaders = unsafePerformIO $ do + lookupEnv "UNISON_PULL_WORKERS" <&> \case + Just n -> read n + Nothing -> 5 +{-# NOINLINE maxSimultaneousPullDownloaders #-} + +-- | The maximum number of push workers at a time. Each push worker reads from the database and uploads entities. +-- Share currently parallelizes on it's own in the backend, and any more than one push worker +-- just results in serialization conflicts which slow things down. +maxSimultaneousPushWorkers :: Int +maxSimultaneousPushWorkers = unsafePerformIO $ do + lookupEnv "UNISON_PUSH_WORKERS" <&> \case + Just n -> read n + Nothing -> 1 +{-# NOINLINE maxSimultaneousPushWorkers #-} + +syncChunkSize :: Int +syncChunkSize = unsafePerformIO $ do + lookupEnv "UNISON_SYNC_CHUNK_SIZE" <&> \case + Just n -> read n + Nothing -> 50 +{-# NOINLINE syncChunkSize #-} + +------------------------------------------------------------------------------------------------------------------------ +-- Push + +-- | Perform a check-and-set push (initially of just a causal hash, but ultimately all of its dependencies that the +-- server is missing, too) to Unison Share. +-- +-- This flavor of push takes the expected state of the server, and the desired state we want to set; if our expectation +-- is off, we won't proceed with the push. +checkAndSetPush :: + -- | The Unison Share URL. + BaseUrl -> + -- | The repo+path to push to. + Share.Path -> + -- | The hash that we expect this repo+path to be at on Unison Share. If not, we'll get back a hash mismatch error. + -- This prevents accidentally pushing over data that we didn't know was there. + Maybe Hash32 -> + -- | The hash of our local causal to push. + CausalHash -> + -- | Callback that's given a number of entities we just uploaded. + (Int -> IO ()) -> + Cli (Either (SyncError CheckAndSetPushError) ()) +checkAndSetPush unisonShareUrl path expectedHash causalHash uploadedCallback = do + Cli.Env {authHTTPClient} <- ask + + Cli.label \done -> do + let failed :: SyncError CheckAndSetPushError -> Cli void + failed = done . Left + + let updatePathError :: Share.UpdatePathError -> Cli void + updatePathError err = + failed (SyncError (CheckAndSetPushError'UpdatePath (Share.pathRepoInfo path) err)) + + -- Maybe the server already has this causal; try just setting its remote path. Commonly, it will respond that it + -- needs this causal (UpdatePathMissingDependencies). + dependencies <- + updatePath >>= \case + Share.UpdatePathSuccess -> done (Right ()) + Share.UpdatePathFailure err -> + case err of + Share.UpdatePathError'MissingDependencies (Share.NeedDependencies dependencies) -> pure dependencies + _ -> updatePathError err + + -- Upload the causal and all of its dependencies. + uploadEntities unisonShareUrl (Share.pathRepoInfo path) dependencies uploadedCallback & onLeftM \err -> + failed (CheckAndSetPushError'UploadEntities <$> err) + + -- After uploading the causal and all of its dependencies, try setting the remote path again. + updatePath >>= \case + Share.UpdatePathSuccess -> pure (Right ()) + Share.UpdatePathFailure err -> updatePathError err + +-- Return a list (in oldest-to-newest order) of hashes along the causal spine that connects the given arguments, +-- excluding the newest hash (second argument). +loadCausalSpineBetween :: Hash32 -> Hash32 -> Sqlite.Transaction (Maybe [Hash32]) +loadCausalSpineBetween earlierHash laterHash = + dagbfs (== earlierHash) Q.loadCausalParentsByHash laterHash + +data Step a + = DeadEnd + | KeepSearching (List.NonEmpty a) + | FoundGoal a + +-- | @dagbfs goal children root@ searches breadth-first through the monadic tree formed by applying @chilred@ to each +-- node (initially @root@), until it finds a goal node (i.e. when @goal@ returns True). +-- +-- Returns the nodes along a path from root to goal in bottom-up or goal-to-root order, excluding the root node (because +-- it was provided as an input ;)) +-- +-- For example, when searching a tree that looks like +-- +-- 1 +-- / \ +-- 2 3 +-- / \ \ +-- 4 [5] 6 +-- +-- (where the goal is marked [5]), we'd return +-- +-- Just [5,2] +-- +-- And (as another example), if the root node is the goal, +-- +-- [1] +-- / \ +-- 2 3 +-- / \ \ +-- 4 5 6 +-- +-- we'd return +-- +-- Just [] +dagbfs :: forall a m. (Monad m) => (a -> Bool) -> (a -> m [a]) -> a -> m (Maybe [a]) +dagbfs goal children = + let -- The loop state: all distinct paths from the root to the frontier (not including the root, because it's implied, + -- as an input to this function), in reverse order, with the invariant that we haven't found a goal state yet. + -- (Otherwise, we wouldn't still be in this loop, we'd return!). + -- + -- For example, say we are exploring the tree + -- + -- 1 + -- / \ + -- 2 3 + -- / \ \ + -- 4 5 6 + -- + -- Graphically, the frontier here is the nodes 4, 5, and 6; we know that, because we haven't drawn any nodes below + -- them. (This is a BFS algorithm that discovers children on-the-fly, so maybe node 5 (for example) has children, + -- and maybe it doesn't). + -- + -- The loop state, in this case, would be these three paths: + -- + -- [ 4, 2 ] + -- [ 5, 2 ] + -- [ 6, 3 ] + -- + -- (Note, again, that we do not include the root). + go :: NESeq (List.NonEmpty a) -> m (Maybe (List.NonEmpty a)) + go (path :<|| paths) = + -- Step forward from the first path in our loop state (in the example above, [4, 2]). + step (List.NonEmpty.head path) >>= \case + -- If node 4 had no more children, we can toss that whole path: it didn't end in a goal. Now we either keep + -- searching (as we would in the example, since we have two more paths to continue from), or we don't, because + -- this was the only remaining path. + DeadEnd -> + case NESeq.nonEmptySeq paths of + Nothing -> pure Nothing + Just paths' -> go paths' + -- If node 4 did have children, then maybe the search tree now looks like this. + -- + -- 1 + -- / \ + -- 2 3 + -- / \ \ + -- 4 5 6 + -- / \ + -- 7 8 + -- + -- There are two cases to handle: + -- + -- 1. One of the children we just discovered (say 7) is a goal node. So we're done, and we'd return the path + -- + -- [ 7, 4, 2 ] + -- + -- 2. No child we just discovered (7 nor 8) were a goal node. So we loop, putting our new path(s) at the end + -- of the list (so we search paths fairly). In this case, we'd re-enter the loop with the following four + -- paths: + -- + -- [ 5, 2 ] \ these two are are variable 'paths', the tail of the loop state. + -- [ 6, 3 ] / + -- [ 7, 4, 2 ] \ these two are new, just constructed by prepending each of [ 4, 2, 1 ]'s children + -- [ 8, 4, 2 ] / to itself, making two new paths to search + KeepSearching ys -> go (append paths ((\y -> List.NonEmpty.cons y path) <$> NESeq.fromList ys)) + FoundGoal y -> pure (Just (List.NonEmpty.cons y path)) + + -- Step forward from a single node. There are 3 possible outcomes: + -- + -- 1. We discover it has no children. (return DeadEnd) + -- 2. We discover is has children, none of which are a goal. (return KeepSearching) + -- 3. We discover it has children, (at least) one of which is a goal. (return FoundGoal) + step :: a -> m (Step a) + step x = do + ys0 <- children x + pure case List.NonEmpty.nonEmpty ys0 of + Nothing -> DeadEnd + Just ys -> + case Foldable.find goal ys of + Nothing -> KeepSearching ys + Just y -> FoundGoal y + in \root -> + if goal root + then pure (Just []) + else + step root >>= \case + DeadEnd -> pure Nothing + -- lts-18.28 doesn't have List.NonEmpty.singleton + KeepSearching xs -> fmap List.NonEmpty.toList <$> go (NESeq.fromList ((:| []) <$> xs)) + FoundGoal x -> pure (Just [x]) + where + -- Concatenate a seq and a non-empty seq. + append :: Seq x -> NESeq x -> NESeq x + append = (NESeq.><|) + +------------------------------------------------------------------------------------------------------------------------ +-- Pull + +pull :: + -- | The Unison Share URL. + BaseUrl -> + -- | The repo+path to pull from. + Share.Path -> + -- | Callback that's given a number of entities we just downloaded. + (Int -> IO ()) -> + Cli (Either (SyncError PullError) CausalHash) +pull unisonShareUrl repoPath downloadedCallback = + getCausalHashByPath unisonShareUrl repoPath >>= \case + Left err -> pure (Left (PullError'GetCausalHash <$> err)) + -- There's nothing at the remote path, so there's no causal to pull. + Right Nothing -> pure (Left (SyncError (PullError'NoHistoryAtPath repoPath))) + Right (Just hashJwt) -> + downloadEntities unisonShareUrl (Share.pathRepoInfo repoPath) hashJwt downloadedCallback <&> \case + Left err -> Left (PullError'DownloadEntities <$> err) + Right () -> Right (hash32ToCausalHash (Share.hashJWTHash hashJwt)) + +------------------------------------------------------------------------------------------------------------------------ +-- Download entities + +downloadEntities :: + -- | The Unison Share URL. + BaseUrl -> + -- | The repo to download from. + Share.RepoInfo -> + -- | The hash to download. + Share.HashJWT -> + -- | Callback that's given a number of entities we just downloaded. + (Int -> IO ()) -> + Cli (Either (SyncError Share.DownloadEntitiesError) ()) +downloadEntities unisonShareUrl repoInfo hashJwt downloadedCallback = do + Cli.Env {authHTTPClient, codebase} <- ask + + Cli.label \done -> do + let failed :: SyncError Share.DownloadEntitiesError -> Cli void + failed = done . Left + + let hash = Share.hashJWTHash hashJwt + + maybeTempEntities <- + Cli.runTransaction (Q.entityLocation hash) >>= \case + Just Q.EntityInMainStorage -> pure Nothing + Just Q.EntityInTempStorage -> pure (Just (NESet.singleton hash)) + Nothing -> do + let request = + httpDownloadEntities + authHTTPClient + unisonShareUrl + Share.DownloadEntitiesRequest {repoInfo, hashes = NESet.singleton hashJwt} + entities <- + liftIO request >>= \case + Left err -> failed (TransportError err) + Right (Share.DownloadEntitiesFailure err) -> failed (SyncError err) + Right (Share.DownloadEntitiesSuccess entities) -> pure entities + case validateEntities entities of + Left err -> failed . SyncError . Share.DownloadEntitiesEntityValidationFailure $ err + Right () -> pure () + tempEntities <- Cli.runTransaction (insertEntities entities) + liftIO (downloadedCallback 1) + pure (NESet.nonEmptySet tempEntities) + + whenJust maybeTempEntities \tempEntities -> do + let doCompleteTempEntities = + completeTempEntities + authHTTPClient + unisonShareUrl + ( \action -> + Codebase.withConnection codebase \conn -> + action (Sqlite.runTransaction conn) + ) + repoInfo + downloadedCallback + tempEntities + liftIO doCompleteTempEntities & onLeftM \err -> + failed err + -- Since we may have just inserted and then deleted many temp entities, we attempt to recover some disk space by + -- vacuuming after each pull. If the vacuum fails due to another open transaction on this connection, that's ok, + -- we'll try vacuuming again next pull. + _success <- liftIO (Codebase.withConnection codebase Sqlite.vacuum) + pure (Right ()) + +-- | Validates the provided entities if and only if the environment variable `UNISON_ENTITY_VALIDATION` is set to "true". +validateEntities :: NEMap Hash32 (Share.Entity Text Hash32 Share.HashJWT) -> Either Share.EntityValidationError () +validateEntities entities = + when shouldValidateEntities $ do + ifor_ (NEMap.toMap entities) \hash entity -> do + let entityWithHashes = entity & Share.entityHashes_ %~ Share.hashJWTHash + case EV.validateEntity hash entityWithHashes of + Nothing -> pure () + Just err@(Share.EntityHashMismatch et (Share.HashMismatchForEntity {supplied, computed})) -> + let expectedMismatches = case et of + Share.TermComponentType -> expectedComponentHashMismatches + Share.DeclComponentType -> expectedComponentHashMismatches + Share.CausalType -> expectedCausalHashMismatches + _ -> mempty + in case Map.lookup supplied expectedMismatches of + Just expected + | expected == computed -> pure () + _ -> do + Left err + Just err -> do + Left err + +-- | Validate entities received from the server unless this flag is set to false. +validationEnvKey :: String +validationEnvKey = "UNISON_ENTITY_VALIDATION" + +shouldValidateEntities :: Bool +shouldValidateEntities = unsafePerformIO $ do + lookupEnv validationEnvKey <&> \case + Just "false" -> False + _ -> True +{-# NOINLINE shouldValidateEntities #-} + +type WorkerCount = + TVar Int + +newWorkerCount :: IO WorkerCount +newWorkerCount = + newTVarIO 0 + +recordWorking :: WorkerCount -> STM () +recordWorking sem = + modifyTVar' sem (+ 1) + +recordNotWorking :: WorkerCount -> STM () +recordNotWorking sem = + modifyTVar' sem \n -> n - 1 + +-- What the dispatcher is to do +data DispatcherJob + = DispatcherForkWorker (NESet Share.HashJWT) + | DispatcherReturnEarlyBecauseDownloaderFailed (SyncError Share.DownloadEntitiesError) + | DispatcherDone + +-- | Finish downloading entities from Unison Share (or return the first failure to download something). +-- +-- Precondition: the entities were *already* downloaded at some point in the past, and are now sitting in the +-- `temp_entity` table, waiting for their dependencies to arrive so they can be flushed to main storage. +completeTempEntities :: + AuthenticatedHttpClient -> + BaseUrl -> + (forall a. ((forall x. Sqlite.Transaction x -> IO x) -> IO a) -> IO a) -> + Share.RepoInfo -> + (Int -> IO ()) -> + NESet Hash32 -> + IO (Either (SyncError Share.DownloadEntitiesError) ()) +completeTempEntities httpClient unisonShareUrl connect repoInfo downloadedCallback initialNewTempEntities = do + -- The set of hashes we still need to download + hashesVar <- newTVarIO Set.empty + + -- The set of hashes that we haven't inserted yet, but will soon, because we've committed to downloading them. + uninsertedHashesVar <- newTVarIO Set.empty + + -- The entities payloads (along with the jwts that we used to download them) that we've downloaded + entitiesQueue <- newTQueueIO + + -- The sets of new (at the time of inserting, anyway) temp entity rows, which we need to elaborate, then download. + newTempEntitiesQueue <- newTQueueIO + + -- How many workers (downloader / inserter / elaborator) are currently doing stuff. + workerCount <- newWorkerCount + + -- The first download error seen by a downloader, if any. + downloaderFailedVar <- newEmptyTMVarIO + + -- Kick off the cycle of inserter->elaborator->dispatcher->downloader by giving the elaborator something to do + atomically (writeTQueue newTempEntitiesQueue (Set.empty, Just initialNewTempEntities)) + + Ki.scoped \scope -> do + Ki.fork_ scope (inserter entitiesQueue newTempEntitiesQueue workerCount) + Ki.fork_ scope (elaborator hashesVar uninsertedHashesVar newTempEntitiesQueue workerCount) + dispatcher hashesVar uninsertedHashesVar entitiesQueue newTempEntitiesQueue workerCount downloaderFailedVar + where + -- Dispatcher thread: "dequeue" from `hashesVar`, fork one-shot downloaders. + -- + -- We stop when either all of the following are true: + -- + -- - There are no outstanding workers (downloaders, inserter, elaboraror) + -- - The inserter thread doesn't have any outstanding work enqueued (in `entitiesQueue`) + -- - The elaborator thread doesn't have any outstanding work enqueued (in `newTempEntitiesQueue`) + -- + -- Or: + -- + -- - Some downloader failed to download something + dispatcher :: + TVar (Set Share.HashJWT) -> + TVar (Set Share.HashJWT) -> + TQueue (NESet Share.HashJWT, NEMap Hash32 (Share.Entity Text Hash32 Share.HashJWT)) -> + TQueue (Set Share.HashJWT, Maybe (NESet Hash32)) -> + WorkerCount -> + TMVar (SyncError Share.DownloadEntitiesError) -> + IO (Either (SyncError Share.DownloadEntitiesError) ()) + dispatcher hashesVar uninsertedHashesVar entitiesQueue newTempEntitiesQueue workerCount downloaderFailedVar = + Ki.scoped \scope -> + let loop :: IO (Either (SyncError Share.DownloadEntitiesError) ()) + loop = + atomically (checkIfDownloaderFailedMode <|> dispatchWorkMode <|> checkIfDoneMode) >>= \case + DispatcherDone -> pure (Right ()) + DispatcherReturnEarlyBecauseDownloaderFailed err -> pure (Left err) + DispatcherForkWorker hashes -> do + atomically do + -- Limit number of simultaneous downloaders (plus 2, for inserter and elaborator) + workers <- readTVar workerCount + check (workers < maxSimultaneousPullDownloaders + 2) + -- we do need to record the downloader as working outside of the worker thread, not inside. + -- otherwise, we might erroneously fall through the teardown logic below and conclude there's + -- nothing more for the dispatcher to do, when in fact a downloader thread just hasn't made it as + -- far as recording its own existence + recordWorking workerCount + _ <- + Ki.fork @() scope do + downloader entitiesQueue workerCount hashes & onLeftM \err -> + void (atomically (tryPutTMVar downloaderFailedVar err)) + loop + in loop + where + checkIfDownloaderFailedMode :: STM DispatcherJob + checkIfDownloaderFailedMode = + DispatcherReturnEarlyBecauseDownloaderFailed <$> readTMVar downloaderFailedVar + + dispatchWorkMode :: STM DispatcherJob + dispatchWorkMode = do + hashes <- readTVar hashesVar + check (not (Set.null hashes)) + let (hashes1, hashes2) = Set.splitAt syncChunkSize hashes + modifyTVar' uninsertedHashesVar (Set.union hashes1) + writeTVar hashesVar hashes2 + pure (DispatcherForkWorker (NESet.unsafeFromSet hashes1)) + + -- Check to see if there are no hashes left to download, no outstanding workers, and no work in either queue + checkIfDoneMode :: STM DispatcherJob + checkIfDoneMode = do + workers <- readTVar workerCount + check (workers == 0) + isEmptyTQueue entitiesQueue >>= check + isEmptyTQueue newTempEntitiesQueue >>= check + pure DispatcherDone + + -- Downloader thread: download entities, (if successful) enqueue to `entitiesQueue` + downloader :: + TQueue (NESet Share.HashJWT, NEMap Hash32 (Share.Entity Text Hash32 Share.HashJWT)) -> + WorkerCount -> + NESet Share.HashJWT -> + IO (Either (SyncError Share.DownloadEntitiesError) ()) + downloader entitiesQueue workerCount hashes = do + httpDownloadEntities httpClient unisonShareUrl Share.DownloadEntitiesRequest {repoInfo, hashes} >>= \case + Left err -> do + atomically (recordNotWorking workerCount) + pure (Left (TransportError err)) + Right (Share.DownloadEntitiesFailure err) -> do + atomically (recordNotWorking workerCount) + pure (Left (SyncError err)) + Right (Share.DownloadEntitiesSuccess entities) -> do + downloadedCallback (NESet.size hashes) + case validateEntities entities of + Left err -> pure . Left . SyncError . Share.DownloadEntitiesEntityValidationFailure $ err + Right () -> do + atomically do + writeTQueue entitiesQueue (hashes, entities) + recordNotWorking workerCount + pure (Right ()) + + -- Inserter thread: dequeue from `entitiesQueue`, insert entities, enqueue to `newTempEntitiesQueue` + inserter :: + TQueue (NESet Share.HashJWT, NEMap Hash32 (Share.Entity Text Hash32 Share.HashJWT)) -> + TQueue (Set Share.HashJWT, Maybe (NESet Hash32)) -> + WorkerCount -> + IO Void + inserter entitiesQueue newTempEntitiesQueue workerCount = + connect \runTransaction -> + forever do + (hashJwts, entities) <- + atomically do + entities <- readTQueue entitiesQueue + recordWorking workerCount + pure entities + newTempEntities0 <- + runTransaction do + NEMap.toList entities & foldMapM \(hash, entity) -> + upsertEntitySomewhere hash entity <&> \case + Q.EntityInMainStorage -> Set.empty + Q.EntityInTempStorage -> Set.singleton hash + atomically do + writeTQueue newTempEntitiesQueue (NESet.toSet hashJwts, NESet.nonEmptySet newTempEntities0) + recordNotWorking workerCount + + -- Elaborator thread: dequeue from `newTempEntitiesQueue`, elaborate, "enqueue" to `hashesVar` + elaborator :: + TVar (Set Share.HashJWT) -> + TVar (Set Share.HashJWT) -> + TQueue (Set Share.HashJWT, Maybe (NESet Hash32)) -> + WorkerCount -> + IO Void + elaborator hashesVar uninsertedHashesVar newTempEntitiesQueue workerCount = + connect \runTransaction -> + forever do + maybeNewTempEntities <- + atomically do + (hashJwts, mayNewTempEntities) <- readTQueue newTempEntitiesQueue + -- Avoid unnecessary retaining of these hashes to keep memory usage more stable. This algorithm would + -- still be correct if we never delete from `uninsertedHashes`. + -- + -- We remove the inserted hashes from uninsertedHashesVar at this point rather than right after insertion + -- in order to ensure that no running transaction of the elaborator is viewing a snapshot that precedes + -- the snapshot that inserted those hashes. + modifyTVar' uninsertedHashesVar \uninsertedHashes -> Set.difference uninsertedHashes hashJwts + case mayNewTempEntities of + Nothing -> pure Nothing + Just newTempEntities -> do + recordWorking workerCount + pure (Just newTempEntities) + whenJust maybeNewTempEntities \newTempEntities -> do + newElaboratedHashes <- runTransaction (elaborateHashes newTempEntities) + atomically do + uninsertedHashes <- readTVar uninsertedHashesVar + hashes0 <- readTVar hashesVar + writeTVar hashesVar $! Set.union (Set.difference newElaboratedHashes uninsertedHashes) hashes0 + recordNotWorking workerCount + +-- | Insert entities into the database, and return the subset that went into temp storage (`temp_entitiy`) rather than +-- of main storage (`object` / `causal`) due to missing dependencies. +insertEntities :: NEMap Hash32 (Share.Entity Text Hash32 Share.HashJWT) -> Sqlite.Transaction (Set Hash32) +insertEntities entities = + NEMap.toList entities & foldMapM \(hash, entity) -> + upsertEntitySomewhere hash entity <&> \case + Q.EntityInMainStorage -> Set.empty + Q.EntityInTempStorage -> Set.singleton hash + +------------------------------------------------------------------------------------------------------------------------ +-- Get causal hash by path + +-- | Get the causal hash of a path hosted on Unison Share. +getCausalHashByPath :: + -- | The Unison Share URL. + BaseUrl -> + Share.Path -> + Cli (Either (SyncError GetCausalHashByPathError) (Maybe Share.HashJWT)) +getCausalHashByPath unisonShareUrl repoPath = do + Cli.Env {authHTTPClient} <- ask + liftIO (httpGetCausalHashByPath authHTTPClient unisonShareUrl (Share.GetCausalHashByPathRequest repoPath)) <&> \case + Left err -> Left (TransportError err) + Right (Share.GetCausalHashByPathSuccess maybeHashJwt) -> Right maybeHashJwt + Right (Share.GetCausalHashByPathNoReadPermission _) -> + Left (SyncError (GetCausalHashByPathErrorNoReadPermission repoPath)) + Right (Share.GetCausalHashByPathInvalidRepoInfo err repoInfo) -> + Left (SyncError (GetCausalHashByPathErrorInvalidRepoInfo err repoInfo)) + Right Share.GetCausalHashByPathUserNotFound -> + Left (SyncError $ GetCausalHashByPathErrorUserNotFound (Share.pathRepoInfo repoPath)) + +------------------------------------------------------------------------------------------------------------------------ +-- Upload entities + +data UploadDispatcherJob + = UploadDispatcherReturnFailure (SyncError Share.UploadEntitiesError) + | UploadDispatcherForkWorkerWhenAvailable (NESet Hash32) + | UploadDispatcherForkWorker (NESet Hash32) + | UploadDispatcherDone + +-- | Upload a set of entities to Unison Share. If the server responds that it cannot yet store any hash(es) due to +-- missing dependencies, send those dependencies too, and on and on, until the server stops responding that it's missing +-- anything. +-- +-- Returns true on success, false on failure (because the user does not have write permission). +uploadEntities :: + BaseUrl -> + Share.RepoInfo -> + NESet Hash32 -> + (Int -> IO ()) -> + Cli (Either (SyncError Share.UploadEntitiesError) ()) +uploadEntities unisonShareUrl repoInfo hashes0 uploadedCallback = do + Cli.Env {authHTTPClient, codebase} <- ask + + liftIO do + hashesVar <- newTVarIO (NESet.toSet hashes0) + -- Semantically, this is the set of hashes we've uploaded so far, but we do delete from it when it's safe to, so it + -- doesn't grow unbounded. It's used to filter out hashes that would be duplicate uploads: the server, when + -- responding to any particular upload request, may declare that it still needs some hashes that we're in the + -- process of uploading from another thread. + dedupeVar <- newTVarIO Set.empty + nextWorkerIdVar <- newTVarIO 0 + workersVar <- newTVarIO Set.empty + workerFailedVar <- newEmptyTMVarIO + + Ki.scoped \scope -> + dispatcher + scope + authHTTPClient + (Codebase.runTransaction codebase) + hashesVar + dedupeVar + nextWorkerIdVar + workersVar + workerFailedVar + where + dispatcher :: + Ki.Scope -> + AuthenticatedHttpClient -> + (forall a. Sqlite.Transaction a -> IO a) -> + TVar (Set Hash32) -> + TVar (Set Hash32) -> + TVar Int -> + TVar (Set Int) -> + TMVar (SyncError Share.UploadEntitiesError) -> + IO (Either (SyncError Share.UploadEntitiesError) ()) + dispatcher scope httpClient runTransaction hashesVar dedupeVar nextWorkerIdVar workersVar workerFailedVar = do + loop + where + loop :: IO (Either (SyncError Share.UploadEntitiesError) ()) + loop = + doJob [checkForFailureMode, dispatchWorkMode, checkIfDoneMode] + + doJob :: [STM UploadDispatcherJob] -> IO (Either (SyncError Share.UploadEntitiesError) ()) + doJob jobs = + atomically (asum jobs) >>= \case + UploadDispatcherReturnFailure err -> pure (Left err) + UploadDispatcherForkWorkerWhenAvailable hashes -> doJob [forkWorkerMode hashes, checkForFailureMode] + UploadDispatcherForkWorker hashes -> do + workerId <- + atomically do + workerId <- readTVar nextWorkerIdVar + writeTVar nextWorkerIdVar $! workerId + 1 + modifyTVar' workersVar (Set.insert workerId) + pure workerId + _ <- + Ki.fork @() scope do + worker httpClient runTransaction hashesVar dedupeVar workersVar workerFailedVar workerId hashes + loop + UploadDispatcherDone -> pure (Right ()) + + checkForFailureMode :: STM UploadDispatcherJob + checkForFailureMode = do + err <- readTMVar workerFailedVar + pure (UploadDispatcherReturnFailure err) + + dispatchWorkMode :: STM UploadDispatcherJob + dispatchWorkMode = do + hashes <- readTVar hashesVar + when (Set.null hashes) retry + let (hashes1, hashes2) = Set.splitAt syncChunkSize hashes + modifyTVar' dedupeVar (Set.union hashes1) + writeTVar hashesVar hashes2 + pure (UploadDispatcherForkWorkerWhenAvailable (NESet.unsafeFromSet hashes1)) + + forkWorkerMode :: NESet Hash32 -> STM UploadDispatcherJob + forkWorkerMode hashes = do + workers <- readTVar workersVar + when (Set.size workers >= maxSimultaneousPushWorkers) retry + pure (UploadDispatcherForkWorker hashes) + + checkIfDoneMode :: STM UploadDispatcherJob + checkIfDoneMode = do + workers <- readTVar workersVar + when (not (Set.null workers)) retry + pure UploadDispatcherDone + + worker :: + AuthenticatedHttpClient -> + (forall a. Sqlite.Transaction a -> IO a) -> + TVar (Set Hash32) -> + TVar (Set Hash32) -> + TVar (Set Int) -> + TMVar (SyncError Share.UploadEntitiesError) -> + Int -> + NESet Hash32 -> + IO () + worker httpClient runTransaction hashesVar dedupeVar workersVar workerFailedVar workerId hashes = do + entities <- + fmap NEMap.fromAscList do + runTransaction do + for (NESet.toAscList hashes) \hash -> do + entity <- expectEntity hash + pure (hash, entity) + + result <- + httpUploadEntities httpClient unisonShareUrl Share.UploadEntitiesRequest {entities, repoInfo} <&> \case + Left err -> Left (TransportError err) + Right response -> + case response of + Share.UploadEntitiesSuccess -> Right Set.empty + Share.UploadEntitiesFailure err -> + case err of + Share.UploadEntitiesError'NeedDependencies (Share.NeedDependencies moreHashes) -> + Right (NESet.toSet moreHashes) + err -> Left (SyncError err) + + case result of + Left err -> void (atomically (tryPutTMVar workerFailedVar err)) + Right moreHashes -> do + uploadedCallback (NESet.size hashes) + maybeYoungestWorkerThatWasAlive <- + atomically do + -- Record ourselves as "dead". The only work we have left to do is remove the hashes we just uploaded from + -- the `dedupe` set, but whether or not we are "alive" is relevant only to: + -- + -- - The main dispatcher thread, which terminates when there are no more hashes to upload, and no alive + -- workers. It is not important for us to delete from the `dedupe` set in this case. + -- + -- - Other worker threads, each of which independently decides when it is safe to delete the set of + -- hashes they just uploaded from the `dedupe` set (as we are doing now). + !workers <- Set.delete workerId <$> readTVar workersVar + writeTVar workersVar workers + -- Add more work (i.e. hashes to upload) to the work queue (really a work set), per the response we just + -- got from the server. Remember to only add hashes that aren't in the `dedupe` set (see the comment on + -- the dedupe set above for more info). + when (not (Set.null moreHashes)) do + dedupe <- readTVar dedupeVar + hashes0 <- readTVar hashesVar + writeTVar hashesVar $! Set.union (Set.difference moreHashes dedupe) hashes0 + pure (Set.lookupMax workers) + -- Block until we are sure that the server does not have any uncommitted transactions that see a version of + -- the database that does not include the entities we just uploaded. After that point, it's fine to remove the + -- hashes of the entities we just uploaded from the `dedupe` set, because they will never be relevant for any + -- subsequent deduping operations. If we didn't delete from the `dedupe` set, this algorithm would still be + -- correct, it would just use an unbounded amount of memory to remember all the hashes we've uploaded so far. + whenJust maybeYoungestWorkerThatWasAlive \youngestWorkerThatWasAlive -> do + atomically do + workers <- readTVar workersVar + whenJust (Set.lookupMin workers) \oldestWorkerAlive -> + when (oldestWorkerAlive <= youngestWorkerThatWasAlive) retry + atomically (modifyTVar' dedupeVar (`Set.difference` (NESet.toSet hashes))) + +------------------------------------------------------------------------------------------------------------------------ +-- Database operations + +-- | "Elaborate" a set of `temp_entity` hashes. +-- +-- For each hash, then we ought to instead download its missing dependencies (which themselves are +-- elaborated by this same procedure, in case we have any of *them* already in temp storage, too. +-- 3. If it's in main storage, we should ignore it. +-- +-- In the end, we return a set of hashes that correspond to entities we actually need to download. +elaborateHashes :: NESet Hash32 -> Sqlite.Transaction (Set Share.HashJWT) +elaborateHashes hashes = + Q.elaborateHashes (NESet.toList hashes) <&> Set.fromList . coerce @[Text] @[Share.HashJWT] + +-- | Upsert a downloaded entity "somewhere" - +-- +-- 1. Nowhere if we already had the entity (in main or temp storage). +-- 2. In main storage if we already have all of its dependencies in main storage. +-- 3. In temp storage otherwise. +upsertEntitySomewhere :: + Hash32 -> + Share.Entity Text Hash32 Share.HashJWT -> + Sqlite.Transaction Q.EntityLocation +upsertEntitySomewhere hash entity = + Q.entityLocation hash >>= \case + Just location -> pure location + Nothing -> do + missingDependencies1 :: Map Hash32 Share.HashJWT <- + Share.entityDependencies entity + & foldMapM + ( \hashJwt -> do + let hash = Share.hashJWTHash hashJwt + Q.entityExists hash <&> \case + True -> Map.empty + False -> Map.singleton hash hashJwt + ) + case NEMap.nonEmptyMap missingDependencies1 of + Nothing -> do + _id <- Q.saveTempEntityInMain v2HashHandle hash (entityToTempEntity Share.hashJWTHash entity) + pure Q.EntityInMainStorage + Just missingDependencies -> do + Q.insertTempEntity + hash + (entityToTempEntity Share.hashJWTHash entity) + ( coerce + @(NEMap Hash32 Share.HashJWT) + @(NEMap Hash32 Text) + missingDependencies + ) + pure Q.EntityInTempStorage + +------------------------------------------------------------------------------------------------------------------------ +-- HTTP calls + +httpGetCausalHashByPath :: + Auth.AuthenticatedHttpClient -> + BaseUrl -> + Share.GetCausalHashByPathRequest -> + IO (Either CodeserverTransportError Share.GetCausalHashByPathResponse) +httpDownloadEntities :: + Auth.AuthenticatedHttpClient -> + BaseUrl -> + Share.DownloadEntitiesRequest -> + IO (Either CodeserverTransportError Share.DownloadEntitiesResponse) +httpUploadEntities :: + Auth.AuthenticatedHttpClient -> + BaseUrl -> + Share.UploadEntitiesRequest -> + IO (Either CodeserverTransportError Share.UploadEntitiesResponse) +( httpGetCausalHashByPath, + httpDownloadEntities, + httpUploadEntities + ) = + let ( httpGetCausalHashByPath + Servant.:<|> httpDownloadEntities + Servant.:<|> httpUploadEntities + ) = + let pp :: Proxy ("ucm" Servant.:> "v1" Servant.:> "sync" Servant.:> Share.API) + pp = Proxy + in Servant.hoistClient pp hoist (Servant.client pp) + in ( go httpGetCausalHashByPath, + go httpDownloadEntities, + go httpUploadEntities + ) + where + hoist :: Servant.ClientM a -> ReaderT Servant.ClientEnv (ExceptT CodeserverTransportError IO) a + hoist m = do + clientEnv <- Reader.ask + liftIO (Servant.runClientM m clientEnv) >>= \case + Right a -> pure a + Left err -> do + Debug.debugLogM Debug.Sync (show err) + throwError case err of + Servant.FailureResponse _req resp -> + case HTTP.statusCode $ Servant.responseStatusCode resp of + 401 -> Unauthenticated (Servant.baseUrl clientEnv) + -- The server should provide semantically relevant permission-denied messages + -- when possible, but this should catch any we miss. + 403 -> PermissionDenied (Text.Lazy.toStrict . Text.Lazy.decodeUtf8 $ Servant.responseBody resp) + 408 -> Timeout + 429 -> RateLimitExceeded + 504 -> Timeout + _ -> UnexpectedResponse resp + Servant.DecodeFailure msg resp -> DecodeFailure msg resp + Servant.UnsupportedContentType _ct resp -> UnexpectedResponse resp + Servant.InvalidContentTypeHeader resp -> UnexpectedResponse resp + Servant.ConnectionError _ -> UnreachableCodeserver (Servant.baseUrl clientEnv) + + go :: + (req -> ReaderT Servant.ClientEnv (ExceptT CodeserverTransportError IO) resp) -> + Auth.AuthenticatedHttpClient -> + BaseUrl -> + req -> + IO (Either CodeserverTransportError resp) + go f (Auth.AuthenticatedHttpClient httpClient) unisonShareUrl req = + (Servant.mkClientEnv httpClient unisonShareUrl) + { Servant.makeClientRequest = \url request -> + -- Disable client-side timeouts + (Servant.defaultMakeClientRequest url request) + { Http.Client.responseTimeout = Http.Client.responseTimeoutNone + } + } + & runReaderT (f req) + & runExceptT diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index d3f24db564..c3965c1432 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -96,6 +96,7 @@ module U.Codebase.Sqlite.Operations -- * Projects expectProjectAndBranchNames, + expectProjectBranchHead, -- * reflog getReflog, @@ -1524,3 +1525,8 @@ expectProjectAndBranchNames projectId projectBranchId = do Project {name = pName} <- Q.expectProject projectId ProjectBranch {name = bName} <- Q.expectProjectBranch projectId projectBranchId pure (pName, bName) + +expectProjectBranchHead :: Db.ProjectId -> Db.ProjectBranchId -> Transaction CausalHash +expectProjectBranchHead projId projectBranchId = do + chId <- Q.expectProjectBranchHead projId projectBranchId + Q.expectCausalHash chId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs index 0884efcb23..81dbbc2816 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs @@ -9,13 +9,13 @@ import Control.Lens (_1, _2) import Data.Set.NonEmpty qualified as Set.NonEmpty import Data.Text as Text import Data.These (These (..)) -import Data.Void (absurd) import System.Console.Regions qualified as Console.Regions import Text.Builder qualified import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Sqlite.DbId import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Project qualified as Sqlite (Project) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch) import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite (ProjectBranch) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) @@ -31,9 +31,6 @@ import Unison.Codebase.Editor.Input ) import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Editor.Output.PushPull (PushPull (Push)) -import Unison.Codebase.Path qualified as Path -import Unison.Codebase.PushBehavior (PushBehavior) import Unison.Codebase.PushBehavior qualified as PushBehavior import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName)) import Unison.Hash32 (Hash32) @@ -70,11 +67,6 @@ handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do PushSourceTarget1 remoteProjectAndBranch0 -> do localProjectAndBranch <- Cli.getCurrentProjectAndBranch pushProjectBranchToProjectBranch force localProjectAndBranch (Just remoteProjectAndBranch0) - -- push .some.path to @some/project - PushSourceTarget2 (PathySource localPath0) remoteProjectAndBranch0 -> do - localPath <- Cli.resolvePath' localPath0 - remoteProjectAndBranch <- ProjectUtils.hydrateNames remoteProjectAndBranch0 - pushLooseCodeToProjectBranch force localPath remoteProjectAndBranch -- push @some/project to @some/project PushSourceTarget2 (ProjySource localProjectAndBranch0) remoteProjectAndBranch -> do localProjectAndBranch <- ProjectUtils.expectProjectAndBranchByTheseNames localProjectAndBranch0 @@ -86,19 +78,6 @@ handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do PushBehavior.RequireEmpty -> False PushBehavior.RequireNonEmpty -> False --- Push a local namespace ("loose code") to a remote project branch. -pushLooseCodeToProjectBranch :: Bool -> Path.Absolute -> ProjectAndBranch ProjectName ProjectBranchName -> Cli () -pushLooseCodeToProjectBranch force localPath remoteProjectAndBranch = do - _ <- AuthLogin.ensureAuthenticatedWithCodeserver Codeserver.defaultCodeserver - localBranchHead <- - Cli.runTransactionWithRollback \rollback -> do - loadCausalHashToPush localPath >>= \case - Nothing -> rollback (EmptyLooseCodePush (Path.absoluteToPath' localPath)) - Just hash -> pure hash - - uploadPlan <- pushToProjectBranch0 force PushingLooseCode localBranchHead remoteProjectAndBranch - executeUploadPlan uploadPlan - -- | Push a local project branch to a remote project branch. If the remote project branch is left unspecified, we either -- use a pre-existing mapping for the local branch, or else infer what remote branch to push to (possibly creating it). pushProjectBranchToProjectBranch :: @@ -109,14 +88,11 @@ pushProjectBranchToProjectBranch :: pushProjectBranchToProjectBranch force localProjectAndBranch maybeRemoteProjectAndBranchNames = do _ <- AuthLogin.ensureAuthenticatedWithCodeserver Codeserver.defaultCodeserver let localProjectAndBranchIds = localProjectAndBranch & over #project (view #projectId) & over #branch (view #branchId) - let localProjectAndBranchNames = localProjectAndBranch & over #project (view #name) & over #branch (view #name) -- Load local project and branch from database and get the causal hash to push (localProjectAndBranch, localBranchHead) <- - Cli.runTransactionWithRollback \rollback -> do - hash <- - loadCausalHashToPush (ProjectUtils.projectBranchPath localProjectAndBranchIds) & onNothingM do - rollback (EmptyProjectBranchPush localProjectAndBranchNames) + Cli.runTransaction do + hash <- expectCausalHashToPush (localProjectAndBranch ^. #branch) localProjectAndBranch <- expectProjectAndBranch localProjectAndBranchIds pure (localProjectAndBranch, hash) @@ -432,7 +408,7 @@ executeUploadPlan UploadPlan {remoteBranch, causalHash, afterUploadAction} = do Cli.respond (Output.UploadedEntities numUploaded) afterUploadAction let ProjectAndBranch projectName branchName = remoteBranch - Cli.respond (ViewOnShare (Right (Share.hardCodedUri, projectName, branchName))) + Cli.respond (ViewOnShare (Share.hardCodedUri, projectName, branchName)) ------------------------------------------------------------------------------------------------------------------------ -- After upload actions @@ -524,7 +500,7 @@ makeSetHeadAfterUploadAction force pushing localBranchHead remoteBranch = do when (localBranchHead == Share.API.hashJWTHash remoteBranch.branchHead) do Cli.respond (RemoteProjectBranchIsUpToDate Share.hardCodedUri remoteProjectAndBranchNames) - Cli.returnEarly (ViewOnShare (Right (Share.hardCodedUri, remoteBranch.projectName, remoteBranch.branchName))) + Cli.returnEarly (ViewOnShare (Share.hardCodedUri, remoteBranch.projectName, remoteBranch.branchName)) when (not force) do whenM (Cli.runTransaction (wouldNotBeFastForward localBranchHead remoteBranchHead)) do @@ -594,14 +570,11 @@ expectProjectAndBranch (ProjectAndBranch projectId branchId) = <$> Queries.expectProject projectId <*> Queries.expectProjectBranch projectId branchId --- Get the causal hash to push at the given path. Return Nothing if there's no history. -loadCausalHashToPush :: Path.Absolute -> Sqlite.Transaction (Maybe Hash32) -loadCausalHashToPush path = - Operations.loadCausalHashAtPath Nothing segments <&> \case - Nothing -> Nothing - Just (CausalHash hash) -> Just (Hash32.fromHash hash) - where - segments = Path.toList (Path.unabsolute path) +-- Get the causal hash for the given project branch. +expectCausalHashToPush :: ProjectBranch -> Sqlite.Transaction Hash32 +expectCausalHashToPush pb = do + CausalHash causalHash <- Operations.expectProjectBranchHead (pb ^. #projectId) (pb ^. #branchId) + pure (Hash32.fromHash causalHash) -- Were we to try to advance `remoteBranchHead` to `localBranchHead`, would it *not* be a fast-forward? wouldNotBeFastForward :: Hash32 -> Hash32 -> Sqlite.Transaction Bool diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 9f5e57f32d..46cab3a744 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -247,8 +247,7 @@ data PullSourceTarget deriving stock (Eq, Show) data PushSource - = PathySource Path' - | ProjySource (These ProjectName ProjectBranchName) + = ProjySource (These ProjectName ProjectBranchName) deriving stock (Eq, Show) -- | Push source and target: either neither is specified, or only a target, or both. diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 090d78bc1e..b137b5d32f 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -426,9 +426,7 @@ data WhichBranchEmpty | WhichBranchEmptyPath (Either ProjectPath Path') data ShareError - = ShareErrorCheckAndSetPush Sync.CheckAndSetPushError - | ShareErrorDownloadEntities Share.DownloadEntitiesError - | ShareErrorFastForwardPush Sync.FastForwardPushError + = ShareErrorDownloadEntities Share.DownloadEntitiesError | ShareErrorGetCausalHashByPath Sync.GetCausalHashByPathError | ShareErrorPull Sync.PullError | ShareErrorTransport Sync.CodeserverTransportError diff --git a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs index d9520379f4..14e7412c4e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs +++ b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs @@ -1,6 +1,7 @@ module Unison.Codebase.Editor.UriParser ( readRemoteNamespaceParser, parseReadShareLooseCode, + writeRemoteNamespace, ) where @@ -19,7 +20,7 @@ import Unison.Codebase.Editor.RemoteRepo import Unison.Codebase.Path qualified as Path import Unison.NameSegment (NameSegment) import Unison.Prelude -import Unison.Project (ProjectBranchSpecifier (..), ProjectName, projectAndBranchNamesParser) +import Unison.Project (ProjectBranchName, ProjectBranchSpecifier (..), ProjectName, projectAndBranchNamesParser) import Unison.Syntax.Lexer qualified import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Util.Pretty qualified as P @@ -47,6 +48,12 @@ parseReadShareLooseCode label input = let printError err = P.lines [P.string "I couldn't parse this as a share path.", P.prettyPrintParseError input err] in first printError (P.parse readShareLooseCode label (Text.pack input)) +-- >>> P.parseMaybe writeRemoteNamespace "unisonweb.base._releases.M4" +-- Just (WriteRemoteNamespaceShare (WriteShareRemoteNamespace {server = ShareRepo, repo = "unisonweb", path = base._releases.M4})) +writeRemoteNamespace :: P (These ProjectName ProjectBranchName) +writeRemoteNamespace = + (projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths ProjectBranchSpecifier'Name) + -- >>> P.parseMaybe readShareLooseCode ".unisonweb.base._releases.M4" -- >>> P.parseMaybe readShareLooseCode "unisonweb.base._releases.M4" -- Nothing diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index b5b2787344..5195866641 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -171,7 +171,7 @@ import Unison.Codebase.Branch.Merge qualified as Branch import Unison.Codebase.Editor.Input (DeleteOutput (..), DeleteTarget (..), Input) import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output.PushPull (PushPull (Pull, Push)) -import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteRemoteNamespace) +import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace) import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Editor.SlurpResult qualified as SR import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) @@ -640,11 +640,11 @@ handlePullSourceArg = otherNumArg -> Left $ wrongStructuredArgument "a source to pull from" otherNumArg handlePushTargetArg :: - I.Argument -> Either (P.Pretty CT.ColorText) (WriteRemoteNamespace (These ProjectName ProjectBranchName)) + I.Argument -> Either (P.Pretty CT.ColorText) (These ProjectName ProjectBranchName) handlePushTargetArg = either (maybe (Left "Wanted a source to push from, but this ain’t it.") pure . parsePushTarget) - $ fmap RemoteRepo.WriteRemoteProjectBranch . \case + $ \case SA.Project project -> pure $ This project SA.ProjectBranch (ProjectAndBranch project branch) -> pure $ maybe That These project branch otherNumArg -> Left $ wrongStructuredArgument "a source to push from" otherNumArg @@ -654,11 +654,6 @@ handlePushSourceArg = either (maybe (Left $ P.text "Wanted a source to push from, but this ain’t it.") pure . parsePushSource) \case - SA.AbsolutePath path -> pure . Input.PathySource $ Path.absoluteToPath' path - SA.Name name -> pure . Input.PathySource $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> pure . Input.PathySource $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . Input.PathySource . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name SA.Project project -> pure . Input.ProjySource $ This project SA.ProjectBranch (ProjectAndBranch project branch) -> pure . Input.ProjySource $ maybe That These project branch otherNumArg -> Left $ wrongStructuredArgument "a source to push from" otherNumArg @@ -3847,12 +3842,11 @@ projectNameSuggestions slash (Text.strip . Text.pack -> input) codebase = do parsePushSource :: String -> Maybe Input.PushSource parsePushSource sourceStr = fixup Input.ProjySource (tryFrom $ Text.pack sourceStr) - <|> fixup Input.PathySource (Path.parsePath' sourceStr) where fixup = either (const Nothing) . (pure .) -- | Parse a push target. -parsePushTarget :: String -> Maybe (WriteRemoteNamespace (These ProjectName ProjectBranchName)) +parsePushTarget :: String -> Maybe (These ProjectName ProjectBranchName) parsePushTarget = Megaparsec.parseMaybe UriParser.writeRemoteNamespace . Text.pack parseHashQualifiedName :: diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 5645ce7458..bc95371850 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -57,8 +57,6 @@ import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.Output qualified as E import Unison.Codebase.Editor.Output.BranchDiff qualified as OBD import Unison.Codebase.Editor.Output.PushPull qualified as PushPull -import Unison.Codebase.Editor.RemoteRepo (ShareUserHandle (..), WriteRemoteNamespace (..), WriteShareRemoteNamespace (..)) -import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) import Unison.Codebase.Editor.StructuredArgument qualified as SA @@ -67,7 +65,6 @@ import Unison.Codebase.IntegrityCheck (IntegrityResult (..), prettyPrintIntegrit import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path qualified as Path -import Unison.Codebase.PushBehavior qualified as PushBehavior import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH @@ -91,7 +88,6 @@ import Unison.LabeledDependency as LD import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment -import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Names (Names (..)) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names @@ -1533,11 +1529,6 @@ notifyUser dir = \case <> ( terms <&> \(n, r) -> prettyHashQualified' (HQ'.take hqLength . HQ'.fromNamedReference n $ Reference.DerivedId r) ) - RefusedToPush pushBehavior path -> - (pure . P.warnCallout) case pushBehavior of - PushBehavior.ForcePush -> error "impossible: refused to push due to ForcePush?" - PushBehavior.RequireEmpty -> expectedEmptyPushDest path - PushBehavior.RequireNonEmpty -> expectedNonEmptyPushDest path GistCreated remoteNamespace -> pure $ P.lines @@ -1599,10 +1590,7 @@ notifyUser dir = \case PrintVersion ucmVersion -> pure (P.text ucmVersion) ShareError shareError -> pure (prettyShareError shareError) ViewOnShare shareRef -> - pure $ - "View it here: " <> case shareRef of - Left repoPath -> prettyShareLink repoPath - Right branchInfo -> prettyRemoteBranchInfo branchInfo + pure $ "View it here: " <> prettyRemoteBranchInfo shareRef IntegrityCheck result -> pure $ case result of NoIntegrityErrors -> "🎉 No issues detected 🎉" IntegrityErrorDetected ns -> prettyPrintIntegrityErrors ns @@ -2120,39 +2108,16 @@ notifyUser dir = \case Nothing -> prettyProjectBranchName targetBranch Just targetProject -> prettyProjectAndBranchName (ProjectAndBranch targetProject targetBranch) -expectedEmptyPushDest :: WriteRemoteNamespace Void -> Pretty -expectedEmptyPushDest namespace = - P.lines - [ "The remote namespace " <> prettyWriteRemoteNamespace (absurd <$> namespace) <> " is not empty.", - "", - "Did you mean to use " <> IP.makeExample' IP.push <> " instead?" - ] - -expectedNonEmptyPushDest :: WriteRemoteNamespace Void -> Pretty -expectedNonEmptyPushDest namespace = - P.lines - [ P.wrap ("The remote namespace " <> prettyWriteRemoteNamespace (absurd <$> namespace) <> " is empty."), - "", - P.wrap ("Did you mean to use " <> IP.makeExample' IP.pushCreate <> " instead?") - ] - prettyShareError :: ShareError -> Pretty prettyShareError = P.fatalCallout . \case - ShareErrorCheckAndSetPush err -> prettyCheckAndSetPushError err ShareErrorDownloadEntities err -> prettyDownloadEntitiesError err - ShareErrorFastForwardPush err -> prettyFastForwardPushError err ShareErrorGetCausalHashByPath err -> prettyGetCausalHashByPathError err ShareErrorPull err -> prettyPullError err ShareErrorTransport err -> prettyTransportError err ShareErrorUploadEntities err -> prettyUploadEntitiesError err ShareExpectedSquashedHead -> "The server failed to provide a squashed branch head when requested. Please report this as a bug to the Unison team." -prettyCheckAndSetPushError :: Share.CheckAndSetPushError -> Pretty -prettyCheckAndSetPushError = \case - Share.CheckAndSetPushError'UpdatePath repoInfo err -> prettyUpdatePathError repoInfo err - Share.CheckAndSetPushError'UploadEntities err -> prettyUploadEntitiesError err - prettyDownloadEntitiesError :: Share.DownloadEntitiesError -> Pretty prettyDownloadEntitiesError = \case Share.DownloadEntitiesNoReadPermission repoInfo -> noReadPermissionForRepo repoInfo @@ -2161,27 +2126,6 @@ prettyDownloadEntitiesError = \case Share.DownloadEntitiesProjectNotFound project -> shareProjectNotFound project Share.DownloadEntitiesEntityValidationFailure err -> prettyEntityValidationFailure err -prettyFastForwardPathError :: Share.Path -> Share.FastForwardPathError -> Pretty -prettyFastForwardPathError path = \case - Share.FastForwardPathError'InvalidParentage Share.InvalidParentage {child, parent} -> - P.lines - [ "The server detected an error in the history being pushed, please report this as a bug in ucm.", - "The history in question is the hash: " <> prettyHash32 child <> " with the ancestor: " <> prettyHash32 parent - ] - Share.FastForwardPathError'InvalidRepoInfo err repoInfo -> invalidRepoInfo err repoInfo - Share.FastForwardPathError'MissingDependencies dependencies -> needDependencies dependencies - Share.FastForwardPathError'NoHistory -> expectedNonEmptyPushDest (sharePathToWriteRemotePathShare path) - Share.FastForwardPathError'NoWritePermission path -> noWritePermissionForPath path - Share.FastForwardPathError'NotFastForward _hashJwt -> notFastForward path - Share.FastForwardPathError'UserNotFound -> shareUserNotFound (Share.pathRepoInfo path) - -prettyFastForwardPushError :: Share.FastForwardPushError -> Pretty -prettyFastForwardPushError = \case - Share.FastForwardPushError'FastForwardPath path err -> prettyFastForwardPathError path err - Share.FastForwardPushError'GetCausalHash err -> prettyGetCausalHashByPathError err - Share.FastForwardPushError'NotFastForward path -> notFastForward path - Share.FastForwardPushError'UploadEntities err -> prettyUploadEntitiesError err - prettyGetCausalHashByPathError :: Share.GetCausalHashByPathError -> Pretty prettyGetCausalHashByPathError = \case Share.GetCausalHashByPathErrorNoReadPermission sharePath -> noReadPermissionForPath sharePath @@ -2195,21 +2139,6 @@ prettyPullError = \case Share.PullError'NoHistoryAtPath sharePath -> P.wrap $ P.text "The server didn't find anything at" <> prettySharePath sharePath -prettyUpdatePathError :: Share.RepoInfo -> Share.UpdatePathError -> Pretty -prettyUpdatePathError repoInfo = \case - Share.UpdatePathError'HashMismatch Share.HashMismatch {path = sharePath, expectedHash, actualHash} -> - case (expectedHash, actualHash) of - (Nothing, Just _) -> expectedEmptyPushDest (sharePathToWriteRemotePathShare sharePath) - _ -> - P.wrap $ - P.text "It looks like someone modified" - <> prettySharePath sharePath - <> P.text "an instant before you. Pull and try again? 🤞" - Share.UpdatePathError'InvalidRepoInfo err repoInfo -> invalidRepoInfo err repoInfo - Share.UpdatePathError'MissingDependencies dependencies -> needDependencies dependencies - Share.UpdatePathError'NoWritePermission path -> noWritePermissionForPath path - Share.UpdatePathError'UserNotFound -> shareUserNotFound repoInfo - prettyUploadEntitiesError :: Share.UploadEntitiesError -> Pretty prettyUploadEntitiesError = \case Share.UploadEntitiesError'EntityValidationFailure validationFailureErr -> prettyEntityValidationFailure validationFailureErr @@ -2407,17 +2336,6 @@ shareUserNotFound :: Share.RepoInfo -> Pretty shareUserNotFound repoInfo = P.wrap ("User" <> prettyRepoInfo repoInfo <> "does not exist.") -sharePathToWriteRemotePathShare :: Share.Path -> WriteRemoteNamespace void -sharePathToWriteRemotePathShare sharePath = - -- Recover the original WriteRemotePath from the information in the error, which is thrown from generic share - -- client code that doesn't know about WriteRemotePath - WriteRemoteNamespaceShare - WriteShareRemoteNamespace - { server = RemoteRepo.DefaultCodeserver, - repo = ShareUserHandle $ Share.unRepoInfo (Share.pathRepoInfo sharePath), - path = Path.fromList (coerce @[Text] @[NameSegment] (Share.pathCodebasePath sharePath)) - } - formatMissingStuff :: (Show tm, Show typ) => [(HQ.HashQualified Name, tm)] -> diff --git a/unison-cli/src/Unison/Share/Sync.hs b/unison-cli/src/Unison/Share/Sync.hs index 8df14b8f99..6ccf8939ef 100644 --- a/unison-cli/src/Unison/Share/Sync.hs +++ b/unison-cli/src/Unison/Share/Sync.hs @@ -6,14 +6,10 @@ module Unison.Share.Sync getCausalHashByPath, GetCausalHashByPathError (..), - -- ** Push - checkAndSetPush, - CheckAndSetPushError (..), - fastForwardPush, - FastForwardPushError (..), + -- ** Upload uploadEntities, - -- ** Pull + -- ** Pull/Download pull, PullError (..), downloadEntities, @@ -26,16 +22,10 @@ import Control.Monad.Except import Control.Monad.Reader (ask) import Control.Monad.Trans.Reader (ReaderT, runReaderT) import Control.Monad.Trans.Reader qualified as Reader -import Data.Foldable qualified as Foldable (find) -import Data.List.NonEmpty (pattern (:|)) -import Data.List.NonEmpty qualified as List (NonEmpty) -import Data.List.NonEmpty qualified as List.NonEmpty import Data.Map qualified as Map import Data.Map.NonEmpty (NEMap) import Data.Map.NonEmpty qualified as NEMap import Data.Proxy -import Data.Sequence.NonEmpty (NESeq ((:<||))) -import Data.Sequence.NonEmpty qualified as NESeq (fromList, nonEmptySeq, (><|)) import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) import Data.Set.NonEmpty qualified as NESet @@ -65,7 +55,7 @@ import Unison.Share.ExpectedHashMismatches (expectedCausalHashMismatches, expect import Unison.Share.Sync.Types import Unison.Sqlite qualified as Sqlite import Unison.Sync.API qualified as Share (API) -import Unison.Sync.Common (causalHashToHash32, entityToTempEntity, expectEntity, hash32ToCausalHash) +import Unison.Sync.Common (entityToTempEntity, expectEntity, hash32ToCausalHash) import Unison.Sync.EntityValidation qualified as EV import Unison.Sync.Types qualified as Share import Unison.Util.Monoid (foldMapM) @@ -98,300 +88,6 @@ syncChunkSize = unsafePerformIO $ do Nothing -> 50 {-# NOINLINE syncChunkSize #-} ------------------------------------------------------------------------------------------------------------------------- --- Push - --- | Perform a check-and-set push (initially of just a causal hash, but ultimately all of its dependencies that the --- server is missing, too) to Unison Share. --- --- This flavor of push takes the expected state of the server, and the desired state we want to set; if our expectation --- is off, we won't proceed with the push. -checkAndSetPush :: - -- | The Unison Share URL. - BaseUrl -> - -- | The repo+path to push to. - Share.Path -> - -- | The hash that we expect this repo+path to be at on Unison Share. If not, we'll get back a hash mismatch error. - -- This prevents accidentally pushing over data that we didn't know was there. - Maybe Hash32 -> - -- | The hash of our local causal to push. - CausalHash -> - -- | Callback that's given a number of entities we just uploaded. - (Int -> IO ()) -> - Cli (Either (SyncError CheckAndSetPushError) ()) -checkAndSetPush unisonShareUrl path expectedHash causalHash uploadedCallback = do - Cli.Env {authHTTPClient} <- ask - - Cli.label \done -> do - let failed :: SyncError CheckAndSetPushError -> Cli void - failed = done . Left - - let updatePathError :: Share.UpdatePathError -> Cli void - updatePathError err = - failed (SyncError (CheckAndSetPushError'UpdatePath (Share.pathRepoInfo path) err)) - - let updatePath :: Cli Share.UpdatePathResponse - updatePath = do - liftIO request & onLeftM \err -> failed (TransportError err) - where - request :: IO (Either CodeserverTransportError Share.UpdatePathResponse) - request = - httpUpdatePath - authHTTPClient - unisonShareUrl - Share.UpdatePathRequest - { path, - expectedHash, - newHash = causalHashToHash32 causalHash - } - - -- Maybe the server already has this causal; try just setting its remote path. Commonly, it will respond that it - -- needs this causal (UpdatePathMissingDependencies). - dependencies <- - updatePath >>= \case - Share.UpdatePathSuccess -> done (Right ()) - Share.UpdatePathFailure err -> - case err of - Share.UpdatePathError'MissingDependencies (Share.NeedDependencies dependencies) -> pure dependencies - _ -> updatePathError err - - -- Upload the causal and all of its dependencies. - uploadEntities unisonShareUrl (Share.pathRepoInfo path) dependencies uploadedCallback & onLeftM \err -> - failed (CheckAndSetPushError'UploadEntities <$> err) - - -- After uploading the causal and all of its dependencies, try setting the remote path again. - updatePath >>= \case - Share.UpdatePathSuccess -> pure (Right ()) - Share.UpdatePathFailure err -> updatePathError err - --- | Perform a fast-forward push (initially of just a causal hash, but ultimately all of its dependencies that the --- server is missing, too) to Unison Share. --- --- This flavor of push provides the server with a chain of causal hashes leading from its current state to our desired --- state. -fastForwardPush :: - -- | The Unison Share URL. - BaseUrl -> - -- | The repo+path to push to. - Share.Path -> - -- | The hash of our local causal to push. - CausalHash -> - -- | Callback that's given a number of entities we just uploaded. - (Int -> IO ()) -> - Cli (Either (SyncError FastForwardPushError) ()) -fastForwardPush unisonShareUrl path localHeadHash uploadedCallback = do - Cli.label \done -> do - let succeeded :: Cli void - succeeded = - done (Right ()) - - let failed :: SyncError FastForwardPushError -> Cli void - failed = done . Left - - let fastForwardPathError :: Share.FastForwardPathError -> Cli void - fastForwardPathError err = - failed (SyncError (FastForwardPushError'FastForwardPath path err)) - - remoteHeadHash <- - getCausalHashByPath unisonShareUrl path >>= \case - Left err -> failed (FastForwardPushError'GetCausalHash <$> err) - Right Nothing -> fastForwardPathError Share.FastForwardPathError'NoHistory - Right (Just remoteHeadHash) -> pure (Share.hashJWTHash remoteHeadHash) - - let doLoadCausalSpineBetween = do - -- (Temporary?) optimization - perform the "is ancestor?" check within sqlite before reconstructing the - -- actual path. - let isBefore :: Sqlite.Transaction Bool - isBefore = do - maybeHashIds <- - runMaybeT $ - (,) - <$> MaybeT (Q.loadCausalHashIdByCausalHash (hash32ToCausalHash remoteHeadHash)) - <*> MaybeT (Q.loadCausalHashIdByCausalHash localHeadHash) - case maybeHashIds of - Nothing -> pure False - Just (remoteHeadHashId, localHeadHashId) -> Q.before remoteHeadHashId localHeadHashId - isBefore >>= \case - False -> pure Nothing - True -> loadCausalSpineBetween remoteHeadHash (causalHashToHash32 localHeadHash) - - let doUpload :: List.NonEmpty CausalHash -> Cli () - -- Maybe we could save round trips here by including the tail (or the head *and* the tail) as "extra hashes", - -- but we don't have that API yet. So, we only upload the head causal entity (which we don't even know for sure - -- the server doesn't have yet), and will (eventually) end up uploading the casuals in the tail that the server - -- needs. - doUpload (headHash :| _tailHashes) = - request & onLeftM \err -> failed (FastForwardPushError'UploadEntities <$> err) - where - request = - uploadEntities - unisonShareUrl - (Share.pathRepoInfo path) - (NESet.singleton (causalHashToHash32 headHash)) - uploadedCallback - - localInnerHashes <- - Cli.runTransaction doLoadCausalSpineBetween >>= \case - -- After getting the remote causal hash, we can tell from a local computation that this wouldn't be a - -- fast-forward push, so we don't bother trying - just report the error now. - Nothing -> failed (SyncError (FastForwardPushError'NotFastForward path)) - -- The path from remote-to-local, excluding local, was empty. So, remote == local; there's nothing to push. - Just [] -> succeeded - -- drop remote hash - Just (_ : localInnerHashes) -> pure (map hash32ToCausalHash localInnerHashes) - - doUpload (localHeadHash :| localInnerHashes) - - let doFastForwardPath :: Cli Share.FastForwardPathResponse - doFastForwardPath = do - Cli.Env {authHTTPClient} <- ask - let request = - httpFastForwardPath - authHTTPClient - unisonShareUrl - Share.FastForwardPathRequest - { expectedHash = remoteHeadHash, - hashes = - causalHashToHash32 <$> List.NonEmpty.fromList (localInnerHashes ++ [localHeadHash]), - path - } - liftIO request & onLeftM \err -> failed (TransportError err) - - doFastForwardPath >>= \case - Share.FastForwardPathSuccess -> succeeded - Share.FastForwardPathFailure err -> fastForwardPathError err - --- Return a list (in oldest-to-newest order) of hashes along the causal spine that connects the given arguments, --- excluding the newest hash (second argument). -loadCausalSpineBetween :: Hash32 -> Hash32 -> Sqlite.Transaction (Maybe [Hash32]) -loadCausalSpineBetween earlierHash laterHash = - dagbfs (== earlierHash) Q.loadCausalParentsByHash laterHash - -data Step a - = DeadEnd - | KeepSearching (List.NonEmpty a) - | FoundGoal a - --- | @dagbfs goal children root@ searches breadth-first through the monadic tree formed by applying @chilred@ to each --- node (initially @root@), until it finds a goal node (i.e. when @goal@ returns True). --- --- Returns the nodes along a path from root to goal in bottom-up or goal-to-root order, excluding the root node (because --- it was provided as an input ;)) --- --- For example, when searching a tree that looks like --- --- 1 --- / \ --- 2 3 --- / \ \ --- 4 [5] 6 --- --- (where the goal is marked [5]), we'd return --- --- Just [5,2] --- --- And (as another example), if the root node is the goal, --- --- [1] --- / \ --- 2 3 --- / \ \ --- 4 5 6 --- --- we'd return --- --- Just [] -dagbfs :: forall a m. (Monad m) => (a -> Bool) -> (a -> m [a]) -> a -> m (Maybe [a]) -dagbfs goal children = - let -- The loop state: all distinct paths from the root to the frontier (not including the root, because it's implied, - -- as an input to this function), in reverse order, with the invariant that we haven't found a goal state yet. - -- (Otherwise, we wouldn't still be in this loop, we'd return!). - -- - -- For example, say we are exploring the tree - -- - -- 1 - -- / \ - -- 2 3 - -- / \ \ - -- 4 5 6 - -- - -- Graphically, the frontier here is the nodes 4, 5, and 6; we know that, because we haven't drawn any nodes below - -- them. (This is a BFS algorithm that discovers children on-the-fly, so maybe node 5 (for example) has children, - -- and maybe it doesn't). - -- - -- The loop state, in this case, would be these three paths: - -- - -- [ 4, 2 ] - -- [ 5, 2 ] - -- [ 6, 3 ] - -- - -- (Note, again, that we do not include the root). - go :: NESeq (List.NonEmpty a) -> m (Maybe (List.NonEmpty a)) - go (path :<|| paths) = - -- Step forward from the first path in our loop state (in the example above, [4, 2]). - step (List.NonEmpty.head path) >>= \case - -- If node 4 had no more children, we can toss that whole path: it didn't end in a goal. Now we either keep - -- searching (as we would in the example, since we have two more paths to continue from), or we don't, because - -- this was the only remaining path. - DeadEnd -> - case NESeq.nonEmptySeq paths of - Nothing -> pure Nothing - Just paths' -> go paths' - -- If node 4 did have children, then maybe the search tree now looks like this. - -- - -- 1 - -- / \ - -- 2 3 - -- / \ \ - -- 4 5 6 - -- / \ - -- 7 8 - -- - -- There are two cases to handle: - -- - -- 1. One of the children we just discovered (say 7) is a goal node. So we're done, and we'd return the path - -- - -- [ 7, 4, 2 ] - -- - -- 2. No child we just discovered (7 nor 8) were a goal node. So we loop, putting our new path(s) at the end - -- of the list (so we search paths fairly). In this case, we'd re-enter the loop with the following four - -- paths: - -- - -- [ 5, 2 ] \ these two are are variable 'paths', the tail of the loop state. - -- [ 6, 3 ] / - -- [ 7, 4, 2 ] \ these two are new, just constructed by prepending each of [ 4, 2, 1 ]'s children - -- [ 8, 4, 2 ] / to itself, making two new paths to search - KeepSearching ys -> go (append paths ((\y -> List.NonEmpty.cons y path) <$> NESeq.fromList ys)) - FoundGoal y -> pure (Just (List.NonEmpty.cons y path)) - - -- Step forward from a single node. There are 3 possible outcomes: - -- - -- 1. We discover it has no children. (return DeadEnd) - -- 2. We discover is has children, none of which are a goal. (return KeepSearching) - -- 3. We discover it has children, (at least) one of which is a goal. (return FoundGoal) - step :: a -> m (Step a) - step x = do - ys0 <- children x - pure case List.NonEmpty.nonEmpty ys0 of - Nothing -> DeadEnd - Just ys -> - case Foldable.find goal ys of - Nothing -> KeepSearching ys - Just y -> FoundGoal y - in \root -> - if goal root - then pure (Just []) - else - step root >>= \case - DeadEnd -> pure Nothing - -- lts-18.28 doesn't have List.NonEmpty.singleton - KeepSearching xs -> fmap List.NonEmpty.toList <$> go (NESeq.fromList ((:| []) <$> xs)) - FoundGoal x -> pure (Just [x]) - where - -- Concatenate a seq and a non-empty seq. - append :: Seq x -> NESeq x -> NESeq x - append = (NESeq.><|) - ------------------------------------------------------------------------------------------------------------------------ -- Pull @@ -977,16 +673,6 @@ httpGetCausalHashByPath :: BaseUrl -> Share.GetCausalHashByPathRequest -> IO (Either CodeserverTransportError Share.GetCausalHashByPathResponse) -httpFastForwardPath :: - Auth.AuthenticatedHttpClient -> - BaseUrl -> - Share.FastForwardPathRequest -> - IO (Either CodeserverTransportError Share.FastForwardPathResponse) -httpUpdatePath :: - Auth.AuthenticatedHttpClient -> - BaseUrl -> - Share.UpdatePathRequest -> - IO (Either CodeserverTransportError Share.UpdatePathResponse) httpDownloadEntities :: Auth.AuthenticatedHttpClient -> BaseUrl -> @@ -998,14 +684,10 @@ httpUploadEntities :: Share.UploadEntitiesRequest -> IO (Either CodeserverTransportError Share.UploadEntitiesResponse) ( httpGetCausalHashByPath, - httpFastForwardPath, - httpUpdatePath, httpDownloadEntities, httpUploadEntities ) = let ( httpGetCausalHashByPath - Servant.:<|> httpFastForwardPath - Servant.:<|> httpUpdatePath Servant.:<|> httpDownloadEntities Servant.:<|> httpUploadEntities ) = @@ -1013,8 +695,6 @@ httpUploadEntities :: pp = Proxy in Servant.hoistClient pp hoist (Servant.client pp) in ( go httpGetCausalHashByPath, - go httpFastForwardPath, - go httpUpdatePath, go httpDownloadEntities, go httpUploadEntities ) diff --git a/unison-cli/src/Unison/Share/Sync/Types.hs b/unison-cli/src/Unison/Share/Sync/Types.hs index 1d14c32207..a53d14acbb 100644 --- a/unison-cli/src/Unison/Share/Sync/Types.hs +++ b/unison-cli/src/Unison/Share/Sync/Types.hs @@ -1,8 +1,6 @@ -- | Types used by the UCM client during sync. module Unison.Share.Sync.Types - ( CheckAndSetPushError (..), - CodeserverTransportError (..), - FastForwardPushError (..), + ( CodeserverTransportError (..), GetCausalHashByPathError (..), PullError (..), SyncError (..), @@ -13,29 +11,6 @@ import Servant.Client qualified as Servant import Unison.Prelude import Unison.Sync.Types qualified as Share --- | Error used by the client when pushing code to Unison Share. -data CheckAndSetPushError - = CheckAndSetPushError'UpdatePath - -- The repo we are pushing to. This is only necessary because an UpdatePathError does not have enough context to - -- print the entire error message we want to print, but it really should, at which point maybe this can go away. - Share.RepoInfo - Share.UpdatePathError - | CheckAndSetPushError'UploadEntities Share.UploadEntitiesError - deriving stock (Show) - --- | An error occurred while fast-forward pushing code to Unison Share. -data FastForwardPushError - = FastForwardPushError'FastForwardPath - -- The path we are fast forwarding. This is only necessary because a FastForwardPathError does not have enough - -- context to print the entire error message we want to print, but it really should, at which point maybe this can - -- go away. - Share.Path - Share.FastForwardPathError - | FastForwardPushError'GetCausalHash GetCausalHashByPathError - | FastForwardPushError'NotFastForward Share.Path - | FastForwardPushError'UploadEntities Share.UploadEntitiesError - deriving stock (Show) - -- | An error occurred while pulling code from Unison Share. data PullError = PullError'DownloadEntities Share.DownloadEntitiesError diff --git a/unison-share-api/src/Unison/Sync/API.hs b/unison-share-api/src/Unison/Sync/API.hs index 754931f8b1..5cafebdfc3 100644 --- a/unison-share-api/src/Unison/Sync/API.hs +++ b/unison-share-api/src/Unison/Sync/API.hs @@ -11,8 +11,6 @@ api = Proxy type API = "path" :> "get" :> GetCausalHashByPathEndpoint - :<|> "path" :> "fast-forward" :> FastForwardPathEndpoint - :<|> "path" :> "update" :> UpdatePathEndpoint :<|> "entities" :> "download" :> DownloadEntitiesEndpoint :<|> "entities" :> "upload" :> UploadEntitiesEndpoint @@ -20,14 +18,6 @@ type GetCausalHashByPathEndpoint = ReqBody '[JSON] GetCausalHashByPathRequest :> Post '[JSON] GetCausalHashByPathResponse -type FastForwardPathEndpoint = - ReqBody '[JSON] FastForwardPathRequest - :> Post '[JSON] FastForwardPathResponse - -type UpdatePathEndpoint = - ReqBody '[JSON] UpdatePathRequest - :> Post '[JSON] UpdatePathResponse - type DownloadEntitiesEndpoint = ReqBody '[JSON] DownloadEntitiesRequest :> Post '[JSON] DownloadEntitiesResponse diff --git a/unison-share-api/src/Unison/Sync/Types.hs b/unison-share-api/src/Unison/Sync/Types.hs index ccd680135f..4b37cfaf21 100644 --- a/unison-share-api/src/Unison/Sync/Types.hs +++ b/unison-share-api/src/Unison/Sync/Types.hs @@ -48,11 +48,6 @@ module Unison.Sync.Types UploadEntitiesResponse (..), UploadEntitiesError (..), - -- ** Fast-forward path - FastForwardPathRequest (..), - FastForwardPathResponse (..), - FastForwardPathError (..), - -- ** Update path UpdatePathRequest (..), UpdatePathResponse (..), @@ -747,115 +742,13 @@ instance FromJSON HashMismatchForEntity where Aeson.withObject "HashMismatchForEntity" \obj -> HashMismatchForEntity <$> obj - .: "supplied" + .: "supplied" <*> obj - .: "computed" - ------------------------------------------------------------------------------------------------------------------------- --- Fast-forward path - --- | A non-empty list of causal hashes, latest first, that show the lineage from wherever the client wants to --- fast-forward to back to wherever the (client believes the) server is (including the server head, in a separate --- field). --- --- For example, if the client wants to update --- --- @ --- A -> B -> C --- @ --- --- to --- --- @ --- A -> B -> C -> D -> E -> F --- @ --- --- then it would send hashes --- --- @ --- expectedHash = C --- hashes = [D, E, F] --- @ --- --- Note that if the client wants to begin a history at a new path on the server, it would use the "update path" endpoint --- instead. -data FastForwardPathRequest = FastForwardPathRequest - { -- | The causal that the client believes exists at `path` - expectedHash :: Hash32, - -- | The sequence of causals to fast-forward with, starting from the oldest new causal to the newest new causal - hashes :: NonEmpty Hash32, - -- | The path to fast-forward - path :: Path - } - deriving stock (Show) - -instance ToJSON FastForwardPathRequest where - toJSON FastForwardPathRequest {expectedHash, hashes, path} = - object - [ "expected_hash" .= expectedHash, - "hashes" .= hashes, - "path" .= path - ] - -instance FromJSON FastForwardPathRequest where - parseJSON = - Aeson.withObject "FastForwardPathRequest" \o -> do - expectedHash <- o .: "expected_hash" - hashes <- o .: "hashes" - path <- o .: "path" - pure FastForwardPathRequest {expectedHash, hashes, path} - -data FastForwardPathResponse - = FastForwardPathSuccess - | FastForwardPathFailure FastForwardPathError - deriving stock (Show) - -data FastForwardPathError - = FastForwardPathError'MissingDependencies (NeedDependencies Hash32) - | FastForwardPathError'NoWritePermission Path - | -- | This wasn't a fast-forward. Here's a JWT to download the causal head, if you want it. - FastForwardPathError'NotFastForward HashJWT - | -- | There was no history at this path; the client should use the "update path" endpoint instead. - FastForwardPathError'NoHistory - | -- | This wasn't a fast-forward. You said the first hash was a parent of the second hash, but I disagree. - FastForwardPathError'InvalidParentage InvalidParentage - | FastForwardPathError'InvalidRepoInfo Text RepoInfo - | FastForwardPathError'UserNotFound - deriving stock (Show) + .: "computed" data InvalidParentage = InvalidParentage {parent :: Hash32, child :: Hash32} deriving stock (Show) -instance ToJSON FastForwardPathResponse where - toJSON = \case - FastForwardPathSuccess -> jsonUnion "success" (Object mempty) - (FastForwardPathFailure (FastForwardPathError'MissingDependencies deps)) -> jsonUnion "missing_dependencies" deps - (FastForwardPathFailure (FastForwardPathError'NoWritePermission path)) -> jsonUnion "no_write_permission" path - (FastForwardPathFailure (FastForwardPathError'NotFastForward hashJwt)) -> jsonUnion "not_fast_forward" hashJwt - (FastForwardPathFailure FastForwardPathError'NoHistory) -> jsonUnion "no_history" (Object mempty) - (FastForwardPathFailure (FastForwardPathError'InvalidParentage invalidParentage)) -> - jsonUnion "invalid_parentage" invalidParentage - (FastForwardPathFailure (FastForwardPathError'InvalidRepoInfo msg repoInfo)) -> - jsonUnion "invalid_repo_info" (msg, repoInfo) - (FastForwardPathFailure FastForwardPathError'UserNotFound) -> - jsonUnion "user_not_found" (Object mempty) - -instance FromJSON FastForwardPathResponse where - parseJSON = - Aeson.withObject "FastForwardPathResponse" \o -> - o .: "type" >>= Aeson.withText "type" \case - "success" -> pure FastForwardPathSuccess - "missing_dependencies" -> FastForwardPathFailure . FastForwardPathError'MissingDependencies <$> o .: "payload" - "no_write_permission" -> FastForwardPathFailure . FastForwardPathError'NoWritePermission <$> o .: "payload" - "not_fast_forward" -> FastForwardPathFailure . FastForwardPathError'NotFastForward <$> o .: "payload" - "no_history" -> pure (FastForwardPathFailure FastForwardPathError'NoHistory) - "invalid_parentage" -> FastForwardPathFailure . FastForwardPathError'InvalidParentage <$> o .: "payload" - "invalid_repo_info" -> do - (msg, repoInfo) <- o .: "payload" - pure (FastForwardPathFailure (FastForwardPathError'InvalidRepoInfo msg repoInfo)) - "user_not_found" -> pure (FastForwardPathFailure FastForwardPathError'UserNotFound) - t -> failText $ "Unexpected FastForwardPathResponse type: " <> t - instance ToJSON InvalidParentage where toJSON (InvalidParentage parent child) = object ["parent" .= parent, "child" .= child] From 5b0045dc66d48fa53f81f3898486d01631d5b209 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 14:50:44 -0700 Subject: [PATCH 120/631] Fix ReleaseDraft --- .../Codebase/Editor/HandleInput/ReleaseDraft.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs index 13caf9b1ac..e6cdbffc7e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs @@ -6,8 +6,8 @@ where import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli -import Unison.Cli.ProjectUtils qualified as ProjectUtils -import Unison.Codebase.Editor.HandleInput.Branch (CreateFrom (..), doCreateBranch) +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Codebase.Editor.HandleInput.Branch (CreateFrom (..), createBranch) import Unison.Codebase.Editor.Output qualified as Output import Unison.Prelude import Unison.Project (Semver) @@ -16,15 +16,15 @@ import Witch (unsafeFrom) -- | Handle a @release.draft@ command. handleReleaseDraft :: Semver -> Cli () handleReleaseDraft ver = do - currentProjectAndBranch <- fst <$> ProjectUtils.expectCurrentProjectBranch + currentProjectAndBranch <- Cli.getCurrentProjectAndBranch let branchName = unsafeFrom @Text ("releases/drafts/" <> into @Text ver) _ <- - doCreateBranch - (CreateFrom'Branch currentProjectAndBranch) - (currentProjectAndBranch ^. #project) - branchName + createBranch ("release.draft " <> into @Text ver) + (CreateFrom'ParentBranch (currentProjectAndBranch ^. #branch)) + (currentProjectAndBranch ^. #project) + (pure branchName) Cli.respond (Output.DraftingRelease branchName ver) From 9936a02f556716b3b61756b2f77ebf6b15bd75e2 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 14:53:20 -0700 Subject: [PATCH 121/631] Fix Upgrade --- .../Codebase/Editor/HandleInput/Branch.hs | 8 ++++---- .../Codebase/Editor/HandleInput/Upgrade.hs | 20 +++++++++---------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index d320fe04b3..ab26f12f34 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -99,7 +99,7 @@ createBranch :: CreateFrom -> Sqlite.Project -> Sqlite.Transaction ProjectBranchName -> - Cli ProjectBranchId + Cli (ProjectBranchName, ProjectBranchId) createBranch description createFrom project getNewBranchName = do let projectId = project ^. #projectId Cli.Env {codebase} <- ask @@ -121,7 +121,7 @@ createBranch description createFrom project getNewBranchName = do Cli.runTransaction $ do newBranchCausalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash branch) pure (Nothing, newBranchCausalHashId) - newBranchId <- + (newBranchName, newBranchId) <- Cli.runTransactionWithRollback \rollback -> do newBranchName <- getNewBranchName Queries.projectBranchExistsByName projectId newBranchName >>= \case @@ -139,7 +139,7 @@ createBranch description createFrom project getNewBranchName = do name = newBranchName, parentBranchId = mayParentBranchId } - pure newBranchId + pure (newBranchName, newBranchId) Cli.switchProject (ProjectAndBranch projectId newBranchId) - pure newBranchId + pure (newBranchName, newBranchId) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index 5b816c87b7..59237c56bd 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -18,6 +18,7 @@ import Unison.Cli.ProjectUtils qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Editor.HandleInput.Branch (CreateFrom (CreateFrom'ParentBranch)) import Unison.Codebase.Editor.HandleInput.Branch qualified as HandleInput.Branch import Unison.Codebase.Editor.HandleInput.Update2 ( addDefinitionsToUnisonFile, @@ -148,26 +149,24 @@ handleUpgrade oldName newName = do `PPED.addFallback` makeComplicatedPPE hashLength currentDeepNamesSansOld mempty dependents ) - pp@(PP.ProjectPath project branch pathInProject) <- Cli.getCurrentProjectPath + (PP.ProjectPath project projectBranch pathInProject) <- Cli.getCurrentProjectPath parsingEnv <- makeParsingEnv pathInProject currentDeepNamesSansOld typecheckedUnisonFile <- prettyParseTypecheck unisonFile printPPE parsingEnv & onLeftM \prettyUnisonFile -> do - -- Small race condition: since picking a branch name and creating the branch happen in different - -- transactions, creating could fail. - temporaryBranchName <- Cli.runTransaction (findTemporaryBranchName (project ^. #projectId) oldName newName) - temporaryBranchId <- - HandleInput.Branch.createBranchFromParent + let getTemporaryBranchName = findTemporaryBranchName (project ^. #projectId) oldName newName + (temporaryBranchName, _temporaryBranchId) <- + HandleInput.Branch.createBranch textualDescriptionOfUpgrade - (Just branch) + (CreateFrom'ParentBranch projectBranch) project - temporaryBranchName + getTemporaryBranchName scratchFilePath <- Cli.getLatestFile <&> \case Nothing -> "scratch.u" Just (file, _) -> file liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) Cli.returnEarly $ - Output.UpgradeFailure branch.name temporaryBranchName scratchFilePath oldName newName + Output.UpgradeFailure (projectBranch ^. #name) temporaryBranchName scratchFilePath oldName newName branchUpdates <- Cli.runTransactionWithRollback \abort -> do @@ -177,8 +176,9 @@ handleUpgrade oldName newName = do (findCtorNamesMaybe Output.UOUUpgrade currentLocalNames currentLocalConstructorNames Nothing) typecheckedUnisonFile Cli.stepAt + projectBranch textualDescriptionOfUpgrade - ( Path.unabsolute projectPath, + ( Path.absoluteEmpty, Branch.deleteLibdep oldName . Branch.batchUpdates branchUpdates ) Cli.respond (Output.UpgradeSuccess oldName newName) From 1e4627b393cb1def47d0594b70d9fb5b5ed139ad Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 14:58:28 -0700 Subject: [PATCH 122/631] Fix update.old --- unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs index 1f2538891a..39cc4acc23 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs @@ -74,6 +74,7 @@ import Unison.WatchKind (WatchKind) handleUpdate :: Input -> OptionalPatch -> Set Name -> Cli () handleUpdate input optionalPatch requestedNames = do Cli.Env {codebase} <- ask + pp <- Cli.getCurrentProjectPath currentPath' <- Cli.getCurrentPath let patchPath = case optionalPatch of @@ -211,7 +212,7 @@ handleUpdate input optionalPatch requestedNames = do & Path.unsplit' & Path.resolve @_ @_ @Path.Absolute currentPath' & tShow - Cli.updateRoot branchWithPropagatedPatch description + void $ Cli.updateAt description pp (const branchWithPropagatedPatch) getSlurpResultForUpdate :: Set Name -> Names -> Cli SlurpResult getSlurpResultForUpdate requestedNames slurpCheckNames = do From 7b5845ff2e2cd7043970aefbfefbef8de05240eb Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 15:01:53 -0700 Subject: [PATCH 123/631] Fix AddRun --- unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs index 7d24986d27..8ef0550a30 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs @@ -19,7 +19,7 @@ import Unison.Codebase.Editor.Input (Input) import Unison.Codebase.Editor.Output (Output (NoLastRunResult, SaveTermNameConflict, SlurpOutput)) import Unison.Codebase.Editor.Slurp qualified as Slurp import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult -import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.InputPattern qualified as InputPattern import Unison.CommandLine.InputPatterns qualified as InputPatterns import Unison.Name (Name) @@ -37,13 +37,13 @@ handleAddRun input resultName = do let resultVar = Name.toVar resultName uf <- addSavedTermToUnisonFile resultName Cli.Env {codebase} <- ask - currentPath <- Cli.getCurrentPath currentNames <- Cli.currentNames let sr = Slurp.slurpFile uf (Set.singleton resultVar) Slurp.AddOp currentNames let adds = SlurpResult.adds sr Cli.runTransaction . Codebase.addDefsToCodebase codebase . SlurpResult.filterUnisonFile sr $ uf let description = (Text.pack (InputPattern.patternName InputPatterns.saveExecuteResult) <> " " <> Name.toText resultName) - Cli.stepAt description (Path.unabsolute currentPath, doSlurpAdds adds uf) + PP.ProjectPath _proj pb currentPath <- Cli.getCurrentProjectPath + Cli.stepAt pb description (currentPath, doSlurpAdds adds uf) let namesWithDefinitionsFromFile = UF.addNamesFromTypeCheckedUnisonFile uf currentNames pped <- Cli.prettyPrintEnvDeclFromNames namesWithDefinitionsFromFile let suffixifiedPPE = PPE.suffixifiedPPE pped From b1ad1599ed6289cdfab0058c7bb92d5717d4507a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 15:04:19 -0700 Subject: [PATCH 124/631] Fix up Pull --- .../Codebase/Editor/HandleInput/Pull.hs | 20 +++++++++---------- .../src/Unison/Codebase/Editor/Output.hs | 2 +- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index fec305abd3..886f7d2a46 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -21,23 +21,21 @@ import Unison.Cli.MergeTypes (MergeSource (..)) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.NamesUtils 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 (Branch (..)) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Merge qualified as Branch -import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.HandleInput.Merge2 (AliceMergeInfo (..), BobMergeInfo (..), LcaMergeInfo (..), MergeInfo (..), doMerge) import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper) import Unison.Codebase.Editor.Input import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Editor.Output.PushPull qualified as PushPull import Unison.Codebase.Editor.Propagate qualified as Propagate import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace (..), printReadRemoteNamespace) -import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path @@ -260,7 +258,7 @@ mergeBranchAndPropagateDefaultPatch mode inputDescription unchangedMessage srcb mergeBranch = Cli.time "mergeBranch" do Cli.Env {codebase} <- ask - destb <- Cli.getBranchAt dest + destb <- Cli.getBranchFromProjectPath dest merged <- liftIO (Branch.merge'' (Codebase.lca codebase) mode srcb destb) b <- Cli.updateAtM inputDescription dest (const $ pure merged) for_ maybeDest0 \dest0 -> do @@ -271,18 +269,18 @@ mergeBranchAndPropagateDefaultPatch mode inputDescription unchangedMessage srcb loadPropagateDiffDefaultPatch :: Text -> Maybe (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) -> - Path.Absolute -> + PP.ProjectPath -> Cli () loadPropagateDiffDefaultPatch inputDescription maybeDest0 dest = do Cli.respond Output.AboutToPropagatePatch Cli.time "loadPropagateDiffDefaultPatch" do - original <- Cli.getBranch0At dest + original <- Cli.getBranch0FromProjectPath dest patch <- liftIO $ Branch.getPatch NameSegment.defaultPatchSegment original patchDidChange <- propagatePatch inputDescription patch dest when patchDidChange do whenJust maybeDest0 \dest0 -> do Cli.respond Output.CalculatingDiff - patched <- Cli.getBranchAt dest + patched <- Cli.getBranchFromProjectPath dest let patchPath = Path.Path' (Right (Path.Relative (Path.fromList [NameSegment.defaultPatchSegment]))) (ppe, diff) <- diffHelper original (Branch.head patched) Cli.respondNumbered (ShowDiffAfterMergePropagate dest0 dest patchPath ppe diff) @@ -291,11 +289,13 @@ loadPropagateDiffDefaultPatch inputDescription maybeDest0 dest = do propagatePatch :: Text -> Patch -> - Path.Absolute -> + PP.ProjectPath -> Cli Bool propagatePatch inputDescription patch scopePath = do + let pb = scopePath ^. #branch Cli.time "propagatePatch" do - rootNames <- Branch.toNames <$> Cli.getRootBranch0 + rootNames <- Cli.projectBranchNames pb Cli.stepAt' + pb (inputDescription <> " (applying patch)") - (Path.unabsolute scopePath, Propagate.propagateAndApply rootNames patch) + (scopePath ^. PP.absPath_, Propagate.propagateAndApply rootNames patch) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index b137b5d32f..f15608cbbc 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -105,7 +105,7 @@ data NumberedOutput (BranchDiffOutput Symbol Ann) | ShowDiffAfterMergePropagate (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) - Path.Absolute + ProjectPath Path.Path' PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) From 0b16a7c9de7dbefc8f52cd1f52a25551d194fbd0 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 7 Jun 2024 15:10:10 -0700 Subject: [PATCH 125/631] Fixup BranchId --- .../src/Unison/Codebase/ProjectPath.hs | 4 + unison-cli/src/Unison/Cli/MonadUtils.hs | 12 +-- unison-cli/src/Unison/Cli/Pretty.hs | 5 +- .../src/Unison/Codebase/Editor/Input.hs | 24 +++--- .../src/Unison/Codebase/Editor/Output.hs | 2 +- .../src/Unison/CommandLine/InputPatterns.hs | 79 +++++++++++-------- 6 files changed, 75 insertions(+), 51 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index 5c249cea40..2694d26b51 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -43,6 +43,10 @@ type ProjectPathIds = ProjectPathG ProjectId ProjectBranchId type ProjectPathNames = ProjectPathG ProjectName ProjectBranchName +instance From ProjectPathNames Text where + from (ProjectPath proj branch path) = + into @Text (ProjectAndBranch proj branch) <> ":" <> Path.absToText path + type ProjectPath = ProjectPathG Project ProjectBranch projectBranchRoot :: ProjectAndBranch Project ProjectBranch -> ProjectPath diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index f80a916a0a..5587f88694 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -201,10 +201,11 @@ resolveSplit' = -- branches by path are OK - the empty branch will be returned). resolveAbsBranchId :: Input.AbsBranchId -> Cli (Branch IO) resolveAbsBranchId = \case - Left hash -> resolveShortCausalHash hash - Right absPath -> do + Input.BranchAtSCH hash -> resolveShortCausalHash hash + Input.BranchAtPath absPath -> do pp <- resolvePath' (Path' (Left absPath)) getBranchFromProjectPath pp + Input.BranchAtProjectPath pp -> getBranchFromProjectPath pp -- | V2 version of 'resolveAbsBranchId2'. resolveAbsBranchIdV2 :: @@ -213,13 +214,14 @@ resolveAbsBranchIdV2 :: Input.AbsBranchId -> Sqlite.Transaction (V2.Branch Sqlite.Transaction) resolveAbsBranchIdV2 rollback (ProjectAndBranch proj branch) = \case - Left shortHash -> do + Input.BranchAtSCH shortHash -> do hash <- resolveShortCausalHashToCausalHash rollback shortHash causal <- (Codebase.expectCausalBranchByCausalHash hash) V2Causal.value causal - Right absPath -> do + Input.BranchAtPath absPath -> do let pp = PP.ProjectPath proj branch absPath Codebase.getShallowBranchAtProjectPath pp + Input.BranchAtProjectPath pp -> Codebase.getShallowBranchAtProjectPath pp -- | Resolve a @BranchId@ to the corresponding @Branch IO@, or fail if no such branch hash is found. (Non-existent -- branches by path are OK - the empty branch will be returned). @@ -231,7 +233,7 @@ resolveBranchId branchId = do -- | Resolve a @BranchId@ to an @AbsBranchId@. resolveBranchIdToAbsBranchId :: Input.BranchId -> Cli Input.AbsBranchId resolveBranchIdToAbsBranchId = - traverseOf _Right (fmap (view PP.absPath_) . resolvePath') + traverse (fmap (view PP.absPath_) . resolvePath') -- | Resolve a @ShortCausalHash@ to the corresponding @Branch IO@, or fail if no such branch hash is found. resolveShortCausalHash :: ShortCausalHash -> Cli (Branch IO) diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index 0f18f47b09..0c51349383 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -187,8 +187,9 @@ prettyNamespaceKey = \case prettyBranchId :: Input.AbsBranchId -> Pretty prettyBranchId = \case - Left sch -> prettySCH sch - Right absPath -> prettyAbsolute $ absPath + Input.BranchAtSCH sch -> prettySCH sch + Input.BranchAtPath absPath -> prettyAbsolute $ absPath + Input.BranchAtProjectPath pp -> prettyProjectPath pp prettyRelative :: Path.Relative -> Pretty prettyRelative = P.blue . P.shown diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 46cab3a744..84af51ddd1 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -9,6 +9,7 @@ module Unison.Codebase.Editor.Input Event (..), OutputLocation (..), PatchPath, + BranchIdG (..), BranchId, AbsBranchId, UnresolvedProjectBranch, @@ -35,6 +36,7 @@ import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace) import Unison.Codebase.Path (Path, Path') import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.PushBehavior (PushBehavior) import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH @@ -60,15 +62,19 @@ type PatchPath = Path.Split' data OptionalPatch = NoPatch | DefaultPatch | UsePatch PatchPath deriving (Eq, Ord, Show) -type BranchId = Either ShortCausalHash Path' +data BranchIdG p + = BranchAtSCH ShortCausalHash + | BranchAtPath p + | BranchAtProjectPath ProjectPath + deriving stock (Eq, Show, Functor, Foldable, Traversable) + +type BranchId = BranchIdG Path' + +type AbsBranchId = BranchIdG Path.Absolute -- | An unambiguous project branch name, use the current project name if not provided. type UnresolvedProjectBranch = ProjectAndBranch (Maybe ProjectName) ProjectBranchName --- | TODO: You should probably use a `ProjectPath` instead of a `Path.Absolute` in most --- cases. -type AbsBranchId = Either ShortCausalHash Path.Absolute - type HashOrHQSplit' = Either ShortHash Path.HQSplit' -- | Should we force the operation or not? @@ -78,8 +84,8 @@ data Insistence = Force | Try parseBranchId :: String -> Either Text BranchId parseBranchId ('#' : s) = case SCH.fromText (Text.pack s) of Nothing -> Left "Invalid hash, expected a base32hex string." - Just h -> pure $ Left h -parseBranchId s = Right <$> Path.parsePath' s + Just h -> pure $ BranchAtSCH h +parseBranchId s = BranchAtPath <$> Path.parsePath' s parseBranchId2 :: String -> Either (P.Pretty P.ColorText) (Either ShortCausalHash BranchRelativePath) parseBranchId2 ('#' : s) = case SCH.fromText (Text.pack s) of @@ -110,10 +116,10 @@ data Input | DiffNamespaceI BranchId BranchId -- old new | PullI !PullSourceTarget !PullMode | PushRemoteBranchI PushRemoteBranchInput - | ResetRootI (Either ShortCausalHash Path') + | ResetRootI BranchId | ResetI ( These - (Either ShortCausalHash Path') + BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) ) (Maybe UnresolvedProjectBranch) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index f15608cbbc..6880948800 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -111,7 +111,7 @@ data NumberedOutput (BranchDiffOutput Symbol Ann) | ShowDiffAfterMergePreview (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) - Path.Absolute + ProjectPath PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterPull Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 5195866641..47f8207caf 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -168,7 +168,7 @@ import Unison.Cli.Pretty import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch.Merge qualified as Branch -import Unison.Codebase.Editor.Input (DeleteOutput (..), DeleteTarget (..), Input) +import Unison.Codebase.Editor.Input (BranchIdG (..), DeleteOutput (..), DeleteTarget (..), Input) import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output.PushPull (PushPull (Pull, Push)) import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace) @@ -246,8 +246,13 @@ formatStructuredArgument schLength = \case -- prefixBranchId ".base" "List.map" -> ".base.List.map" prefixBranchId :: Input.AbsBranchId -> Name -> Text prefixBranchId branchId name = case branchId of - Left sch -> "#" <> SCH.toText sch <> ":" <> Name.toText (Name.makeAbsolute name) - Right pathPrefix -> Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name) + BranchAtSCH sch -> "#" <> SCH.toText sch <> ":" <> Name.toText (Name.makeAbsolute name) + BranchAtPath pathPrefix -> Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name) + BranchAtProjectPath pp -> + pp + & PP.absPath_ %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) + & PP.toNames + & into @Text entryToHQText :: Path' -> ShallowListEntry v Ann -> Text entryToHQText pathArg = @@ -428,8 +433,8 @@ handleSplitArg = (first P.text . Path.parseSplit) \case SA.Name name | Name.isRelative name -> pure $ Path.splitFromName name - SA.NameWithBranchPrefix (Left _) name | Name.isRelative name -> pure $ Path.splitFromName name - SA.NameWithBranchPrefix (Right prefix) name + SA.NameWithBranchPrefix (BranchAtSCH _) name | Name.isRelative name -> pure $ Path.splitFromName name + SA.NameWithBranchPrefix (BranchAtPath prefix) name | Name.isRelative name -> pure . Path.splitFromName . Name.makeAbsolute $ Path.prefixName prefix name otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg @@ -439,8 +444,8 @@ handleSplit'Arg = (first P.text . Path.parseSplit') \case SA.Name name -> pure $ Path.splitFromName' name - SA.NameWithBranchPrefix (Left _) name -> pure $ Path.splitFromName' name - SA.NameWithBranchPrefix (Right prefix) name -> + SA.NameWithBranchPrefix (BranchAtSCH _) name -> pure $ Path.splitFromName' name + SA.NameWithBranchPrefix (BranchAtPath prefix) name -> pure . Path.splitFromName' . Name.makeAbsolute $ Path.prefixName prefix name otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg @@ -457,11 +462,17 @@ handleBranchIdArg = either (first P.text . Input.parseBranchId) \case - SA.AbsolutePath path -> pure . pure $ Path.absoluteToPath' path - SA.Name name -> pure . pure $ Path.fromName' name + SA.AbsolutePath path -> pure . BranchAtPath $ Path.absoluteToPath' path + SA.Name name -> pure . BranchAtPath $ Path.fromName' name SA.NameWithBranchPrefix mprefix name -> - pure . pure . Path.fromName' $ either (const name) (Name.makeAbsolute . flip Path.prefixName name) mprefix - SA.Namespace hash -> pure . Left $ SCH.fromFullHash hash + pure $ case mprefix of + BranchAtSCH _sch -> BranchAtPath . Path.fromName' $ name + BranchAtPath prefix -> BranchAtPath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + BranchAtProjectPath pp -> + pp + & PP.absPath_ %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) + & BranchAtProjectPath + SA.Namespace hash -> pure . BranchAtSCH $ SCH.fromFullHash hash otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg handleBranchIdOrProjectArg :: @@ -471,13 +482,13 @@ handleBranchIdOrProjectArg = either (maybe (Left $ P.text "Expected a branch or project, but it’s not") pure . branchIdOrProject) \case - SA.Namespace hash -> pure . This . Left $ SCH.fromFullHash hash - SA.AbsolutePath path -> pure . This . pure $ Path.absoluteToPath' path - SA.Name name -> pure . This . pure $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> pure . This . pure $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> - pure . This . pure . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name - SA.ProjectBranch pb -> pure $ pure pb + SA.Namespace hash -> pure . This . BranchAtSCH $ SCH.fromFullHash hash + SA.AbsolutePath path -> pure . This . BranchAtPath $ Path.absoluteToPath' path + SA.Name name -> pure . This . BranchAtPath $ Path.fromName' name + SA.NameWithBranchPrefix (BranchAtSCH _) name -> pure . This . BranchAtPath $ Path.fromName' name + SA.NameWithBranchPrefix (BranchAtPath prefix) name -> + pure . This . BranchAtPath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name + SA.ProjectBranch pb -> pure $ That pb otherArgType -> Left $ wrongStructuredArgument "a branch" otherArgType where branchIdOrProject :: @@ -506,8 +517,8 @@ handleBranchId2Arg = SA.Namespace hash -> pure . Left $ SCH.fromFullHash hash SA.AbsolutePath path -> pure . pure . UnqualifiedPath $ Path.absoluteToPath' path SA.Name name -> pure . pure . UnqualifiedPath $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> pure . pure . UnqualifiedPath $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> + SA.NameWithBranchPrefix (BranchAtSCH _) name -> pure . pure . UnqualifiedPath $ Path.fromName' name + SA.NameWithBranchPrefix (BranchAtPath prefix) name -> pure . pure . UnqualifiedPath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name SA.ProjectBranch (ProjectAndBranch mproject branch) -> case mproject of @@ -522,8 +533,8 @@ handleBranchRelativePathArg = \case SA.AbsolutePath path -> pure . UnqualifiedPath $ Path.absoluteToPath' path SA.Name name -> pure . UnqualifiedPath $ Path.fromName' name - SA.NameWithBranchPrefix (Left _) name -> pure . UnqualifiedPath $ Path.fromName' name - SA.NameWithBranchPrefix (Right prefix) name -> + SA.NameWithBranchPrefix (BranchAtSCH _) name -> pure . UnqualifiedPath $ Path.fromName' name + SA.NameWithBranchPrefix (BranchAtPath prefix) name -> pure . UnqualifiedPath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name SA.ProjectBranch (ProjectAndBranch mproject branch) -> case mproject of @@ -559,8 +570,8 @@ handleHashQualifiedSplit'Arg = (first P.text . Path.parseHQSplit') \case hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit' name - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit' hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + SA.HashQualifiedWithBranchPrefix (BranchAtSCH _) hqname -> pure $ hq'NameToSplit' hqname + SA.HashQualifiedWithBranchPrefix (BranchAtPath prefix) hqname -> pure . hq'NameToSplit' $ Name.makeAbsolute . Path.prefixName prefix <$> hqname sr@(SA.SearchResult mpath result) -> first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit' $ searchResultToHQ mpath result @@ -572,8 +583,8 @@ handleHashQualifiedSplitArg = (first P.text . Path.parseHQSplit) \case hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit name - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + SA.HashQualifiedWithBranchPrefix (BranchAtSCH _) hqname -> pure $ hq'NameToSplit hqname + SA.HashQualifiedWithBranchPrefix (BranchAtPath prefix) hqname -> pure . hq'NameToSplit $ Name.makeAbsolute . Path.prefixName prefix <$> hqname sr@(SA.SearchResult mpath result) -> first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit $ searchResultToHQ mpath result @@ -594,8 +605,8 @@ handleShortHashOrHQSplit'Arg = (first P.text . Path.parseShortHashOrHQSplit') \case SA.HashQualified name -> pure $ hqNameToSplit' name - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure . pure $ hq'NameToSplit' hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + SA.HashQualifiedWithBranchPrefix (BranchAtSCH _) hqname -> pure . pure $ hq'NameToSplit' hqname + SA.HashQualifiedWithBranchPrefix (BranchAtPath prefix) hqname -> pure . pure $ hq'NameToSplit' (Name.makeAbsolute . Path.prefixName prefix <$> hqname) SA.SearchResult mpath result -> pure . hqNameToSplit' $ searchResultToHQ mpath result otherNumArg -> Left $ wrongStructuredArgument "a hash or name" otherNumArg @@ -614,11 +625,11 @@ handleNameArg = (first P.text . Name.parseTextEither . Text.pack) \case SA.Name name -> pure name - SA.NameWithBranchPrefix (Left _) name -> pure name - SA.NameWithBranchPrefix (Right prefix) name -> pure . Name.makeAbsolute $ Path.prefixName prefix name + SA.NameWithBranchPrefix (BranchAtSCH _) name -> pure name + SA.NameWithBranchPrefix (BranchAtPath prefix) name -> pure . Name.makeAbsolute $ Path.prefixName prefix name SA.HashQualified hqname -> maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + SA.HashQualifiedWithBranchPrefix (BranchAtSCH _) hqname -> pure $ HQ'.toName hqname + SA.HashQualifiedWithBranchPrefix (BranchAtPath prefix) hqname -> pure . Name.makeAbsolute . Path.prefixName prefix $ HQ'.toName hqname SA.SearchResult mpath result -> maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result @@ -1510,7 +1521,7 @@ history = ) \case [src] -> Input.HistoryI (Just 10) (Just 10) <$> handleBranchIdArg src - [] -> pure $ Input.HistoryI (Just 10) (Just 10) (Right Path.currentPath) + [] -> pure $ Input.HistoryI (Just 10) (Just 10) (BranchAtPath Path.currentPath) _ -> Left (I.help history) forkLocal :: InputPattern @@ -2097,7 +2108,7 @@ diffNamespace = ) ( \case [before, after] -> Input.DiffNamespaceI <$> handleBranchIdArg before <*> handleBranchIdArg after - [before] -> Input.DiffNamespaceI <$> handleBranchIdArg before <*> pure (pure Path.currentPath) + [before] -> Input.DiffNamespaceI <$> handleBranchIdArg before <*> pure (BranchAtPath Path.currentPath) _ -> Left $ I.help diffNamespace ) where From f50aa45d1a603a1ece0aadeaa7d2d43bae1e5e50 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Mon, 10 Jun 2024 10:04:53 -0400 Subject: [PATCH 126/631] Create issue templates --- .github/ISSUE_TEMPLATE/bug_report.md | 48 +++++++++++++++++++++++ .github/ISSUE_TEMPLATE/feature_request.md | 20 ++++++++++ 2 files changed, 68 insertions(+) create mode 100644 .github/ISSUE_TEMPLATE/bug_report.md create mode 100644 .github/ISSUE_TEMPLATE/feature_request.md diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md new file mode 100644 index 0000000000..64663666ee --- /dev/null +++ b/.github/ISSUE_TEMPLATE/bug_report.md @@ -0,0 +1,48 @@ +--- +name: Bug report +about: Create a report to help us improve +title: '' +labels: bug +assignees: '' + +--- + +**Describe and demonstrated the bug** +Please attach a [ucm transcript](https://www.unison-lang.org/docs/tooling/transcripts/) if possible, calling out the unexpected behavior in the text. e.g. + +Input: +```` +```unison:hide +a = 1 +``` +Here I typo the next command and `ucm` silently does nothing. I would have expected an error message: +```ucm +.> add b +``` +```` + +Output: +```` +```unison +a = 1 +``` + +Here I typo the next command and `ucm` silently does nothing, I would have expected an error message: +```ucm +.> add b + + + +``` +```` + +**Screenshots** +If applicable, add screenshots to help explain your problem. + +**Environment (please complete the following information):** + - `ucm` version [e.g. "0.5.21", or "1cb2437 (built on 2024-06-03)"] + - OS/Architecture: [e.g. "macOS 14.5, Intel"] + - Browser, if applicable: [e.g. "chrome 125.0.6422.142"] + +**Additional context** +Add any other context about the problem here. diff --git a/.github/ISSUE_TEMPLATE/feature_request.md b/.github/ISSUE_TEMPLATE/feature_request.md new file mode 100644 index 0000000000..e301d68ce7 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/feature_request.md @@ -0,0 +1,20 @@ +--- +name: Feature request +about: Suggest an idea for this project +title: '' +labels: feature request +assignees: '' + +--- + +**Is your feature request related to a problem? Please describe.** +A clear and concise description of what the problem is. Ex. I'm always frustrated when [...] + +**Describe the solution you'd like** +A clear and concise description of what you want to happen. + +**Describe alternatives you've considered** +A clear and concise description of any alternative solutions or features you've considered. + +**Additional context** +Add any other context or screenshots about the feature request here. From 4c528fd3bf074db4eae52df75ad49472dab2c93b Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Mon, 10 Jun 2024 10:25:49 -0400 Subject: [PATCH 127/631] Update .github/ISSUE_TEMPLATE/bug_report.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Simon Højberg --- .github/ISSUE_TEMPLATE/bug_report.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md index 64663666ee..e7a9ed4b7a 100644 --- a/.github/ISSUE_TEMPLATE/bug_report.md +++ b/.github/ISSUE_TEMPLATE/bug_report.md @@ -7,7 +7,7 @@ assignees: '' --- -**Describe and demonstrated the bug** +**Describe and demonstrate the bug** Please attach a [ucm transcript](https://www.unison-lang.org/docs/tooling/transcripts/) if possible, calling out the unexpected behavior in the text. e.g. Input: From 294ebb8e7919c9831092497585ac076cbfb7e1ff Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Mon, 10 Jun 2024 10:32:42 -0400 Subject: [PATCH 128/631] Update .github/ISSUE_TEMPLATE/bug_report.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Simon Højberg --- .github/ISSUE_TEMPLATE/bug_report.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md index e7a9ed4b7a..0d92a71379 100644 --- a/.github/ISSUE_TEMPLATE/bug_report.md +++ b/.github/ISSUE_TEMPLATE/bug_report.md @@ -40,7 +40,7 @@ Here I typo the next command and `ucm` silently does nothing, I would have expec If applicable, add screenshots to help explain your problem. **Environment (please complete the following information):** - - `ucm` version [e.g. "0.5.21", or "1cb2437 (built on 2024-06-03)"] + - `ucm --version` [e.g. "0.5.21", or "1cb2437 (built on 2024-06-03)"] - OS/Architecture: [e.g. "macOS 14.5, Intel"] - Browser, if applicable: [e.g. "chrome 125.0.6422.142"] From ab8ef8b432c975862e134c9c58ef5c9cadc61ca5 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Mon, 10 Jun 2024 10:32:48 -0400 Subject: [PATCH 129/631] Update .github/ISSUE_TEMPLATE/bug_report.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Simon Højberg --- .github/ISSUE_TEMPLATE/bug_report.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md index 0d92a71379..17adbc9c3e 100644 --- a/.github/ISSUE_TEMPLATE/bug_report.md +++ b/.github/ISSUE_TEMPLATE/bug_report.md @@ -42,7 +42,7 @@ If applicable, add screenshots to help explain your problem. **Environment (please complete the following information):** - `ucm --version` [e.g. "0.5.21", or "1cb2437 (built on 2024-06-03)"] - OS/Architecture: [e.g. "macOS 14.5, Intel"] - - Browser, if applicable: [e.g. "chrome 125.0.6422.142"] + - Browser, if applicable: [e.g. "chrome 125.0.6422.142"] (Version numbers are typically found the about menu option) **Additional context** Add any other context about the problem here. From 5f222b775027e82e9e37796348b0c92f468d79b4 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 10 Jun 2024 10:43:52 -0400 Subject: [PATCH 130/631] rearrange when we put an upload failure message so it doesn't disappear --- .../Codebase/Editor/HandleInput/Push.hs | 29 ++++++++++--------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs index 25c7bdf25a..a9aba3224c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs @@ -452,22 +452,23 @@ data UploadPlan = UploadPlan -- Execute an upload plan. executeUploadPlan :: UploadPlan -> Cli () executeUploadPlan UploadPlan {remoteBranch, causalHash, afterUploadAction} = do - numUploaded <- + (uploadResult, numUploaded) <- Cli.with withEntitiesUploadedProgressCallback \(uploadedCallback, getNumUploaded) -> do - let upload = - Share.uploadEntities - (codeserverBaseURL Codeserver.defaultCodeserver) - -- On the wire, the remote branch is encoded as e.g. - -- { "repo_info": "@unison/base/@arya/topic", ... } - (Share.RepoInfo (into @Text (ProjectAndBranch (remoteBranch ^. #project) (remoteBranch ^. #branch)))) - (Set.NonEmpty.singleton causalHash) - uploadedCallback - upload & onLeftM \err0 -> do - (Cli.returnEarly . Output.ShareError) case err0 of - Share.SyncError err -> ShareErrorUploadEntities err - Share.TransportError err -> ShareErrorTransport err - liftIO getNumUploaded + uploadResult <- + Share.uploadEntities + (codeserverBaseURL Codeserver.defaultCodeserver) + -- On the wire, the remote branch is encoded as e.g. + -- { "repo_info": "@unison/base/@arya/topic", ... } + (Share.RepoInfo (into @Text (ProjectAndBranch (remoteBranch ^. #project) (remoteBranch ^. #branch)))) + (Set.NonEmpty.singleton causalHash) + uploadedCallback + numUploaded <- liftIO getNumUploaded + pure (uploadResult, numUploaded) Cli.respond (Output.UploadedEntities numUploaded) + uploadResult & onLeft \err0 -> do + (Cli.returnEarly . Output.ShareError) case err0 of + Share.SyncError err -> ShareErrorUploadEntities err + Share.TransportError err -> ShareErrorTransport err afterUploadAction let ProjectAndBranch projectName branchName = remoteBranch Cli.respond (ViewOnShare (Right (Share.hardCodedUri, projectName, branchName))) From 7274361ec2f7874f9271f13c4d875d474737f1cb Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 10 Jun 2024 10:26:19 -0700 Subject: [PATCH 131/631] Fix up Pull and output messages --- unison-cli/src/Unison/Cli/Pretty.hs | 6 +++--- .../src/Unison/Codebase/Editor/HandleInput/Pull.hs | 9 ++++----- unison-cli/src/Unison/Codebase/Editor/Output.hs | 12 ++++++------ unison-cli/src/Unison/CommandLine/OutputMessages.hs | 9 +++++---- 4 files changed, 18 insertions(+), 18 deletions(-) diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index 0c51349383..7052e7b87d 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -75,8 +75,8 @@ import Unison.Codebase.Editor.RemoteRepo ( ReadRemoteNamespace (..), ) import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo -import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH @@ -179,9 +179,9 @@ prettyPath' p' = then "the current namespace" else P.blue (P.shown p') -prettyNamespaceKey :: Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -> Pretty +prettyNamespaceKey :: Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -> Pretty prettyNamespaceKey = \case - Left path -> prettyPath' path + Left path -> prettyProjectPath path Right (ProjectAndBranch project branch) -> prettyProjectAndBranchName (ProjectAndBranch (project ^. #name) (branch ^. #name)) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index 886f7d2a46..9eebe820c9 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -37,7 +37,6 @@ import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Editor.Propagate qualified as Propagate import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace (..), printReadRemoteNamespace) import Unison.Codebase.Patch (Patch (..)) -import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.InputPattern qualified as InputPattern @@ -92,11 +91,11 @@ handlePull unresolvedSourceAndTarget pullMode = do Input.PullWithHistory -> do targetBranch <- Cli.getBranchFromProjectPath targetProjectPath - if Branch.isEmpty0 $ Branch.head targetBranchObject + if Branch.isEmpty0 $ Branch.head targetBranch then do Cli.Env {codebase} <- ask remoteBranchObject <- liftIO (Codebase.expectBranchForHash codebase remoteCausalHash) - void $ Cli.updateAtM description targetAbsolutePath (const $ pure remoteBranchObject) + void $ Cli.updateAtM description targetProjectPath (const $ pure remoteBranchObject) Cli.respond $ MergeOverEmpty target else do Cli.respond AboutToMerge @@ -133,7 +132,7 @@ handlePull unresolvedSourceAndTarget pullMode = do didUpdate <- Cli.updateAtM description - targetAbsolutePath + targetProjectPath (\targetBranchObject -> pure $ remoteBranchObject `Branch.consBranchSnapshot` targetBranchObject) Cli.respond @@ -268,7 +267,7 @@ mergeBranchAndPropagateDefaultPatch mode inputDescription unchangedMessage srcb loadPropagateDiffDefaultPatch :: Text -> - Maybe (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) -> + Maybe (Either PP.ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) -> PP.ProjectPath -> Cli () loadPropagateDiffDefaultPatch inputDescription maybeDest0 dest = do diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 6880948800..807805e301 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -99,18 +99,18 @@ data NumberedOutput | ShowDiffAfterDeleteBranch Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterModifyBranch Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterMerge - (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) - Path.Absolute + (Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) + ProjectPath PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterMergePropagate - (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) + (Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) ProjectPath Path.Path' PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterMergePreview - (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) + (Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) ProjectPath PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) @@ -291,8 +291,8 @@ data Output | -- This will replace the above once `merge.old` is deleted MergeAlreadyUpToDate2 !MergeSourceAndTarget | PreviewMergeAlreadyUpToDate - (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) - (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) + (Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) + (Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) | -- | No conflicts or edits remain for the current patch. NoConflictsOrEdits | NotImplemented diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index bc95371850..f58aa7458d 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -150,6 +150,7 @@ import Unison.Var (Var) import Unison.Var qualified as Var import Unison.WatchKind qualified as WK import Witch (unsafeFrom) +import Unison.Codebase.Editor.Input (BranchIdG(..)) reportBugURL :: Pretty reportBugURL = "https://github.com/unisonweb/unison/issues/new" @@ -228,7 +229,7 @@ notifyNumbered = \case <> " to undo the results of this merge." ] ) - (showDiffNamespace ShowNumbers ppe (absPathToBranchId destAbs) (absPathToBranchId destAbs) diffOutput) + (showDiffNamespace ShowNumbers ppe (BranchAtProjectPath destAbs) (BranchAtProjectPath destAbs) diffOutput) ShowDiffAfterMergePropagate dest' destAbs patchPath' ppe diffOutput -> first ( \p -> @@ -255,7 +256,7 @@ notifyNumbered = \case <> " to undo the results of this merge." ] ) - (showDiffNamespace ShowNumbers ppe (absPathToBranchId destAbs) (absPathToBranchId destAbs) diffOutput) + (showDiffNamespace ShowNumbers ppe (BranchAtProjectPath destAbs) (BranchAtProjectPath destAbs) diffOutput) ShowDiffAfterMergePreview dest' destAbs ppe diffOutput -> first ( \p -> @@ -265,7 +266,7 @@ notifyNumbered = \case p ] ) - (showDiffNamespace ShowNumbers ppe (absPathToBranchId destAbs) (absPathToBranchId destAbs) diffOutput) + (showDiffNamespace ShowNumbers ppe (BranchAtProjectPath destAbs) (BranchAtProjectPath destAbs) diffOutput) ShowDiffAfterUndo ppe diffOutput -> first (\p -> P.lines ["Here are the changes I undid", "", p]) @@ -532,7 +533,7 @@ notifyNumbered = \case & fmap (\name -> formatNum (getNameNumber name) <> prettyName name) & P.lines where - absPathToBranchId = Right + absPathToBranchId = BranchAtPath undoTip :: P.Pretty P.ColorText undoTip = From a7d455c490475e3ca54b236e3c2653e78712a355 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 10 Jun 2024 10:37:55 -0700 Subject: [PATCH 132/631] Fix CommitUpgrade --- .../src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs index 76229b8bfd..35ebe12519 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs @@ -8,10 +8,10 @@ import U.Codebase.Sqlite.Project qualified import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Editor.HandleInput.DeleteBranch qualified as DeleteBranch import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge -import Unison.Codebase.Editor.HandleInput.ProjectSwitch qualified as ProjectSwitch import Unison.Codebase.Editor.Output qualified as Output import Unison.Merge.TwoWay (TwoWay (..)) import Unison.Prelude @@ -19,7 +19,7 @@ import Unison.Project (ProjectAndBranch (..)) handleCommitUpgrade :: Cli () handleCommitUpgrade = do - (upgradeProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch + upgradeProjectAndBranch <- Cli.getCurrentProjectAndBranch -- Assert that this is an "upgrade" branch and get its parent, which is the branch we were on when we ran `upgrade`. @@ -35,7 +35,7 @@ handleCommitUpgrade = do -- Switch to the parent - ProjectSwitch.switchToProjectBranch (ProjectUtils.justTheIds parentProjectAndBranch) + Cli.switchProject (ProjectUtils.justTheIds parentProjectAndBranch) -- Merge the upgrade branch into the parent From 87c9d5b1d1f331136aa552a12b87b7752598f0ec Mon Sep 17 00:00:00 2001 From: ChrisPenner Date: Mon, 10 Jun 2024 17:40:25 +0000 Subject: [PATCH 133/631] automatically run ormolu --- unison-share-api/src/Unison/Sync/Types.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-share-api/src/Unison/Sync/Types.hs b/unison-share-api/src/Unison/Sync/Types.hs index 4b37cfaf21..98d713f660 100644 --- a/unison-share-api/src/Unison/Sync/Types.hs +++ b/unison-share-api/src/Unison/Sync/Types.hs @@ -742,9 +742,9 @@ instance FromJSON HashMismatchForEntity where Aeson.withObject "HashMismatchForEntity" \obj -> HashMismatchForEntity <$> obj - .: "supplied" + .: "supplied" <*> obj - .: "computed" + .: "computed" data InvalidParentage = InvalidParentage {parent :: Hash32, child :: Hash32} deriving stock (Show) From 528c2a1cd6930f36e957fc04543b1f3232f3febb Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 10 Jun 2024 13:56:12 -0400 Subject: [PATCH 134/631] commit failing transcript --- unison-src/transcripts/merge.md | 46 +++++++++ unison-src/transcripts/merge.output.md | 123 +++++++++++++++++++++++++ 2 files changed, 169 insertions(+) diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index e6475de63d..ddd57e4e50 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -1367,3 +1367,49 @@ project/alice> merge /bob ```ucm:hide .> project.delete project ``` + +## Regression tests + +### Delete one alias and update the other + + +```ucm:hide +.> project.create-empty project +project/main> builtins.mergeio +``` + +```unison +foo = 17 +bar = 17 +``` + +```ucm +project/main> add +project/main> branch alice +project/alice> delete.term bar +``` + +```unison +foo = 18 +``` + +```ucm +project/alice> update +project/main> branch bob +``` + +```unison +bob = 101 +``` + +```ucm +project/bob> add +``` + +```ucm:error +project/alice> merge /bob +``` + +```ucm:hide +.> project.delete project +``` diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 90412693d7..f8841a816e 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1322,3 +1322,126 @@ project/alice> merge /bob I merged project/bob into project/alice. ``` +## Regression tests + +### Delete one alias and update the other + + +```unison +foo = 17 +bar = 17 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bar : Nat + foo : Nat + +``` +```ucm +project/main> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat + +project/main> branch alice + + Done. I've created the alice branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /alice`. + +project/alice> delete.term bar + + Done. + +``` +```unison +foo = 18 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These names already exist. You can `update` them to your + new definition: + + foo : Nat + +``` +```ucm +project/alice> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +project/main> branch bob + + Done. I've created the bob branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /bob`. + +``` +```unison +bob = 101 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bob : Nat + +``` +```ucm +project/bob> add + + ⍟ I've added these definitions: + + bob : Nat + +``` +```ucm +project/alice> merge /bob + + Sorry, I wasn't able to perform the merge: + + On the merge ancestor, foo and bar were aliases for the same + definition, but on project/alice the names have different + definitions currently. I'd need just a single new definition + to use in their dependents when I merge. + + Please fix up project/alice to resolve this. For example, + + * `update` the definitions to be the same again, so that + there's nothing for me to decide. + * `move` or `delete` all but one of the definitions; I'll + use the remaining name when propagating updates. + + and then try merging again. + +``` From e3440a91c6832fb01a617eb48d7297df05af309f Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 10 Jun 2024 13:57:22 -0400 Subject: [PATCH 135/631] don't consider update+delete a conflicted alias --- .../Unison/Codebase/Editor/HandleInput/Merge2.hs | 2 ++ unison-src/transcripts/merge.md | 2 +- unison-src/transcripts/merge.output.md | 16 +--------------- 3 files changed, 4 insertions(+), 16 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 28bed78c5a..6237868aa9 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -974,6 +974,8 @@ findConflictedAlias defns diff = g hashed1 alias = case Map.lookup alias diff of Just (DiffOp'Update hashed2) | hashed1 == hashed2.new -> Nothing + -- If "foo" was updated but its alias "bar" was deleted, that's ok + Just (DiffOp'Delete _) -> Nothing _ -> Just (name, alias) -- Given a name like "base", try "base__1", then "base__2", etc, until we find a name that doesn't diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index ddd57e4e50..d653b84c99 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -1406,7 +1406,7 @@ bob = 101 project/bob> add ``` -```ucm:error +```ucm project/alice> merge /bob ``` diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index f8841a816e..2d977ae507 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1428,20 +1428,6 @@ project/bob> add ```ucm project/alice> merge /bob - Sorry, I wasn't able to perform the merge: - - On the merge ancestor, foo and bar were aliases for the same - definition, but on project/alice the names have different - definitions currently. I'd need just a single new definition - to use in their dependents when I merge. - - Please fix up project/alice to resolve this. For example, - - * `update` the definitions to be the same again, so that - there's nothing for me to decide. - * `move` or `delete` all but one of the definitions; I'll - use the remaining name when propagating updates. - - and then try merging again. + I merged project/bob into project/alice. ``` From 1faba8442dfd11f0552bf3dbb2b6b4ee6a5e3cbc Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 10 Jun 2024 10:39:32 -0700 Subject: [PATCH 136/631] Don't expose dangerous primitives for setting project root --- unison-cli/src/Unison/Cli/MonadUtils.hs | 32 ++++++++----------------- 1 file changed, 10 insertions(+), 22 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 5587f88694..868b7bb3ab 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -27,8 +27,6 @@ module Unison.Cli.MonadUtils resolveShortCausalHash, -- ** Getting/setting branches - setCurrentProjectRoot, - modifyProjectRoot, getCurrentProjectRoot, getCurrentProjectRoot0, getCurrentBranch, @@ -270,25 +268,6 @@ getCurrentProjectRoot0 :: Cli (Branch0 IO) getCurrentProjectRoot0 = Branch.head <$> getCurrentProjectRoot --- | Set a new root branch. --- --- Note: This does _not_ update the codebase, the caller is responsible for that. -setCurrentProjectRoot :: Branch IO -> Cli () -setCurrentProjectRoot b = do - void $ modifyProjectRoot (const b) - --- | Modify the root branch. --- --- Note: This does _not_ update the codebase, the caller is responsible for that. -modifyProjectRoot :: (Branch IO -> Branch IO) -> Cli (Branch IO) -modifyProjectRoot f = do - rootVar <- use #currentProjectRoot - atomically do - root <- takeTMVar rootVar - let !newRoot = f root - putTMVar rootVar newRoot - pure newRoot - -- | Get the current branch. getCurrentBranch :: Cli (Branch IO) getCurrentBranch = do @@ -464,6 +443,7 @@ updateAndStepAt reason projectBranch updates steps = do updateProjectBranchRoot :: ProjectBranch -> Text -> (Branch IO -> Cli (Branch IO, r)) -> Cli r updateProjectBranchRoot projectBranch reason f = do + currentPB <- getCurrentProjectBranch Cli.Env {codebase} <- ask Cli.time "updateProjectBranchRoot" do old <- getProjectBranchRoot projectBranch @@ -472,8 +452,16 @@ updateProjectBranchRoot projectBranch reason f = do Cli.runTransaction $ do causalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash new) Q.setProjectBranchHead reason (projectBranch ^. #projectId) (projectBranch ^. #branchId) causalHashId - setCurrentProjectRoot new + if projectBranch.branchId == currentPB.branchId + then setCurrentProjectRoot new + else pure () pure result + where + setCurrentProjectRoot :: Branch IO -> Cli () + setCurrentProjectRoot !newRoot = do + rootVar <- use #currentProjectRoot + atomically do + void $ swapTMVar rootVar newRoot updateProjectBranchRoot_ :: ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli () updateProjectBranchRoot_ projectBranch reason f = do From 6d78dabea751175b3a5d954417ced42f7811a574 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 10 Jun 2024 10:39:32 -0700 Subject: [PATCH 137/631] Fix up most imports in HandleInput --- unison-cli/src/Unison/Cli/ProjectUtils.hs | 15 ++- .../src/Unison/Codebase/Editor/HandleInput.hs | 124 +++++++----------- 2 files changed, 61 insertions(+), 78 deletions(-) diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index 11aeba7a00..65c480f217 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -4,6 +4,7 @@ module Unison.Cli.ProjectUtils expectProjectBranchByName, resolveBranchRelativePath, resolveProjectBranch, + resolveProjectBranchInProject, -- * Name hydration hydrateNames, @@ -201,13 +202,23 @@ expectProjectAndBranchByTheseNames = \case -- 1. If the project is missing, use the provided project. -- 2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the provided -- project, defaulting to 'main' if branch is unspecified. -resolveProjectBranch :: Project -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -resolveProjectBranch defaultProj (ProjectAndBranch mayProjectName mayBranchName) = do +resolveProjectBranchInProject :: Project -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) +resolveProjectBranchInProject defaultProj (ProjectAndBranch mayProjectName mayBranchName) = do let branchName = fromMaybe (unsafeFrom @Text "main") mayBranchName let projectName = fromMaybe (defaultProj ^. #name) mayProjectName projectAndBranch <- expectProjectAndBranchByTheseNames (These projectName branchName) pure projectAndBranch +-- | Expect/resolve branch reference with the following rules: +-- +-- 1. If the project is missing, use the current project. +-- 2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the current +-- project, defaulting to 'main' if branch is unspecified. +resolveProjectBranch :: ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) +resolveProjectBranch pab = do + pp <- Cli.getCurrentProjectPath + resolveProjectBranchInProject (pp ^. #project) pab + -- | Get the causal hash of a project branch. getProjectBranchCausalHash :: ProjectBranch -> Transaction CausalHash getProjectBranchCausalHash ProjectBranch {projectId, branchId} = do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 6c572676f8..074494cfef 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -37,6 +37,7 @@ import Unison.Builtin qualified as Builtin import Unison.Builtin.Terms qualified as Builtin import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils (getCurrentProjectBranch) import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.NamesUtils qualified as Cli import Unison.Cli.PrettyPrintUtils qualified as Cli @@ -108,6 +109,7 @@ import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path (Path, Path' (..)) import Unison.Codebase.Path qualified as HQSplit' import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.CommandLine.BranchRelativePath (BranchRelativePath) @@ -259,16 +261,8 @@ loop e = do Left hash -> Cli.resolveShortCausalHash hash Right path' -> Cli.expectBranchAtPath' path' That (ProjectAndBranch mProjectName branchName) -> do - let arg = case mProjectName of - Nothing -> That branchName - Just projectName -> These projectName branchName - ProjectAndBranch project branch <- ProjectUtils.expectProjectAndBranchByTheseNames arg - Cli.expectBranchAtPath' - ( Path.absoluteToPath' - ( ProjectUtils.projectBranchPath - (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId)) - ) - ) + newProjectAndBranch <- ProjectUtils.resolveProjectBranch mProjectName (Just branchName) + Cli.getProjectBranchRoot newProjectAndBranch.branch These branchId (ProjectAndBranch mProjectName branchName) -> Cli.label \jump -> do absPath <- case branchId of Left hash -> jump =<< Cli.resolveShortCausalHash hash @@ -342,33 +336,30 @@ loop e = do Left hash -> Cli.resolveShortCausalHash hash Right path' -> Cli.expectBranchAtPath' path' description <- inputDescription input - Cli.updateCurrentProjectRoot newRoot description + pb <- getCurrentProjectBranch + Cli.updateAtM "reset-root" (PP.projectBranchRoot pb) newRoot description Cli.respond Success ForkLocalBranchI src0 dest0 -> do (srcb, branchEmpty) <- case src0 of Left hash -> (,WhichBranchEmptyHash hash) <$> Cli.resolveShortCausalHash hash Right path' -> do - absPath <- ProjectUtils.branchRelativePathToAbsolute path' - let srcp = Path.convert absPath - srcb <- Cli.expectBranchAtPath' srcp + srcPP <- ProjectUtils.resolveBranchRelativePath path' + srcb <- Cli.getBranchFromProjectPath srcPP `whenNothingM` pure Branch.empty pure (srcb, WhichBranchEmptyPath srcp) description <- inputDescription input - dest <- ProjectUtils.branchRelativePathToAbsolute dest0 + dest <- ProjectUtils.resolveBranchRelativePath dest0 ok <- Cli.updateAtM description dest (const $ pure srcb) Cli.respond if ok then Success else BranchEmpty branchEmpty MergeI branch -> handleMerge branch - MergeLocalBranchI src0 dest0 mergeMode -> do + MergeLocalBranchI unresolvedSrc unresolvedDest mergeMode -> do description <- inputDescription input - src0 <- ProjectUtils.expectLooseCodeOrProjectBranch src0 - dest0 <- ProjectUtils.expectLooseCodeOrProjectBranch dest0 - let srcp = looseCodeOrProjectToPath src0 - let destp = looseCodeOrProjectToPath dest0 - srcb <- Cli.expectBranchAtPath' srcp - dest <- Cli.resolvePath' destp + srcPaB <- ProjectUtils.resolveProjectBranch (second Just src0) + destPaB <- ProjectUtils.resolveProjectBranch (second Just dest0) + srcBranch <- Cli.getProjectBranchRoot srcPaB.branch let err = Just $ MergeAlreadyUpToDate @@ -377,11 +368,9 @@ loop e = do mergeBranchAndPropagateDefaultPatch mergeMode description err srcb (Just dest0) dest PreviewMergeLocalBranchI src0 dest0 -> do Cli.Env {codebase} <- ask - src0 <- ProjectUtils.expectLooseCodeOrProjectBranch src0 - dest0 <- ProjectUtils.expectLooseCodeOrProjectBranch dest0 - srcb <- Cli.expectBranchAtPath' $ looseCodeOrProjectToPath src0 - dest <- Cli.resolvePath' $ looseCodeOrProjectToPath dest0 - destb <- Cli.getBranchAt dest + srcPaB <- ProjectUtils.resolveProjectBranch (second Just src0) + destPaB <- ProjectUtils.resolveProjectBranch (second Just dest0) + srcBranch <- Cli.getProjectBranchRoot srcPaB.branch merged <- liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb) if merged == destb then Cli.respond (PreviewMergeAlreadyUpToDate src0 dest0) @@ -421,8 +410,8 @@ loop e = do case from of Left hash -> Cli.resolveShortCausalHash hash Right path' -> do - path <- Cli.resolvePath' path' - Cli.getMaybeBranchAt path & onNothingM (Cli.returnEarly (CreatedNewBranch path)) + pp <- Cli.resolvePath' path' + Cli.getBranchFromProjectPath pp schLength <- Cli.runTransaction Codebase.branchHashLength history <- liftIO (doHistory schLength 0 branch []) Cli.respondNumbered history @@ -440,7 +429,7 @@ loop e = do let elem = (Branch.headHash b, Branch.namesDiff b' b) doHistory schLength (n + 1) b' (elem : acc) UndoI -> do - rootBranch <- Cli.getProjectRoot + rootBranch <- Cli.getCurrentProjectRoot (_, prev) <- liftIO (Branch.uncons rootBranch) & onNothingM do Cli.returnEarly . CantUndo $ @@ -448,7 +437,8 @@ loop e = do then CantUndoPastStart else CantUndoPastMerge description <- inputDescription input - Cli.updateCurrentProjectRoot prev description + pb <- getCurrentProjectBranch + Cli.updateProjectBranchRoot pb prev description (ppe, diff) <- diffHelper (Branch.head prev) (Branch.head rootBranch) Cli.respondNumbered (Output.ShowDiffAfterUndo ppe diff) UiI path' -> openUI path' @@ -467,8 +457,8 @@ loop e = do Cli.respond $ Output.MarkdownOut (Text.intercalate "\n---\n" mdText) DocsToHtmlI namespacePath' sourceDirectory -> do Cli.Env {codebase, sandboxedRuntime} <- ask - absPath <- Cli.resolvePath' namespacePath' - branch <- liftIO $ Codebase.getBranchAtPath codebase absPath + projPath <- Cli.resolvePath' namespacePath' + branch <- Cli.getBranchFromProjectPath projPath _evalErrs <- liftIO $ (Backend.docsInBranchToHtmlFiles sandboxedRuntime codebase branch sourceDirectory) pure () AliasTermI src' dest' -> do @@ -522,14 +512,14 @@ loop e = do -- this implementation will happily produce name conflicts, -- but will surface them in a normal diff at the end of the operation. AliasManyI srcs dest' -> do - root0 <- Cli.getProjectRoot0 + root0 <- Cli.getCurrentProjectRoot0 currentBranch0 <- Cli.getCurrentBranch0 - destAbs <- Cli.resolvePath' dest' - old <- Cli.getBranch0At destAbs + destPP <- Cli.resolvePath' dest' + old <- Cli.getBranch0FromProjectPath destPP description <- inputDescription input let (unknown, actions) = foldl' (go root0 currentBranch0 destAbs) mempty srcs Cli.stepManyAt description actions - new <- Cli.getBranch0At destAbs + new <- Cli.getBranch0FromProjectPath destPP (ppe, diff) <- diffHelper old new Cli.respondNumbered (ShowDiffAfterModifyBranch dest' destAbs ppe diff) when (not (null unknown)) do @@ -579,14 +569,9 @@ loop e = do NamesI global query -> do hqLength <- Cli.runTransaction Codebase.hashLength (names, pped) <- - if global || any Name.isAbsolute query + if global then do - -- TODO: Use some global names index here - root0 <- Cli.getProjectRoot0 - -- Use an absolutely qualified ppe for view.global - let names = Names.makeAbsolute $ Branch.toNames root0 - let pped = PPED.makePPED (PPE.hqNamer hqLength names) (PPE.suffixifyByHash names) - pure (names, pped) + error "TODO: Implement names.global." else do names <- Cli.currentNames pped <- Cli.prettyPrintEnvDeclFromNames names @@ -652,7 +637,8 @@ loop e = do if hasConfirmed || insistence == Force then do description <- inputDescription input - Cli.updateRoot Branch.empty description + pb <- Cli.getCurrentProjectBranch + Cli.updateProjectBranchRoot pb Branch.empty description Cli.respond DeletedEverything else Cli.respond DeleteEverythingConfirmation DeleteTarget'Namespace insistence (Just p@(parentPath, childName)) -> do @@ -824,8 +810,8 @@ loop e = do Cli.respond $ DumpUnisonFileHashes hqLength datas effects terms DebugTabCompletionI inputs -> do Cli.Env {authHTTPClient, codebase} <- ask - ppCtx <- Cli.getProjectPath - let completionFunc = Completion.haskelineTabComplete IP.patternMap codebase authHTTPClient ppCtx + pp <- Cli.getCurrentProjectPath + let completionFunc = Completion.haskelineTabComplete IP.patternMap codebase authHTTPClient pp (_, completions) <- liftIO $ completionFunc (reverse (unwords inputs), "") Cli.respond (DisplayDebugCompletions completions) DebugFuzzyOptionsI command args -> do @@ -835,8 +821,8 @@ loop e = do Just (IP.InputPattern {args = argTypes}) -> do zip argTypes args & Monoid.foldMapM \case ((argName, _, IP.ArgumentType {fzfResolver = Just IP.FZFResolver {getOptions}}), "_") -> do - ppCtx <- Cli.getProjectPath - results <- liftIO $ getOptions codebase ppCtx currentBranch + pp <- Cli.getCurrentProjectPath + results <- liftIO $ getOptions codebase pp currentBranch Cli.respond (DebugDisplayFuzzyOptions argName (Text.unpack <$> results)) ((_, _, IP.ArgumentType {fzfResolver = Nothing}), "_") -> do Cli.respond DebugFuzzyOptionsNoResolver @@ -906,10 +892,10 @@ loop e = do prettyRef renderR r = P.indentN 2 $ P.text (renderR r) prettyDefn renderR (r, Foldable.toList -> names) = P.lines (P.text <$> if null names then [""] else NameSegment.toEscapedText <$> names) <> P.newline <> prettyRef renderR r - projectRoot <- Cli.getProjectRoot + projectRoot <- Cli.getCurrentProjectRoot void . liftIO . flip State.execStateT mempty $ goCausal [getCausal projectRoot] DebugDumpNamespaceSimpleI -> do - projectRootBranch0 <- Cli.getProjectRoot0 + projectRootBranch0 <- Cli.getCurrentProjectRoot0 for_ (Relation.toList . Branch.deepTypes $ projectRootBranch0) \(r, name) -> traceM $ show name ++ ",Type," ++ Text.unpack (Reference.toText r) for_ (Relation.toList . Branch.deepTerms $ projectRootBranch0) \(r, name) -> @@ -1161,12 +1147,10 @@ inputDescription input = hqs (p, hq) = hqs' (Path' . Right . Path.Relative $ p, hq) ps' = p' . Path.unsplit' ps = p . Path.unsplit - looseCodeOrProjectToText :: Input.LooseCodeOrProject -> Cli Text - looseCodeOrProjectToText = \case - This path -> p' path - That branch -> pure (into @Text branch) - -- just trying to recover the syntax the user wrote - These path _branch -> pure (Path.toText' path) + unresolvedProjectBranchText :: UnresolvedProjectBranch -> Cli Text + unresolvedProjectBranchText (ProjectAndBranch mayProjName pbName) = case mayProjName of + Nothing -> pure $ into @Text pbName + Just projName -> into @Text $ ProjectAndBranch projName pbName handleFindI :: Bool -> @@ -1179,7 +1163,7 @@ handleFindI isVerbose fscope ws input = do (pped, names, searchRoot, branch0) <- case fscope of FindLocal p -> do searchRoot <- Cli.resolvePath' p - branch0 <- Cli.getBranch0At searchRoot + branch0 <- Cli.getBranch0FromProjectPath searchRoot let names = Branch.toNames (Branch.withoutLib branch0) -- Don't exclude anything from the pretty printer, since the type signatures we print for -- results may contain things in lib. @@ -1187,7 +1171,7 @@ handleFindI isVerbose fscope ws input = do pure (pped, names, Just p, branch0) FindLocalAndDeps p -> do searchRoot <- Cli.resolvePath' p - branch0 <- Cli.getBranch0At searchRoot + branch0 <- Cli.getBranch0FromProjectPath searchRoot let names = Branch.toNames (Branch.withoutTransitiveLibs branch0) -- Don't exclude anything from the pretty printer, since the type signatures we print for -- results may contain things in lib. @@ -1195,7 +1179,7 @@ handleFindI isVerbose fscope ws input = do pure (pped, names, Just p, branch0) FindGlobal -> do -- TODO: Rewrite to be properly global again - projectRootNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getProjectRoot0 + projectRootNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getCurrentProjectRoot0 pped <- Cli.prettyPrintEnvDeclFromNames projectRootNames currentBranch0 <- Cli.getCurrentBranch0 pure (pped, projectRootNames, Nothing, currentBranch0) @@ -1336,14 +1320,14 @@ handleShowDefinition outputLoc showDefinitionScope query = do (names, unbiasedPPED) <- case (hasAbsoluteQuery, showDefinitionScope) of -- TODO: We should instead print each definition using the names from its project-branch root. (True, _) -> do - root <- Cli.getProjectRoot + root <- Cli.getCurrentProjectRoot let root0 = Branch.head root let names = Names.makeAbsolute $ Branch.toNames root0 pped <- Cli.prettyPrintEnvDeclFromNames names pure (names, pped) (_, ShowDefinitionGlobal) -> do -- TODO: Maybe rewrite to be properly global - root <- Cli.getProjectRoot + root <- Cli.getCurrentProjectRoot let root0 = Branch.head root let names = Names.makeAbsolute $ Branch.toNames root0 pped <- Cli.prettyPrintEnvDeclFromNames names @@ -1627,7 +1611,7 @@ checkDeletes typesTermsTuples doutput inputs = do toRel setRef name = R.fromList (fmap (name,) (toList setRef)) let toDelete = fmap (\(_, names, types, terms) -> Names (toRel terms names) (toRel types names)) splitsNames -- make sure endangered is compeletely contained in paths - projectNames <- Branch.toNames <$> Cli.getProjectRoot0 + projectNames <- Branch.toNames <$> Cli.getCurrentProjectRoot0 -- get only once for the entire deletion set let allTermsToDelete :: Set LabeledDependency allTermsToDelete = Set.unions (fmap Names.labeledReferences toDelete) @@ -1721,7 +1705,7 @@ displayI outputLoc hq = do (names, pped) <- if useRoot then do - root <- Cli.getProjectRoot + root <- Cli.getCurrentProjectRoot let root0 = Branch.head root let names = Names.makeAbsolute $ Branch.toNames root0 pped <- Cli.prettyPrintEnvDeclFromNames names @@ -1853,15 +1837,3 @@ addWatch watchName (Just uf) = do (UF.watchComponents uf <> [(WK.RegularWatch, [(v2, ann, Term.var a v, ty)])]) ) _ -> addWatch watchName Nothing - -looseCodeOrProjectToPath :: Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -> Path' -looseCodeOrProjectToPath = \case - Left pth -> pth - Right (ProjectAndBranch prj br) -> - Path.absoluteToPath' - ( ProjectUtils.projectBranchPath - ( ProjectAndBranch - (prj ^. #projectId) - (br ^. #branchId) - ) - ) From b76e559dddf564d49a41d30bb6be22adadac3062 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 10 Jun 2024 11:55:30 -0700 Subject: [PATCH 138/631] Fix projectbranch resolve rename --- unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs | 2 +- .../src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index ab26f12f34..8dc9252dc0 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -64,7 +64,7 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB Input.BranchSourceI'Empty -> pure Nothing Input.BranchSourceI'UnresolvedProjectBranch unresolvedProjectBranch -> do pp <- Cli.getCurrentProjectPath - Just <$> ProjectUtils.resolveProjectBranch (pp ^. #project) (unresolvedProjectBranch & #branch %~ Just) + Just <$> ProjectUtils.resolveProjectBranchInProject (pp ^. #project) (unresolvedProjectBranch & #branch %~ Just) case maySrcProjectAndBranch of Just srcProjectAndBranch -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs index 2c91256bb7..4501d0d453 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs @@ -28,7 +28,7 @@ import Witch (unsafeFrom) handleDeleteBranch :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleDeleteBranch projectAndBranchNamesToDelete = do ProjectPath currentProject currentBranch _ <- Cli.getCurrentProjectPath - projectAndBranchToDelete@(ProjectAndBranch _projectToDelete branchToDelete) <- ProjectUtils.resolveProjectBranch currentProject (projectAndBranchNamesToDelete & #branch %~ Just) + projectAndBranchToDelete@(ProjectAndBranch _projectToDelete branchToDelete) <- ProjectUtils.resolveProjectBranchInProject currentProject (projectAndBranchNamesToDelete & #branch %~ Just) doDeleteProjectBranch projectAndBranchToDelete -- If the user is on the branch that they're deleting, we have to cd somewhere; try these in order: From e1802a1e2a6e0e37832e3bbd6b8018c35fba0450 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 10 Jun 2024 15:35:15 -0400 Subject: [PATCH 139/631] make `edit.namespace` not put record accessors --- .../src/Unison/PrettyPrintEnv/Names.hs | 7 ++ .../src/Unison/Syntax/DeclPrinter.hs | 71 +++++++------- .../Editor/HandleInput/EditNamespace.hs | 96 ++++++++++++------- 3 files changed, 110 insertions(+), 64 deletions(-) diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs index fe34067742..4d511091eb 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs @@ -32,11 +32,15 @@ import Unison.Referent (Referent) ------------------------------------------------------------------------------------------------------------------------ -- Namer +-- | A "namer" associates a set of (possibly hash-qualified) names with a referent / type reference. data Namer = Namer { nameTerm :: Referent -> Set (HQ'.HashQualified Name), nameType :: TypeReference -> Set (HQ'.HashQualified Name) } +-- | Make a "namer" out of a collection of names, ignoring conflicted names. That is, if references #foo and #bar are +-- both associated with name "baz", then the returned namer maps #foo too "baz" (not "baz"#foo) and #bar to "baz" (not +-- "baz"#bar). namer :: Names -> Namer namer names = Namer @@ -44,6 +48,9 @@ namer names = nameType = Set.map HQ'.fromName . Names.namesForReference names } +-- | Make a "namer" out of a collection of names, respecting conflicted names. That is, if references #foo and #bar are +-- both associated with name "baz", then the returned namer maps #foo too "baz"#foo and #bar to "baz"#bar, but otherwise +-- if a reference #qux has a single name "qux", then the returned namer maps #qux to "qux" (not "qux"#qux). hqNamer :: Int -> Names -> Namer hqNamer hashLen names = Namer diff --git a/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs b/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs index 71668e70a5..cfe84cb175 100644 --- a/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs @@ -3,6 +3,7 @@ module Unison.Syntax.DeclPrinter prettyDeclW, prettyDeclHeader, prettyDeclOrBuiltinHeader, + getFieldAndAccessorNames, AccessorName, ) where @@ -26,7 +27,7 @@ import Unison.PrettyPrintEnv (PrettyPrintEnv) import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.PrettyPrintEnvDecl qualified as PPED -import Unison.Reference (Reference, Reference' (DerivedId), TypeReference) +import Unison.Reference (Reference, TypeReference) import Unison.Referent qualified as Referent import Unison.Syntax.HashQualified qualified as HQ (toText) import Unison.Syntax.Name qualified as Name @@ -125,20 +126,20 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd = constructor (n, (_, _, t)) = constructor' n t constructor' n t = case Type.unArrows t of Nothing -> pure $ prettyPattern unsuffixifiedPPE CT.Data name (ConstructorReference r n) - Just ts -> case fieldNames unsuffixifiedPPE r name dd of + Just ts -> case getFieldAndAccessorNames unsuffixifiedPPE r name dd of Nothing -> pure . P.group . P.hang' (prettyPattern unsuffixifiedPPE CT.Data name (ConstructorReference r n)) " " $ P.spaced (runPretty suffixifiedPPE (traverse (TypePrinter.prettyRaw Map.empty 10) (init ts))) - Just fs -> do + Just (fieldNames, _) -> do tell $ Set.fromList $ [ case accessor of Nothing -> declName `Name.joinDot` fieldName Just accessor -> declName `Name.joinDot` fieldName `Name.joinDot` accessor | HQ.NameOnly declName <- [name], - fieldName <- fs, + fieldName <- fieldNames, accessor <- [ Nothing, Just (Name.fromSegment NameSegment.setSegment), @@ -149,7 +150,7 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd = fmt S.DelimiterChar "{ " <> P.sep (fmt S.DelimiterChar "," <> " " `P.orElse` "\n ") - (field <$> zip fs (init ts)) + (field <$> zip fieldNames (init ts)) <> fmt S.DelimiterChar " }" field (fname, typ) = P.group $ @@ -158,28 +159,31 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd = `P.hang` runPretty suffixifiedPPE (TypePrinter.prettyRaw Map.empty (-1) typ) header = prettyDataHeader name dd <> fmt S.DelimiterChar (" = " `P.orElse` "\n = ") --- Comes up with field names for a data declaration which has the form of a --- record, like `type Pt = { x : Int, y : Int }`. Works by generating the --- record accessor terms for the data type, hashing these terms, and then --- checking the `PrettyPrintEnv` for the names of those hashes. If the names for --- these hashes are: +-- This function determines if a data declaration "looks like a record", and if so, returns both its auto-generated +-- accessor names (such as "Pt.x.set") and field names (such as "x"). Because we generate three accessors per field, +-- there will always be three times as many accessors as there are fields. +-- +-- It works by works by generating the record accessor terms for the data type, hashing these terms, and then checking +-- the `PrettyPrintEnv` for the names of those hashes. +-- +-- For example, for a type named "Pt", if the names of its accessors are -- -- `Pt.x`, `Pt.x.set`, `Pt.x.modify`, `Pt.y`, `Pt.y.set`, `Pt.y.modify` -- --- then this matches the naming convention generated by the parser, and we --- return `x` and `y` as the field names. +-- then we will return those accessors along with the field names +-- +-- `x`, `y` -- --- This function bails with `Nothing` if the names aren't an exact match for --- the expected record naming convention. -fieldNames :: +-- This function returns `Nothing` if the given data declaration does not "look like a record". +getFieldAndAccessorNames :: forall v a. (Var v) => PrettyPrintEnv -> TypeReference -> HQ.HashQualified Name -> DataDeclaration v a -> - Maybe [Name] -fieldNames env r hqTypename dd = do + Maybe ([Name], [Name]) -- field names, accessor names +getFieldAndAccessorNames env r hqTypename dd = do -- If we only have a hash for the decl, then we can't know where in the namespace to look for the generated accessors, -- so we just give up trying to infer whether this was a record (even if it was one). typename <- HQ.toName hqTypename @@ -212,10 +216,11 @@ fieldNames env r hqTypename dd = do -- ( #sety , "Pt.y.set" ) -- ( #modifyy , "Pt.y.modify" ) -- ] - let names = - [ (r, HQ.toText . PPE.termName env . Referent.Ref $ DerivedId r) - | r <- (\(refId, _trm, _typ) -> refId) <$> Map.elems hashes - ] + let accessorNamesByHash = + hashes + & Map.elems + & map \(refId, _term, _typ) -> + (refId, HQ.toText (PPE.termName env (Referent.fromTermReferenceId refId))) -- { -- #getx => "x" @@ -225,10 +230,10 @@ fieldNames env r hqTypename dd = do -- #sety => "y" -- #modifyy => "y" -- } - let fieldNames = + let fieldNamesByHash = Map.fromList [ (r, f) - | (r, n) <- names, + | (r, n) <- accessorNamesByHash, let typenameText = Name.toText typename, typenameText `Text.isPrefixOf` n, let rest = Text.drop (Text.length typenameText + 1) n, @@ -236,17 +241,19 @@ fieldNames env r hqTypename dd = do rest `elem` ["", ".set", ".modify"] ] - if Map.size fieldNames == length names + if Map.size fieldNamesByHash == length accessorNamesByHash then Just - [ Name.unsafeParseText name - | -- "_0" - v <- vars, - -- #getx - Just (ref, _, _) <- [Map.lookup (Var.namespaced (Name.toVar typename :| [v])) hashes], - -- "x" - Just name <- [Map.lookup ref fieldNames] - ] + ( [ Name.unsafeParseText name + | -- "_0" + v <- vars, + -- #getx + Just (ref, _, _) <- [Map.lookup (Var.namespaced (Name.toVar typename :| [v])) hashes], + -- "x" + Just name <- [Map.lookup ref fieldNamesByHash] + ], + map (Name.unsafeParseText . snd) accessorNamesByHash + ) else Nothing prettyModifier :: DD.Modifier -> Pretty SyntaxText diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditNamespace.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditNamespace.hs index 45db6ada4c..6f75ba3a93 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditNamespace.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditNamespace.hs @@ -1,8 +1,11 @@ module Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace) where import Control.Monad.Reader +import Data.Foldable qualified as Foldable import Data.List.Extra qualified as List import Data.Map qualified as Map +import Data.Set qualified as Set +import U.Codebase.Reference (Reference' (..)) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli @@ -10,58 +13,87 @@ import Unison.Cli.PrettyPrintUtils qualified as NamesUtils import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Editor.DisplayObject qualified as DisplayObject import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions) import Unison.Codebase.Editor.Input (OutputLocation (..)) import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path +import Unison.HashQualified qualified as HQ +import Unison.Name (Name) import Unison.Names qualified as Names import Unison.Prelude +import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) +import Unison.Referent qualified as Referent import Unison.Server.Backend qualified as Backend +import Unison.Syntax.DeclPrinter qualified as DeclPrinter import Unison.Util.Monoid (foldMapM) handleEditNamespace :: OutputLocation -> [Path] -> Cli () -handleEditNamespace outputLoc inputPaths = do +handleEditNamespace outputLoc paths0 = do Cli.Env {codebase} <- ask currentBranch <- Cli.getCurrentBranch0 ppe <- NamesUtils.currentPrettyPrintEnvDecl + + -- Adjust the requested list of paths slightly: if it's missing (i.e. `edit.namespace` without arguments), then behave + -- as if the empty path (which there is no syntax for, heh) was supplied. let paths = - if null inputPaths + if null paths0 then [Path.empty] - else inputPaths + else paths0 + + -- Make a names object that contains the union of all names in the supplied paths (each prefixed with the associated + -- path of course). Special case: if the path is the empty path, then ignore `lib`. let allNamesToEdit = - (List.nubOrd paths) & foldMap \path -> - let b = Branch.withoutLib $ Branch.getAt0 path currentBranch - names = (Branch.toNames b) - prefixedNames = case Path.toName path of + List.nubOrd paths & foldMap \path -> + let branch = (if path == Path.empty then Branch.withoutLib else id) (Branch.getAt0 path currentBranch) + names = Branch.toNames branch + in -- PPED.makePPED (PPE.hqNamer hashLen ns) (PPE.suffixifyByHash ns) + + case Path.toName path of Nothing -> names Just pathPrefix -> Names.prefix0 pathPrefix names - in prefixedNames + let termRefs = Names.termReferences allNamesToEdit - -- We only need to (optionally) include cycles for type references, not term references, - -- because 'update' is smart enough to patch-up cycles as expected for terms. - let typeRefsWithoutCycles = Names.typeReferences allNamesToEdit - typeRefs <- Cli.runTransaction $ - case includeCycles of - Backend.IncludeCycles -> foldMapM Codebase.componentReferencesForReference typeRefsWithoutCycles - Backend.DontIncludeCycles -> pure typeRefsWithoutCycles + let typeRefs = Names.typeReferences allNamesToEdit - terms <- - termRefs - & foldMapM \ref -> - Map.singleton ref <$> Backend.displayTerm codebase ref - & Cli.runTransaction + (types, terms) <- + Cli.runTransaction do + (types, accessorNames) <- + Foldable.foldlM + ( \(types, accessorNames) ref -> + case ref of + ReferenceBuiltin _ -> do + let !types1 = Map.insert ref (DisplayObject.BuiltinObject ()) types + pure (types1, accessorNames) + ReferenceDerived refId -> do + decl <- Codebase.unsafeGetTypeDeclaration codebase refId + let !types1 = Map.insert ref (DisplayObject.UserObject decl) types + let !accessorNames1 = + accessorNames <> case decl of + Left _effectDecl -> Set.empty + Right dataDecl -> + let declAccessorNames :: Name -> Set Name + declAccessorNames declName = + case DeclPrinter.getFieldAndAccessorNames + ppe.unsuffixifiedPPE + ref + (HQ.fromName declName) + dataDecl of + Nothing -> Set.empty + Just (_fieldNames, theAccessorNames) -> Set.fromList theAccessorNames + in foldMap declAccessorNames (Names.namesForReference allNamesToEdit ref) + pure (types1, accessorNames1) + ) + (Map.empty, Set.empty) + typeRefs + terms <- + termRefs & foldMapM \ref -> + let isRecordAccessor = + not (Set.disjoint (Names.namesForReferent allNamesToEdit (Referent.fromTermReference ref)) accessorNames) + in if isRecordAccessor + then pure Map.empty + else Map.singleton ref <$> Backend.displayTerm codebase ref + pure (types, terms) - types <- - typeRefs - & foldMapM \ref -> - Map.singleton ref <$> Backend.displayType codebase ref - & Cli.runTransaction let misses = [] showDefinitions outputLoc ppe terms types misses - where - -- `view`: don't include cycles; `edit`: include cycles - includeCycles = - case outputLoc of - ConsoleLocation -> Backend.DontIncludeCycles - FileLocation _ -> Backend.IncludeCycles - LatestFileLocation -> Backend.IncludeCycles From 72bdd9185fcf189c24833737159320f0eb5efd01 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 10 Jun 2024 15:49:02 -0400 Subject: [PATCH 140/631] amend edit.namespace transcript --- unison-src/transcripts/edit-namespace.md | 22 +++--- .../transcripts/edit-namespace.output.md | 71 ++++++++++++++----- 2 files changed, 62 insertions(+), 31 deletions(-) diff --git a/unison-src/transcripts/edit-namespace.md b/unison-src/transcripts/edit-namespace.md index f2649ca4e2..816922fe82 100644 --- a/unison-src/transcripts/edit-namespace.md +++ b/unison-src/transcripts/edit-namespace.md @@ -1,8 +1,9 @@ ```ucm:hide -.> builtins.mergeio lib.builtin +.> project.create-empty project +project/main> builtins.mergeio lib.builtin ``` -```unison:hide +```unison {{ ping doc }} nested.cycle.ping n = n Nat.+ pong n @@ -16,26 +17,23 @@ simple.y = 20 -- Shouldn't edit things in lib lib.project.ignoreMe = 30 -``` -```ucm:hide -.> add +-- Shouldn't render record accessors +unique type Foo = { bar : Nat, baz : Nat } ``` -Edit current namespace - ```ucm -.simple> edit.namespace +project/main> add ``` -Edit should hit things recursively +`edit.namespace` edits the whole namespace (minus the top-level `lib`). ```ucm -.> edit.namespace +project/main> edit.namespace ``` -Edit should handle multiple explicit paths at once. +`edit.namespace` can also accept explicit paths ```ucm -.> edit.namespace nested.cycle simple +project/main> edit.namespace nested simple ``` diff --git a/unison-src/transcripts/edit-namespace.output.md b/unison-src/transcripts/edit-namespace.output.md index c180a2a330..ab3bbbb54a 100644 --- a/unison-src/transcripts/edit-namespace.output.md +++ b/unison-src/transcripts/edit-namespace.output.md @@ -12,43 +12,76 @@ simple.y = 20 -- Shouldn't edit things in lib lib.project.ignoreMe = 30 -``` -Edit current namespace +-- Shouldn't render record accessors +unique type Foo = { bar : Nat, baz : Nat } +``` ```ucm -.simple> edit.namespace - ☝️ - - I added 2 definitions to the top of scratch.u + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: - You can edit them there, then run `update` to replace the - definitions currently in this namespace. + ⍟ These new definitions are ok to `add`: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo + Foo.baz : Foo -> Nat + Foo.baz.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.baz.set : Nat -> Foo -> Foo + lib.project.ignoreMe : Nat + nested.cycle.ping : Nat -> Nat + nested.cycle.ping.doc : Doc2 + nested.cycle.pong : Nat -> Nat + nested.cycle.pong.doc : Doc2 + simple.x : Nat + simple.y : Nat + toplevel : Text ``` -```unison:added-by-ucm scratch.u -x : ##Nat -x = 10 +```ucm +project/main> add -y : ##Nat -y = 20 -``` + ⍟ I've added these definitions: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo + Foo.baz : Foo -> Nat + Foo.baz.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.baz.set : Nat -> Foo -> Foo + lib.project.ignoreMe : Nat + nested.cycle.ping : Nat -> Nat + nested.cycle.ping.doc : Doc2 + nested.cycle.pong : Nat -> Nat + nested.cycle.pong.doc : Doc2 + simple.x : Nat + simple.y : Nat + toplevel : Text -Edit should hit things recursively +``` +`edit.namespace` edits the whole namespace (minus the top-level `lib`). ```ucm -.> edit.namespace +project/main> edit.namespace ☝️ - I added 7 definitions to the top of scratch.u + I added 8 definitions to the top of scratch.u You can edit them there, then run `update` to replace the definitions currently in this namespace. ``` ```unison:added-by-ucm scratch.u +type Foo = { bar : Nat, baz : Nat } + nested.cycle.ping : Nat -> Nat nested.cycle.ping n = use Nat + @@ -75,10 +108,10 @@ toplevel : Text toplevel = "hi" ``` -Edit should handle multiple explicit paths at once. +`edit.namespace` can also accept explicit paths ```ucm -.> edit.namespace nested.cycle simple +project/main> edit.namespace nested simple ☝️ From 7a704004432532e9c09aa0339906f8d2a8df0a59 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Mon, 10 Jun 2024 16:45:45 -0400 Subject: [PATCH 141/631] Update issue templates --- .../error-message-suggestion.md | 38 +++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 .github/ISSUE_TEMPLATE/error-message-suggestion.md diff --git a/.github/ISSUE_TEMPLATE/error-message-suggestion.md b/.github/ISSUE_TEMPLATE/error-message-suggestion.md new file mode 100644 index 0000000000..04d267e69a --- /dev/null +++ b/.github/ISSUE_TEMPLATE/error-message-suggestion.md @@ -0,0 +1,38 @@ +--- +name: Error message suggestion +about: Suggest improved wording or design for an error message +title: '' +labels: error-message +assignees: '' + +--- + +**What's the message you're seeing?** +Please paste from your terminal or paste a screenshot, e.g: +``` +project/alice> merge /bob + + On project/alice, bar and foo are not aliases, but they used + to be. + +``` + +**What would a better version look like?** +``` +Sorry, I wasn't able to perform the merge: + +On the merge ancestor, bar and foo were aliases for the same definition; but on project/alice the names have different definitions currently. I'd need just a single new definition to use in their dependents when I merge. + +Please fix up project/alice to resolve this. For example, + + * update the definitions to be the same again, so that there's nothing for me to decide. + * rename or delete one of the definitions; I'll use the remaining name when propagating updates, + and you can change the name back after the merge. + +``` + +Environment (please complete the following information): + +* `ucm --version` [e.g. "0.5.21", or "1cb2437 (built on 2024-06-03)"] +* OS/Architecture: [e.g. "macOS 14.5, Intel"] +* Browser, if applicable: [e.g. "chrome 125.0.6422.142"] (Version numbers are typically found the about menu option) From 591d72cffa088693524461fe059c139724039a0a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 10 Jun 2024 11:57:38 -0700 Subject: [PATCH 142/631] Resolve imports in HandleInput --- .../src/Unison/Codebase/Editor/HandleInput.hs | 77 +++---------------- .../src/Unison/Codebase/Editor/Input.hs | 7 +- 2 files changed, 11 insertions(+), 73 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 074494cfef..318dc3394c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -257,75 +257,17 @@ loop e = do ResetI newRoot mtarget -> do newRoot <- case newRoot of - This newRoot -> case newRoot of - Left hash -> Cli.resolveShortCausalHash hash - Right path' -> Cli.expectBranchAtPath' path' - That (ProjectAndBranch mProjectName branchName) -> do - newProjectAndBranch <- ProjectUtils.resolveProjectBranch mProjectName (Just branchName) - Cli.getProjectBranchRoot newProjectAndBranch.branch - These branchId (ProjectAndBranch mProjectName branchName) -> Cli.label \jump -> do - absPath <- case branchId of - Left hash -> jump =<< Cli.resolveShortCausalHash hash - Right path' -> Cli.resolvePath' path' - mrelativePath <- - Cli.getMaybeBranchAt absPath <&> \case - Nothing -> Nothing - Just _ -> preview ProjectUtils.projectBranchPathPrism absPath - projectAndBranch <- do - let arg = case mProjectName of - Nothing -> That branchName - Just projectName -> These projectName branchName - ProjectUtils.getProjectAndBranchByTheseNames arg - thePath <- case (mrelativePath, projectAndBranch) of - (Nothing, Nothing) -> - ProjectUtils.getCurrentProject >>= \case - Nothing -> pure absPath - Just project -> - Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch (project ^. #name) branchName)) - (Just (projectAndBranch0, relPath), Just (ProjectAndBranch project branch)) -> do - projectAndBranch0 <- Cli.runTransaction (ProjectUtils.expectProjectAndBranchByIds projectAndBranch0) - Cli.respondNumbered (AmbiguousReset AmbiguousReset'Hash (projectAndBranch0, relPath) (ProjectAndBranch (project ^. #name) (branch ^. #name))) - Cli.returnEarlyWithoutOutput - (Just _relativePath, Nothing) -> pure absPath - (Nothing, Just (ProjectAndBranch project branch)) -> - pure (ProjectUtils.projectBranchPath (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId))) - Cli.expectBranchAtPath' (Path.absoluteToPath' thePath) - + BranchAtPath p -> do + pp <- Cli.resolvePath' p + Cli.getBranchFromProjectPath pp + BranchAtSCH sch -> Cli.resolveShortCausalHash hash + BranchAtProjectPath pp -> Cli.getBranchFromProjectPath pp target <- case mtarget of Nothing -> Cli.getCurrentPath - Just looseCodeOrProject -> case looseCodeOrProject of - This path' -> Cli.resolvePath' path' - That (ProjectAndBranch mProjectName branchName) -> do - let arg = case mProjectName of - Nothing -> That branchName - Just projectName -> These projectName branchName - ProjectAndBranch project branch <- ProjectUtils.expectProjectAndBranchByTheseNames arg - pure (ProjectUtils.projectBranchPath (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId))) - These path' (ProjectAndBranch mProjectName branchName) -> do - absPath <- Cli.resolvePath' path' - mrelativePath <- - Cli.getMaybeBranchAt absPath <&> \case - Nothing -> Nothing - Just _ -> preview ProjectUtils.projectBranchPathPrism absPath - projectAndBranch <- do - let arg = case mProjectName of - Nothing -> That branchName - Just projectName -> These projectName branchName - ProjectUtils.getProjectAndBranchByTheseNames arg - case (mrelativePath, projectAndBranch) of - (Nothing, Nothing) -> - ProjectUtils.getCurrentProject >>= \case - Nothing -> pure absPath - Just project -> - Cli.returnEarly (LocalProjectBranchDoesntExist (ProjectAndBranch (project ^. #name) branchName)) - (Just (projectAndBranch0, relPath), Just (ProjectAndBranch project branch)) -> do - projectAndBranch0 <- Cli.runTransaction (ProjectUtils.expectProjectAndBranchByIds projectAndBranch0) - Cli.respondNumbered (AmbiguousReset AmbiguousReset'Target (projectAndBranch0, relPath) (ProjectAndBranch (project ^. #name) (branch ^. #name))) - Cli.returnEarlyWithoutOutput - (Just _relativePath, Nothing) -> pure absPath - (Nothing, Just (ProjectAndBranch project branch)) -> - pure (ProjectUtils.projectBranchPath (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId))) + Just unresolvedProjectAndBranch -> do + targetProjectAndBranch <- ProjectUtils.resolveProjectBranch (second Just unresolvedProjectAndBranch) + pure $ PP.projectBranchRoot targetProjectAndBranch description <- inputDescription input _ <- Cli.updateAt description target (const newRoot) Cli.respond Success @@ -1415,8 +1357,9 @@ doDisplay outputLoc names tm = do -- | Show todo output if there are any conflicts or edits. doShowTodoOutput :: Patch -> Path.Absolute -> Cli () doShowTodoOutput patch scopePath = do + pp <- Cli.resolvePath' (Path.AbsolutePath' scopePath) Cli.Env {codebase} <- ask - names0 <- Branch.toNames <$> Cli.getBranch0At scopePath + names0 <- Branch.toNames <$> Cli.getBranch0FromProjectPath pp todo <- Cli.runTransaction (checkTodo codebase patch names0) if TO.noConflicts todo && TO.noEdits todo then Cli.respond NoConflictsOrEdits diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index c55bd8b5d6..4f0237f732 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -117,12 +117,7 @@ data Input | PullI !PullSourceTarget !PullMode | PushRemoteBranchI PushRemoteBranchInput | ResetRootI BranchId - | ResetI - ( These - BranchId - (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) - ) - (Maybe UnresolvedProjectBranch) + | ResetI BranchId (Maybe UnresolvedProjectBranch) | -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? -- Does it make sense to fork from not-the-root of a Github repo? -- used in Welcome module to give directions to user From 18cde10b98a0e9ba26010628879c54754b9440a4 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 10 Jun 2024 14:45:57 -0700 Subject: [PATCH 143/631] WIP --- .../src/Unison/Codebase/ProjectPath.hs | 7 +- unison-cli/src/Unison/Cli/MonadUtils.hs | 5 + .../src/Unison/Codebase/Editor/HandleInput.hs | 117 ++++++++++-------- .../src/Unison/Codebase/Editor/Input.hs | 4 +- .../src/Unison/Codebase/Editor/Output.hs | 15 +-- 5 files changed, 80 insertions(+), 68 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index 2694d26b51..cdd9a4ef29 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -7,6 +7,7 @@ module Unison.Codebase.ProjectPath projectBranchRoot, absPath_, path_, + path, projectAndBranch_, toText, toIds, @@ -83,11 +84,13 @@ toText (ProjectPath proj branch path) = into @Text (proj ^. #name) <> "/" <> into @Text (branch ^. #name) <> ":" <> Path.absToText path absPath_ :: Lens' (ProjectPathG p b) Path.Absolute -absPath_ = lens go set +absPath_ = lens absPath set where - go (ProjectPath _ _ p) = p set (ProjectPath n b _) p = ProjectPath n b p +path :: (ProjectPathG p b) -> Path.Path +path (ProjectPath _ _ p) = Path.unabsolute p + path_ :: Lens' (ProjectPathG p b) Path.Path path_ = absPath_ . Path.absPath_ diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 868b7bb3ab..d49f4b964e 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -11,6 +11,7 @@ module Unison.Cli.MonadUtils getCurrentProjectPath, resolvePath, resolvePath', + resolvePath'ToAbsolute, resolveSplit', -- * Project and branch resolution @@ -187,6 +188,10 @@ resolvePath' path' = do pp <- getCurrentProjectPath pure $ pp & PP.absPath_ %~ \p -> Path.resolve p path' +resolvePath'ToAbsolute :: Path' -> Cli Path.Absolute +resolvePath'ToAbsolute path' = do + view PP.absPath_ <$> resolvePath' path' + -- | Resolve a path split, per the current path. resolveSplit' :: (Path', a) -> Cli (PP.ProjectPath, a) resolveSplit' = diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 318dc3394c..d605d67f82 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -29,8 +29,6 @@ import U.Codebase.Branch.Diff qualified as V2Branch.Diff import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Reflog qualified as Reflog -import U.Codebase.Sqlite.Project qualified as Sqlite -import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.ABT qualified as ABT import Unison.Builtin qualified as Builtin @@ -93,7 +91,6 @@ import Unison.Codebase.Editor.HandleInput.Update (doSlurpAdds, handleUpdate) import Unison.Codebase.Editor.HandleInput.Update2 (handleUpdate2) import Unison.Codebase.Editor.HandleInput.Upgrade (handleUpgrade) import Unison.Codebase.Editor.Input -import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Editor.Output.DumpNamespace qualified as Output.DN @@ -112,7 +109,7 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash qualified as SCH -import Unison.CommandLine.BranchRelativePath (BranchRelativePath) +import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..)) import Unison.CommandLine.Completion qualified as Completion import Unison.CommandLine.DisplayValues qualified as DisplayValues import Unison.CommandLine.InputPattern qualified as IP @@ -138,12 +135,10 @@ import Unison.Parser.Ann qualified as Ann import Unison.Parsers qualified as Parsers import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE -import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo, empty) import Unison.PrettyPrintEnvDecl qualified as PPED -import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Project (ProjectAndBranch (..)) -import Unison.Reference (Reference, TermReference) +import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -260,11 +255,11 @@ loop e = do BranchAtPath p -> do pp <- Cli.resolvePath' p Cli.getBranchFromProjectPath pp - BranchAtSCH sch -> Cli.resolveShortCausalHash hash + BranchAtSCH sch -> Cli.resolveShortCausalHash sch BranchAtProjectPath pp -> Cli.getBranchFromProjectPath pp target <- case mtarget of - Nothing -> Cli.getCurrentPath + Nothing -> Cli.getCurrentProjectPath Just unresolvedProjectAndBranch -> do targetProjectAndBranch <- ProjectUtils.resolveProjectBranch (second Just unresolvedProjectAndBranch) pure $ PP.projectBranchRoot targetProjectAndBranch @@ -275,11 +270,12 @@ loop e = do Cli.time "reset-root" do newRoot <- case src0 of - Left hash -> Cli.resolveShortCausalHash hash - Right path' -> Cli.expectBranchAtPath' path' + BranchAtSCH hash -> Cli.resolveShortCausalHash hash + BranchAtPath path' -> Cli.expectBranchAtPath' path' + BranchAtProjectPath pp -> Cli.getBranchFromProjectPath pp description <- inputDescription input pb <- getCurrentProjectBranch - Cli.updateAtM "reset-root" (PP.projectBranchRoot pb) newRoot description + void $ Cli.updateProjectBranchRoot_ pb description (const newRoot) Cli.respond Success ForkLocalBranchI src0 dest0 -> do (srcb, branchEmpty) <- @@ -287,8 +283,8 @@ loop e = do Left hash -> (,WhichBranchEmptyHash hash) <$> Cli.resolveShortCausalHash hash Right path' -> do srcPP <- ProjectUtils.resolveBranchRelativePath path' - srcb <- Cli.getBranchFromProjectPath srcPP `whenNothingM` pure Branch.empty - pure (srcb, WhichBranchEmptyPath srcp) + srcb <- Cli.getBranchFromProjectPath srcPP + pure (srcb, WhichBranchEmptyPath srcPP) description <- inputDescription input dest <- ProjectUtils.resolveBranchRelativePath dest0 ok <- Cli.updateAtM description dest (const $ pure srcb) @@ -297,49 +293,57 @@ loop e = do then Success else BranchEmpty branchEmpty MergeI branch -> handleMerge branch - MergeLocalBranchI unresolvedSrc unresolvedDest mergeMode -> do + MergeLocalBranchI unresolvedSrc mayUnresolvedDest mergeMode -> do description <- inputDescription input - srcPaB <- ProjectUtils.resolveProjectBranch (second Just src0) - destPaB <- ProjectUtils.resolveProjectBranch (second Just dest0) - srcBranch <- Cli.getProjectBranchRoot srcPaB.branch - let err = - Just $ - MergeAlreadyUpToDate - ((\x -> ProjectAndBranch x.project.name x.branch.name) <$> src0) - ((\x -> ProjectAndBranch x.project.name x.branch.name) <$> dest0) - mergeBranchAndPropagateDefaultPatch mergeMode description err srcb (Just dest0) dest - PreviewMergeLocalBranchI src0 dest0 -> do + srcPP <- ProjectUtils.resolveBranchRelativePath unresolvedSrc + (destPP, destBRP) <- case mayUnresolvedDest of + Nothing -> Cli.getCurrentProjectPath <&> \pp -> (pp, QualifiedBranchPath pp.project.name pp.branch.name (pp ^. PP.absPath_)) + Just unresolvedDest -> do + ProjectUtils.resolveBranchRelativePath unresolvedDest <&> \pp -> (pp, unresolvedDest) + srcBranch <- Cli.getProjectBranchRoot srcPP.branch + let err = Just $ MergeAlreadyUpToDate unresolvedSrc destBRP + mergeBranchAndPropagateDefaultPatch mergeMode description err srcBranch (Just $ Left destPP) destPP + PreviewMergeLocalBranchI unresolvedSrc mayUnresolvedDest -> do Cli.Env {codebase} <- ask - srcPaB <- ProjectUtils.resolveProjectBranch (second Just src0) - destPaB <- ProjectUtils.resolveProjectBranch (second Just dest0) - srcBranch <- Cli.getProjectBranchRoot srcPaB.branch - merged <- liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb) - if merged == destb - then Cli.respond (PreviewMergeAlreadyUpToDate src0 dest0) + srcPP <- ProjectUtils.resolveBranchRelativePath unresolvedSrc + destPP <- case mayUnresolvedDest of + Nothing -> Cli.getCurrentProjectPath + Just unresolvedDest -> do + ProjectUtils.resolveBranchRelativePath unresolvedDest + srcBranch <- Cli.getProjectBranchRoot srcPP.branch + destBranch <- Cli.getProjectBranchRoot destPP.branch + merged <- liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcBranch destBranch) + if merged == destBranch + then Cli.respond (PreviewMergeAlreadyUpToDate srcPP destPP) else do - (ppe, diff) <- diffHelper (Branch.head destb) (Branch.head merged) - Cli.respondNumbered (ShowDiffAfterMergePreview dest0 dest ppe diff) + (ppe, diff) <- diffHelper (Branch.head destBranch) (Branch.head merged) + Cli.respondNumbered (ShowDiffAfterMergePreview (Left destPP) destPP ppe diff) DiffNamespaceI before after -> do - absBefore <- traverseOf _Right Cli.resolvePath' before - absAfter <- traverseOf _Right Cli.resolvePath' after - beforeBranch0 <- Branch.head <$> Cli.resolveAbsBranchId absBefore - afterBranch0 <- Branch.head <$> Cli.resolveAbsBranchId absAfter + beforeLoc <- case before of + BranchAtSCH sch -> pure $ Left sch + BranchAtPath path' -> Right <$> Cli.resolvePath' path' + BranchAtProjectPath pp -> pure $ Right pp + afterLoc <- case after of + BranchAtSCH sch -> pure $ Left sch + BranchAtPath path' -> Right <$> Cli.resolvePath' path' + BranchAtProjectPath pp -> pure $ Right pp + beforeBranch0 <- Branch.head <$> Cli.resolveBranchId before + afterBranch0 <- Branch.head <$> Cli.resolveBranchId after case (Branch.isEmpty0 beforeBranch0, Branch.isEmpty0 afterBranch0) of - (True, True) -> Cli.returnEarly . NamespaceEmpty $ (absBefore Nel.:| [absAfter]) - (True, False) -> Cli.returnEarly . NamespaceEmpty $ (absBefore Nel.:| []) - (False, True) -> Cli.returnEarly . NamespaceEmpty $ (absAfter Nel.:| []) + (True, True) -> Cli.returnEarly . NamespaceEmpty $ (beforeLoc Nel.:| [afterLoc]) + (True, False) -> Cli.returnEarly . NamespaceEmpty $ (beforeLoc Nel.:| []) + (False, True) -> Cli.returnEarly . NamespaceEmpty $ (afterLoc Nel.:| []) (False, False) -> pure () (ppe, diff) <- diffHelper beforeBranch0 afterBranch0 - Cli.respondNumbered (ShowDiffNamespace absBefore absAfter ppe diff) + Cli.respondNumbered (ShowDiffNamespace beforeLoc afterLoc ppe diff) MoveBranchI src' dest' -> do - hasConfirmed <- confirmedCommand input description <- inputDescription input - doMoveBranch description hasConfirmed src' dest' + doMoveBranch description src' dest' SwitchBranchI path' -> do path <- Cli.resolvePath' path' branchExists <- Cli.branchExistsAtPath' path' - when (not branchExists) (Cli.respond $ CreatedNewBranch path) - Cli.cd path + when (not branchExists) (Cli.respond $ CreatedNewBranch (path ^. PP.absPath_)) + Cli.cd (path ^. PP.absPath_) UpI -> do path0 <- Cli.getCurrentPath whenJust (unsnoc path0) \(path, _) -> @@ -350,10 +354,11 @@ loop e = do HistoryI resultsCap diffCap from -> do branch <- case from of - Left hash -> Cli.resolveShortCausalHash hash - Right path' -> do + BranchAtSCH hash -> Cli.resolveShortCausalHash hash + BranchAtPath path' -> do pp <- Cli.resolvePath' path' Cli.getBranchFromProjectPath pp + BranchAtProjectPath pp -> Cli.getBranchFromProjectPath pp schLength <- Cli.runTransaction Codebase.branchHashLength history <- liftIO (doHistory schLength 0 branch []) Cli.respondNumbered history @@ -380,7 +385,7 @@ loop e = do else CantUndoPastMerge description <- inputDescription input pb <- getCurrentProjectBranch - Cli.updateProjectBranchRoot pb prev description + Cli.updateProjectBranchRoot_ pb description (const prev) (ppe, diff) <- diffHelper (Branch.head prev) (Branch.head rootBranch) Cli.respondNumbered (Output.ShowDiffAfterUndo ppe diff) UiI path' -> openUI path' @@ -425,7 +430,8 @@ loop e = do when (not (Set.null destTerms)) do Cli.returnEarly (TermAlreadyExists dest' destTerms) description <- inputDescription input - Cli.stepAt description (BranchUtil.makeAddTermName (Path.convert dest) srcTerm) + pb <- Cli.getCurrentProjectBranch + Cli.stepAt pb description (BranchUtil.makeAddTermName (Path.convert dest) srcTerm) Cli.respond Success AliasTypeI src' dest' -> do src <- traverseOf _Right Cli.resolveSplit' src' @@ -448,7 +454,8 @@ loop e = do when (not (Set.null destTypes)) do Cli.returnEarly (TypeAlreadyExists dest' destTypes) description <- inputDescription input - Cli.stepAt description (BranchUtil.makeAddTypeName (Path.convert dest) srcType) + pb <- Cli.getCurrentProjectBranch + Cli.stepAt pb description (BranchUtil.makeAddTypeName (Path.convert dest) srcType) Cli.respond Success -- this implementation will happily produce name conflicts, @@ -459,11 +466,11 @@ loop e = do destPP <- Cli.resolvePath' dest' old <- Cli.getBranch0FromProjectPath destPP description <- inputDescription input - let (unknown, actions) = foldl' (go root0 currentBranch0 destAbs) mempty srcs - Cli.stepManyAt description actions + let (unknown, actions) = foldl' (go root0 currentBranch0 (destPP ^. PP.absPath_)) mempty srcs + Cli.stepManyAt destPP.branch description actions new <- Cli.getBranch0FromProjectPath destPP (ppe, diff) <- diffHelper old new - Cli.respondNumbered (ShowDiffAfterModifyBranch dest' destAbs ppe diff) + Cli.respondNumbered (ShowDiffAfterModifyBranch dest' destPP.absPath ppe diff) when (not (null unknown)) do Cli.respond . SearchTermsNotFound . fmap fixupOutput $ unknown where @@ -472,9 +479,9 @@ loop e = do Branch0 IO -> Branch0 IO -> Path.Absolute -> - ([Path.HQSplit], [(Path, Branch0 m -> Branch0 m)]) -> + ([Path.HQSplit], [(Path.Absolute, Branch0 m -> Branch0 m)]) -> Path.HQSplit -> - ([Path.HQSplit], [(Path, Branch0 m -> Branch0 m)]) + ([Path.HQSplit], [(Path.Absolute, Branch0 m -> Branch0 m)]) go root0 currentBranch0 dest (missingSrcs, actions) hqsrc = let proposedDest :: Path.Split proposedDest = second HQ'.toName hqProposedDest diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 4f0237f732..b22e8ac024 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -111,8 +111,8 @@ data Input -- clone w/o merge, error if would clobber ForkLocalBranchI (Either ShortCausalHash BranchRelativePath) BranchRelativePath | -- merge first causal into destination - MergeLocalBranchI UnresolvedProjectBranch (Maybe UnresolvedProjectBranch) Branch.MergeMode - | PreviewMergeLocalBranchI UnresolvedProjectBranch (Maybe UnresolvedProjectBranch) + MergeLocalBranchI BranchRelativePath (Maybe BranchRelativePath) Branch.MergeMode + | PreviewMergeLocalBranchI BranchRelativePath (Maybe BranchRelativePath) | DiffNamespaceI BranchId BranchId -- old new | PullI !PullSourceTarget !PullMode | PushRemoteBranchI PushRemoteBranchInput diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 807805e301..19b282b4c4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -45,6 +45,7 @@ import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH +import Unison.CommandLine.BranchRelativePath (BranchRelativePath) import Unison.CommandLine.InputPattern qualified as Input import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.ConstructorId (ConstructorId) @@ -93,7 +94,7 @@ type NumberedArgs = [StructuredArgument] type HashLength = Int data NumberedOutput - = ShowDiffNamespace AbsBranchId AbsBranchId PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) + = ShowDiffNamespace (Either ShortCausalHash ProjectPath) (Either ShortCausalHash ProjectPath) PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterUndo PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterDeleteDefinitions PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | ShowDiffAfterDeleteBranch Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) @@ -285,14 +286,10 @@ data Output | AboutToMerge | -- | Indicates a trivial merge where the destination was empty and was just replaced. MergeOverEmpty (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) - | MergeAlreadyUpToDate - (Either Path' (ProjectAndBranch ProjectName ProjectBranchName)) - (Either Path' (ProjectAndBranch ProjectName ProjectBranchName)) + | MergeAlreadyUpToDate BranchRelativePath BranchRelativePath | -- This will replace the above once `merge.old` is deleted MergeAlreadyUpToDate2 !MergeSourceAndTarget - | PreviewMergeAlreadyUpToDate - (Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) - (Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) + | PreviewMergeAlreadyUpToDate ProjectPath ProjectPath | -- | No conflicts or edits remain for the current patch. NoConflictsOrEdits | NotImplemented @@ -306,7 +303,7 @@ data Output | BadName Text | CouldntLoadBranch CausalHash | HelpMessage Input.InputPattern - | NamespaceEmpty (NonEmpty AbsBranchId) + | NamespaceEmpty (NonEmpty (Either ShortCausalHash ProjectPath)) | NoOp | -- | @GistCreated repo@ means a causal was just published to @repo@. GistCreated (ReadRemoteNamespace Void) @@ -423,7 +420,7 @@ data CreatedProjectBranchFrom -- | A branch was empty. But how do we refer to that branch? data WhichBranchEmpty = WhichBranchEmptyHash ShortCausalHash - | WhichBranchEmptyPath (Either ProjectPath Path') + | WhichBranchEmptyPath ProjectPath data ShareError = ShareErrorDownloadEntities Share.DownloadEntitiesError From 8138e61a2a0c1b35086fb7436fdd61026deb8bd0 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 10 Jun 2024 15:39:30 -0700 Subject: [PATCH 144/631] toText and output munging --- .../src/Unison/Codebase/Path.hs | 13 ++ .../src/Unison/Codebase/ProjectPath.hs | 9 +- unison-cli/src/Unison/Cli/Pretty.hs | 10 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 188 +++++++++--------- .../HandleInput/NamespaceDependencies.hs | 2 +- .../src/Unison/Codebase/Editor/Input.hs | 6 + .../Unison/CommandLine/BranchRelativePath.hs | 8 + .../src/Unison/CommandLine/InputPatterns.hs | 25 +-- .../src/Unison/CommandLine/OutputMessages.hs | 14 +- 9 files changed, 151 insertions(+), 124 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Path.hs b/parser-typechecker/src/Unison/Codebase/Path.hs index 0a335ac240..ee13e1d124 100644 --- a/parser-typechecker/src/Unison/Codebase/Path.hs +++ b/parser-typechecker/src/Unison/Codebase/Path.hs @@ -32,6 +32,7 @@ module Unison.Codebase.Path prefixNameIfRel, unprefixName, HQSplit, + HQSplitAbsolute, AbsSplit, Split, Split', @@ -390,6 +391,18 @@ empty = Path mempty instance Show Path where show = Text.unpack . toText +instance From Path Text where + from = toText + +instance From Absolute Text where + from = absToText + +instance From Relative Text where + from = relToText + +instance From Path' Text where + from = toText' + -- | Note: This treats the path as relative. toText :: Path -> Text toText = diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index cdd9a4ef29..55d481794d 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -18,7 +18,7 @@ module Unison.Codebase.ProjectPath ) where -import Control.Lens +import Control.Lens hiding (from) import Data.Bifoldable (Bifoldable (..)) import Data.Bitraversable (Bitraversable (..)) import Data.Text qualified as Text @@ -44,10 +44,17 @@ type ProjectPathIds = ProjectPathG ProjectId ProjectBranchId type ProjectPathNames = ProjectPathG ProjectName ProjectBranchName +instance From ProjectPath Text where + from = from . toNames + instance From ProjectPathNames Text where from (ProjectPath proj branch path) = into @Text (ProjectAndBranch proj branch) <> ":" <> Path.absToText path +instance From (ProjectPathG () ProjectBranchName) Text where + from (ProjectPath () branch path) = + "/" <> into @Text branch <> ":" <> Path.absToText path + type ProjectPath = ProjectPathG Project ProjectBranch projectBranchRoot :: ProjectAndBranch Project ProjectBranch -> ProjectPath diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index 7052e7b87d..ac56a7d644 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -6,6 +6,7 @@ module Unison.Cli.Pretty ( displayBranchHash, prettyAbsolute, prettyProjectPath, + prettyBranchRelativePath, prettyBase32Hex#, prettyBase32Hex, prettyBranchId, @@ -80,6 +81,7 @@ import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH +import Unison.CommandLine.BranchRelativePath (BranchRelativePath) import Unison.Core.Project (ProjectBranchName) import Unison.DataDeclaration qualified as DD import Unison.Debug qualified as Debug @@ -260,6 +262,9 @@ prettyProjectAndBranchName :: ProjectAndBranch ProjectName ProjectBranchName -> prettyProjectAndBranchName (ProjectAndBranch project branch) = P.group (prettyProjectName project <> P.hiBlack "/" <> prettyProjectBranchName branch) +prettyBranchRelativePath :: BranchRelativePath -> Pretty +prettyBranchRelativePath = P.blue . P.text . into @Text + -- produces: -- -- #5v5UtREE1fTiyTsTK2zJ1YNqfiF25SkfUnnji86Lms#0 -- Optional.None, Maybe.Nothing : Maybe a @@ -332,10 +337,7 @@ prettyTypeName ppe r = prettyWhichBranchEmpty :: WhichBranchEmpty -> Pretty prettyWhichBranchEmpty = \case WhichBranchEmptyHash hash -> P.shown hash - WhichBranchEmptyPath p -> - case p of - Left pp -> prettyProjectPath pp - Right path' -> prettyPath' path' + WhichBranchEmptyPath pp -> prettyProjectPath pp -- | Displays a full, non-truncated Branch.CausalHash to a string, e.g. #abcdef displayBranchHash :: CausalHash -> Text diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index d605d67f82..220665ab67 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -21,7 +21,6 @@ import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) import Data.Set.NonEmpty qualified as NESet import Data.Text qualified as Text -import Data.These (These (..)) import Data.Time (UTCTime) import Data.Tuple.Extra (uncurry3) import Text.Megaparsec qualified as Megaparsec @@ -137,7 +136,6 @@ import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo, empty) import Unison.PrettyPrintEnvDecl qualified as PPED -import Unison.Project (ProjectAndBranch (..)) import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) @@ -297,7 +295,7 @@ loop e = do description <- inputDescription input srcPP <- ProjectUtils.resolveBranchRelativePath unresolvedSrc (destPP, destBRP) <- case mayUnresolvedDest of - Nothing -> Cli.getCurrentProjectPath <&> \pp -> (pp, QualifiedBranchPath pp.project.name pp.branch.name (pp ^. PP.absPath_)) + Nothing -> Cli.getCurrentProjectPath <&> \pp -> (pp, QualifiedBranchPath (pp ^. #project . #name) (pp ^. #branch . #name) (pp ^. PP.absPath_)) Just unresolvedDest -> do ProjectUtils.resolveBranchRelativePath unresolvedDest <&> \pp -> (pp, unresolvedDest) srcBranch <- Cli.getProjectBranchRoot srcPP.branch @@ -431,7 +429,7 @@ loop e = do Cli.returnEarly (TermAlreadyExists dest' destTerms) description <- inputDescription input pb <- Cli.getCurrentProjectBranch - Cli.stepAt pb description (BranchUtil.makeAddTermName (Path.convert dest) srcTerm) + Cli.stepAt pb description (BranchUtil.makeAddTermName (first PP.absPath dest) srcTerm) Cli.respond Success AliasTypeI src' dest' -> do src <- traverseOf _Right Cli.resolveSplit' src' @@ -455,7 +453,7 @@ loop e = do Cli.returnEarly (TypeAlreadyExists dest' destTypes) description <- inputDescription input pb <- Cli.getCurrentProjectBranch - Cli.stepAt pb description (BranchUtil.makeAddTypeName (Path.convert dest) srcType) + Cli.stepAt pb description (BranchUtil.makeAddTypeName (first PP.absPath dest) srcType) Cli.respond Success -- this implementation will happily produce name conflicts, @@ -466,11 +464,11 @@ loop e = do destPP <- Cli.resolvePath' dest' old <- Cli.getBranch0FromProjectPath destPP description <- inputDescription input - let (unknown, actions) = foldl' (go root0 currentBranch0 (destPP ^. PP.absPath_)) mempty srcs + let (unknown, actions) = foldl' (go root0 currentBranch0 (PP.absPath destPP)) mempty srcs Cli.stepManyAt destPP.branch description actions new <- Cli.getBranch0FromProjectPath destPP (ppe, diff) <- diffHelper old new - Cli.respondNumbered (ShowDiffAfterModifyBranch dest' destPP.absPath ppe diff) + Cli.respondNumbered (ShowDiffAfterModifyBranch dest' (destPP.absPath) ppe diff) when (not (null unknown)) do Cli.respond . SearchTermsNotFound . fmap fixupOutput $ unknown where @@ -483,24 +481,25 @@ loop e = do Path.HQSplit -> ([Path.HQSplit], [(Path.Absolute, Branch0 m -> Branch0 m)]) go root0 currentBranch0 dest (missingSrcs, actions) hqsrc = - let proposedDest :: Path.Split + let proposedDest :: Path.AbsSplit proposedDest = second HQ'.toName hqProposedDest - hqProposedDest :: Path.HQSplit - hqProposedDest = first Path.unabsolute $ Path.resolve dest hqsrc + hqProposedDest :: Path.HQSplitAbsolute + hqProposedDest = Path.resolve dest hqsrc -- `Nothing` if src doesn't exist - doType :: Maybe [(Path, Branch0 m -> Branch0 m)] + doType :: Maybe [(Path.Absolute, Branch0 m -> Branch0 m)] doType = case ( BranchUtil.getType hqsrc currentBranch0, - BranchUtil.getType hqProposedDest root0 + BranchUtil.getType (first Path.unabsolute hqProposedDest) root0 ) of (null -> True, _) -> Nothing -- missing src (rsrcs, existing) -> -- happy path Just . map addAlias . toList $ Set.difference rsrcs existing where + addAlias :: Reference -> (Path.Absolute, Branch0 m -> Branch0 m) addAlias r = BranchUtil.makeAddTypeName proposedDest r - doTerm :: Maybe [(Path, Branch0 m -> Branch0 m)] + doTerm :: Maybe [(Path.Absolute, Branch0 m -> Branch0 m)] doTerm = case ( BranchUtil.getTerm hqsrc currentBranch0, - BranchUtil.getTerm hqProposedDest root0 + BranchUtil.getTerm (first Path.unabsolute hqProposedDest) root0 ) of (null -> True, _) -> Nothing -- missing src (rsrcs, existing) -> @@ -550,11 +549,13 @@ loop e = do authorPath <- Cli.resolveSplit' authorPath' copyrightHolderPath <- Cli.resolveSplit' (base |> NameSegment.copyrightHoldersSegment |> authorNameSegment) guidPath <- Cli.resolveSplit' (authorPath' |> NameSegment.guidSegment) + pb <- Cli.getCurrentProjectBranch Cli.stepManyAt + pb description - [ BranchUtil.makeAddTermName (Path.convert authorPath) (d authorRef), - BranchUtil.makeAddTermName (Path.convert copyrightHolderPath) (d copyrightHolderRef), - BranchUtil.makeAddTermName (Path.convert guidPath) (d guidRef) + [ BranchUtil.makeAddTermName (first PP.absPath authorPath) (d authorRef), + BranchUtil.makeAddTermName (first PP.absPath copyrightHolderPath) (d copyrightHolderRef), + BranchUtil.makeAddTermName (first PP.absPath guidPath) (d guidRef) ] currentPath <- Cli.getCurrentPath finalBranch <- Cli.getCurrentBranch0 @@ -574,61 +575,56 @@ loop e = do MoveTermI src' dest' -> doMoveTerm src' dest' =<< inputDescription input MoveTypeI src' dest' -> doMoveType src' dest' =<< inputDescription input MoveAllI src' dest' -> do - hasConfirmed <- confirmedCommand input desc <- inputDescription input - handleMoveAll hasConfirmed src' dest' desc - DeleteI dtarget -> case dtarget of - DeleteTarget'TermOrType doutput hqs -> delete input doutput Cli.getTermsAt Cli.getTypesAt hqs - DeleteTarget'Type doutput hqs -> delete input doutput (const (pure Set.empty)) Cli.getTypesAt hqs - DeleteTarget'Term doutput hqs -> delete input doutput Cli.getTermsAt (const (pure Set.empty)) hqs - DeleteTarget'Namespace insistence Nothing -> do - hasConfirmed <- confirmedCommand input - if hasConfirmed || insistence == Force - then do - description <- inputDescription input - pb <- Cli.getCurrentProjectBranch - Cli.updateProjectBranchRoot pb Branch.empty description - Cli.respond DeletedEverything - else Cli.respond DeleteEverythingConfirmation - DeleteTarget'Namespace insistence (Just p@(parentPath, childName)) -> do - branch <- Cli.expectBranchAtPath (Path.unsplit p) - description <- inputDescription input - let toDelete = - Names.prefix0 - (Path.unsafeToName (Path.unsplit (p))) - (Branch.toNames (Branch.head branch)) - afterDelete <- do - names <- Cli.currentNames - endangerments <- Cli.runTransaction (getEndangeredDependents toDelete Set.empty names) - case (null endangerments, insistence) of - (True, _) -> pure (Cli.respond Success) - (False, Force) -> do - ppeDecl <- Cli.currentPrettyPrintEnvDecl - pure do - Cli.respond Success - Cli.respondNumbered $ DeletedDespiteDependents ppeDecl endangerments - (False, Try) -> do - ppeDecl <- Cli.currentPrettyPrintEnvDecl - Cli.respondNumbered $ CantDeleteNamespace ppeDecl endangerments - Cli.returnEarlyWithoutOutput - parentPathAbs <- Cli.resolvePath parentPath - -- We have to modify the parent in order to also wipe out the history at the - -- child. - Cli.updateAt description parentPathAbs \parentBranch -> - parentBranch - & Branch.modifyAt (Path.singleton childName) \_ -> Branch.empty - afterDelete - DeleteTarget'ProjectBranch name -> handleDeleteBranch name - DeleteTarget'Project name -> handleDeleteProject name + handleMoveAll src' dest' desc + DeleteI dtarget -> do + pp <- Cli.getCurrentProjectPath + let getTerms (absPath, seg) = Cli.getTermsAt (set PP.absPath_ absPath pp, seg) + let getTypes (absPath, seg) = Cli.getTypesAt (set PP.absPath_ absPath pp, seg) + case dtarget of + DeleteTarget'TermOrType doutput hqs -> do + delete input doutput getTerms getTypes hqs + DeleteTarget'Type doutput hqs -> delete input doutput (const (pure Set.empty)) getTypes hqs + DeleteTarget'Term doutput hqs -> delete input doutput getTerms (const (pure Set.empty)) hqs + DeleteTarget'Namespace insistence p@(parentPath, childName) -> do + branch <- Cli.expectBranchAtPath (Path.unsplit p) + description <- inputDescription input + let toDelete = + Names.prefix0 + (Path.unsafeToName (Path.unsplit (p))) + (Branch.toNames (Branch.head branch)) + afterDelete <- do + names <- Cli.currentNames + endangerments <- Cli.runTransaction (getEndangeredDependents toDelete Set.empty names) + case (null endangerments, insistence) of + (True, _) -> pure (Cli.respond Success) + (False, Force) -> do + ppeDecl <- Cli.currentPrettyPrintEnvDecl + pure do + Cli.respond Success + Cli.respondNumbered $ DeletedDespiteDependents ppeDecl endangerments + (False, Try) -> do + ppeDecl <- Cli.currentPrettyPrintEnvDecl + Cli.respondNumbered $ CantDeleteNamespace ppeDecl endangerments + Cli.returnEarlyWithoutOutput + parentPathAbs <- Cli.resolvePath parentPath + -- We have to modify the parent in order to also wipe out the history at the + -- child. + Cli.updateAt description parentPathAbs \parentBranch -> + parentBranch + & Branch.modifyAt (Path.singleton childName) \_ -> Branch.empty + afterDelete + DeleteTarget'ProjectBranch name -> handleDeleteBranch name + DeleteTarget'Project name -> handleDeleteProject name DisplayI outputLoc namesToDisplay -> do traverse_ (displayI outputLoc) namesToDisplay ShowDefinitionI outputLoc showDefinitionScope query -> handleShowDefinition outputLoc showDefinitionScope query EditNamespaceI paths -> handleEditNamespace LatestFileLocation paths FindShallowI pathArg -> do Cli.Env {codebase} <- ask - - pathArgAbs <- Cli.resolvePath' pathArg - entries <- liftIO (Backend.lsAtPath codebase Nothing pathArgAbs) + pp <- Cli.resolvePath' pathArg + projectRootBranch <- Cli.runTransaction $ Codebase.expectShallowProjectBranchRoot pp.branch + entries <- liftIO (Backend.lsAtPath codebase projectRootBranch (pp.absPath)) Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArg) entries pped <- Cli.currentPrettyPrintEnvDecl let suffixifiedPPE = PPED.suffixifiedPPE pped @@ -654,7 +650,8 @@ loop e = do let sr = Slurp.slurpFile uf vars Slurp.AddOp currentNames let adds = SlurpResult.adds sr Cli.runTransaction . Codebase.addDefsToCodebase codebase . SlurpResult.filterUnisonFile sr $ uf - Cli.stepAt description (Path.unabsolute currentPath, doSlurpAdds adds uf) + pb <- getCurrentProjectBranch + Cli.stepAt pb description (currentPath, doSlurpAdds adds uf) pped <- Cli.prettyPrintEnvDeclFromNames $ UF.addNamesFromTypeCheckedUnisonFile uf currentNames let suffixifiedPPE = PPED.suffixifiedPPE pped Cli.respond $ SlurpOutput input suffixifiedPPE sr @@ -677,8 +674,8 @@ loop e = do previewResponse sourceName sr uf TodoI patchPath branchPath' -> do patch <- Cli.getPatchAt (fromMaybe Cli.defaultPatchPath patchPath) - branchPath <- Cli.resolvePath' branchPath' - doShowTodoOutput patch branchPath + pp <- Cli.resolvePath' branchPath' + doShowTodoOutput patch pp.absPath TestI testInput -> Tests.handleTest testInput ExecuteI main args -> handleRun False main args MakeStandaloneI output main -> doCompile False output main @@ -710,7 +707,8 @@ loop e = do let destPath = case opath of Just path -> Path.resolve currentPath (Path.Relative path) Nothing -> currentPath `snoc` NameSegment.builtinSegment - _ <- Cli.updateAtM description destPath \destb -> + pp <- set PP.absPath_ destPath <$> Cli.getCurrentProjectPath + _ <- Cli.updateAtM description pp \destb -> liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb) Cli.respond Success MergeIOBuiltinsI opath -> do @@ -737,7 +735,8 @@ loop e = do let destPath = case opath of Just path -> Path.resolve currentPath (Path.Relative path) Nothing -> currentPath `snoc` NameSegment.builtinSegment - _ <- Cli.updateAtM description destPath \destb -> + pp <- set PP.absPath_ destPath <$> Cli.getCurrentProjectPath + _ <- Cli.updateAtM description pp \destb -> liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb) Cli.respond Success PullI sourceTarget pullMode -> handlePull sourceTarget pullMode @@ -887,7 +886,7 @@ loop e = do Cli.respond $ PrintVersion ucmVersion ProjectRenameI name -> handleProjectRename name ProjectSwitchI name -> projectSwitch name - ProjectCreateI tryDownloadingBase name -> projectCreate tryDownloadingBase name + ProjectCreateI tryDownloadingBase name -> void $ projectCreate tryDownloadingBase name ProjectsI -> handleProjects BranchI source name -> handleBranch source name BranchRenameI name -> handleBranchRename name @@ -907,8 +906,8 @@ inputDescription input = dest <- brp dest0 pure ("fork " <> src <> " " <> dest) MergeLocalBranchI src0 dest0 mode -> do - src <- looseCodeOrProjectToText src0 - dest <- looseCodeOrProjectToText dest0 + let src = into @Text src0 + let dest = maybe "" (into @Text) dest0 let command = case mode of Branch.RegularMerge -> "merge" @@ -916,17 +915,17 @@ inputDescription input = pure (command <> " " <> src <> " " <> dest) ResetI hash tgt -> do hashTxt <- case hash of - This hash -> hp' hash - That pr -> pure (into @Text pr) - These hash _pr -> hp' hash + BranchAtSCH hash -> hp' $ Left hash + BranchAtPath pr -> pure $ into @Text pr + BranchAtProjectPath pp -> pure $ into @Text pp tgt <- case tgt of Nothing -> pure "" Just tgt -> do - tgt <- looseCodeOrProjectToText tgt - pure (" " <> tgt) + let tgtText = into @Text tgt + pure (" " <> tgtText) pure ("reset " <> hashTxt <> tgt) ResetRootI src0 -> do - src <- hp' src0 + let src = into @Text src0 pure ("reset-root " <> src) AliasTermI src0 dest0 -> do src <- hhqs' src0 @@ -977,10 +976,10 @@ inputDescription input = thing <- traverse hqs' thing0 pure ("delete.type.verbose " <> Text.intercalate " " thing) DeleteTarget'Namespace Try opath0 -> do - opath <- ops opath0 + opath <- ps opath0 pure ("delete.namespace " <> opath) DeleteTarget'Namespace Force opath0 -> do - opath <- ops opath0 + opath <- ps opath0 pure ("delete.namespace.force " <> opath) DeleteTarget'ProjectBranch _ -> wat DeleteTarget'Project _ -> wat @@ -1081,9 +1080,7 @@ inputDescription input = p' :: Path' -> Cli Text p' = fmap tShow . Cli.resolvePath' brp :: BranchRelativePath -> Cli Text - brp = fmap from . ProjectUtils.resolveBranchRelativePath - ops :: Maybe Path.Split -> Cli Text - ops = maybe (pure ".") ps + brp = fmap (into @Text) . ProjectUtils.resolveBranchRelativePath wat = error $ show input ++ " is not expected to alter the branch" hhqs' :: Either SH.ShortHash Path.HQSplit' -> Cli Text hhqs' = \case @@ -1096,10 +1093,6 @@ inputDescription input = hqs (p, hq) = hqs' (Path' . Right . Path.Relative $ p, hq) ps' = p' . Path.unsplit' ps = p . Path.unsplit - unresolvedProjectBranchText :: UnresolvedProjectBranch -> Cli Text - unresolvedProjectBranchText (ProjectAndBranch mayProjName pbName) = case mayProjName of - Nothing -> pure $ into @Text pbName - Just projName -> into @Text $ ProjectAndBranch projName pbName handleFindI :: Bool -> @@ -1414,11 +1407,6 @@ checkTodo codebase patch names0 = do edited :: Set Reference edited = R.dom (Patch._termEdits patch) <> R.dom (Patch._typeEdits patch) -confirmedCommand :: Input -> Cli Bool -confirmedCommand i = do - loopState <- State.get - pure $ Just i == (loopState ^. #lastInput) - -- return `name` and `name....` _searchBranchPrefix :: Branch m -> Name -> [SearchResult] _searchBranchPrefix b n = case Path.unsnoc (Path.fromName n) of @@ -1531,8 +1519,8 @@ delete input doutput getTerms getTypes hqs' = do traverse ( \hq -> do absolute <- Cli.resolveSplit' hq - types <- getTypes absolute - terms <- getTerms absolute + types <- getTypes ( first PP.absPath absolute) + terms <- getTerms( first PP.absPath absolute) return (hq, types, terms) ) hqs' @@ -1551,10 +1539,11 @@ checkDeletes :: [(Path.HQSplit', Set Reference, Set Referent)] -> DeleteOutput - checkDeletes typesTermsTuples doutput inputs = do let toSplitName :: (Path.HQSplit', Set Reference, Set Referent) -> - Cli (Path.Split, Name, Set Reference, Set Referent) + Cli (Path.AbsSplit, Name, Set Reference, Set Referent) toSplitName hq = do - resolvedPath <- Path.convert <$> Cli.resolveSplit' (HQ'.toName <$> hq ^. _1) - return (resolvedPath, Path.unsafeToName (Path.unsplit resolvedPath), hq ^. _2, hq ^. _3) + (pp, ns) <- Cli.resolveSplit' (HQ'.toName <$> hq ^. _1) + let resolvedSplit = (pp.absPath, ns) + return (resolvedSplit, Path.unsafeToName (Path.unsplit (first Path.unabsolute resolvedSplit)), hq ^. _2, hq ^. _3) -- get the splits and names with terms and types splitsNames <- traverse toSplitName typesTermsTuples let toRel :: (Ord ref) => Set ref -> Name -> R.Relation Name ref @@ -1585,7 +1574,8 @@ checkDeletes typesTermsTuples doutput inputs = do ) before <- Cli.getCurrentBranch0 description <- inputDescription inputs - Cli.stepManyAt description deleteTypesTerms + pb <- Cli.getCurrentProjectBranch + Cli.stepManyAt pb description deleteTypesTerms case doutput of DeleteOutput'Diff -> do after <- Cli.getCurrentBranch0 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs index 66f3f0c3af..aa35d39dde 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs @@ -37,7 +37,7 @@ handleNamespaceDependencies namespacePath' = do let pb = pp ^. #branch branch <- Cli.getMaybeBranch0FromProjectPath pp & onNothingM do - Cli.returnEarly (Output.BranchEmpty (Output.WhichBranchEmptyPath (Left pp))) + Cli.returnEarly (Output.BranchEmpty (Output.WhichBranchEmptyPath pp)) externalDependencies <- Cli.runTransaction (namespaceDependencies codebase branch) pped <- Cli.projectBranchPPED pb diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index b22e8ac024..0c69480733 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -68,6 +68,12 @@ data BranchIdG p | BranchAtProjectPath ProjectPath deriving stock (Eq, Show, Functor, Foldable, Traversable) +instance From p Text => From (BranchIdG p) Text where + from = \case + BranchAtSCH h -> "#" <> SCH.toText h + BranchAtPath p -> from p + BranchAtProjectPath pp -> from pp + type BranchId = BranchIdG Path' type AbsBranchId = BranchIdG Path.Absolute diff --git a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs index 65942f5db9..06a71a19ae 100644 --- a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs +++ b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs @@ -4,6 +4,7 @@ module Unison.CommandLine.BranchRelativePath branchRelativePathParser, parseIncrementalBranchRelativePath, IncrementalBranchRelativePath (..), + toText, ) where @@ -15,6 +16,7 @@ import Text.Megaparsec qualified as Megaparsec import Text.Megaparsec.Char qualified as Megaparsec import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path +import Unison.Codebase.ProjectPath (ProjectPathG (..)) import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Project qualified as Project @@ -233,3 +235,9 @@ branchRelativePathParser = pure $ QualifiedBranchPath projName branchName (fromMaybe Path.absoluteEmpty mpath) Right branch -> pure $ BranchPathInCurrentProject branch (fromMaybe Path.absoluteEmpty mpath) + +toText :: BranchRelativePath -> Text +toText = \case + BranchPathInCurrentProject pbName absPath -> ProjectPath () pbName absPath & into @Text + QualifiedBranchPath projName pbName absPath -> ProjectPath projName pbName absPath & into @Text + UnqualifiedPath path' -> Path.toText' path' diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index f86714404e..cfe8604134 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -493,10 +493,11 @@ handleBranchIdArg = SA.Namespace hash -> pure . BranchAtSCH $ SCH.fromFullHash hash otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg -handleBranchIdOrProjectArg :: +-- | TODO: Maybe remove? +_handleBranchIdOrProjectArg :: I.Argument -> Either (P.Pretty CT.ColorText) (These Input.BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)) -handleBranchIdOrProjectArg = +_handleBranchIdOrProjectArg = either (maybe (Left $ P.text "Expected a branch or project, but it’s not") pure . branchIdOrProject) \case @@ -1631,8 +1632,8 @@ reset = ] ) \case - [arg0] -> Input.ResetI <$> handleBranchIdOrProjectArg arg0 <*> pure Nothing - [arg0, arg1] -> Input.ResetI <$> handleBranchIdOrProjectArg arg0 <*> fmap pure (handleMaybeProjectBranchArg arg1) + [arg0] -> Input.ResetI <$> handleBranchIdArg arg0 <*> pure Nothing + [arg0, arg1] -> Input.ResetI <$> handleBranchIdArg arg0 <*> fmap pure (handleMaybeProjectBranchArg arg1) _ -> Left $ I.help reset where config = @@ -2036,13 +2037,13 @@ mergeOldSquashInputPattern = parse = \case [src] -> Input.MergeLocalBranchI - <$> handleMaybeProjectBranchArg src + <$> handleBranchRelativePathArg src <*> pure Nothing <*> pure Branch.SquashMerge [src, dest] -> Input.MergeLocalBranchI - <$> handleMaybeProjectBranchArg src - <*> (Just <$> handleMaybeProjectBranchArg dest) + <$> handleBranchRelativePathArg src + <*> (Just <$> handleBranchRelativePathArg dest) <*> pure Branch.SquashMerge _ -> Left $ I.help mergeOldSquashInputPattern } @@ -2081,13 +2082,13 @@ mergeOldInputPattern = ( \case [src] -> Input.MergeLocalBranchI - <$> handleMaybeProjectBranchArg src + <$> handleBranchRelativePathArg src <*> pure Nothing <*> pure Branch.RegularMerge [src, dest] -> Input.MergeLocalBranchI - <$> handleMaybeProjectBranchArg src - <*> (Just <$> handleMaybeProjectBranchArg dest) + <$> handleBranchRelativePathArg src + <*> (Just <$> handleBranchRelativePathArg dest) <*> pure Branch.RegularMerge _ -> Left $ I.help mergeOldInputPattern ) @@ -2170,9 +2171,9 @@ mergeOldPreviewInputPattern = ] ) ( \case - [src] -> Input.PreviewMergeLocalBranchI <$> handleMaybeProjectBranchArg src <*> pure Nothing + [src] -> Input.PreviewMergeLocalBranchI <$> handleBranchRelativePathArg src <*> pure Nothing [src, dest] -> - Input.PreviewMergeLocalBranchI <$> handleMaybeProjectBranchArg src <*> (Just <$> handleMaybeProjectBranchArg dest) + Input.PreviewMergeLocalBranchI <$> handleBranchRelativePathArg src <*> (Just <$> handleBranchRelativePathArg dest) _ -> Left $ I.help mergeOldPreviewInputPattern ) where diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index f58aa7458d..07439565a6 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -170,7 +170,7 @@ renderFileName dir = P.group . P.blue . fromString <$> shortenDirectory dir notifyNumbered :: NumberedOutput -> (Pretty, NumberedArgs) notifyNumbered = \case ShowDiffNamespace oldPrefix newPrefix ppe diffOutput -> - showDiffNamespace ShowNumbers ppe oldPrefix newPrefix diffOutput + showDiffNamespace ShowNumbers ppe (either BranchAtSCH BranchAtProjectPath oldPrefix) (either BranchAtSCH BranchAtProjectPath newPrefix) diffOutput ShowDiffAfterDeleteDefinitions ppe diff -> first ( \p -> @@ -577,13 +577,13 @@ notifyUser dir = \case pure . P.warnCallout $ "The namespace " - <> prettyBranchId p0 + <> either prettySCH prettyProjectPath p0 <> " is empty. Was there a typo?" ps -> pure . P.warnCallout $ "The namespaces " - <> P.commas (prettyBranchId <$> ps) + <> P.commas (either prettySCH prettyProjectPath <$> ps) <> " are empty. Was there a typo?" LoadPullRequest baseNS headNS basePath headPath mergedPath squashedPath -> pure $ @@ -1327,9 +1327,9 @@ notifyUser dir = \case MergeAlreadyUpToDate src dest -> pure . P.callout "😶" $ P.wrap $ - either prettyPath' prettyProjectAndBranchName dest + prettyBranchRelativePath dest <> "was already up-to-date with" - <> P.group (either prettyPath' prettyProjectAndBranchName src <> ".") + <> P.group (prettyBranchRelativePath src <> ".") MergeAlreadyUpToDate2 aliceAndBob -> pure . P.callout "😶" $ P.wrap $ @@ -1471,9 +1471,9 @@ notifyUser dir = \case PreviewMergeAlreadyUpToDate src dest -> pure . P.callout "😶" $ P.wrap $ - prettyNamespaceKey dest + prettyProjectPath dest <> "is already up-to-date with" - <> P.group (prettyNamespaceKey src <> ".") + <> P.group (prettyProjectPath src) DumpNumberedArgs schLength args -> pure . P.numberedList $ fmap (P.text . IP.formatStructuredArgument (pure schLength)) args NoConflictsOrEdits -> From a45fc88fb1a7fd3d00d7fc6b16ece53dcc386d07 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Mon, 10 Jun 2024 20:42:01 -0400 Subject: [PATCH 145/631] Update merge precondition message: Conflicted aliases (#5070) --- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 1 + unison-src/transcripts/merge.output.md | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 84da282537..98c9bdb271 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1372,6 +1372,7 @@ notifyUser dir = \case <> "or" <> IP.makeExample' IP.delete <> "all but one of the definitions; I'll use the remaining name when propagating updates." + <> "(You can `rename` it back after the merge.)" ) ] ) diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 2d977ae507..b77752a7ba 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -976,7 +976,8 @@ project/alice> merge /bob * `update` the definitions to be the same again, so that there's nothing for me to decide. * `move` or `delete` all but one of the definitions; I'll - use the remaining name when propagating updates. + use the remaining name when propagating updates. (You can + `rename` it back after the merge.) and then try merging again. From 335512e331339cd496db97b6d3bead1efc090f42 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Tue, 11 Jun 2024 09:40:43 -0400 Subject: [PATCH 146/631] fix conflicted alias message 2 (#5071) Co-authored-by: aryairani --- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 4 +++- unison-src/transcripts/merge.output.md | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 98c9bdb271..76355438a9 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1372,7 +1372,9 @@ notifyUser dir = \case <> "or" <> IP.makeExample' IP.delete <> "all but one of the definitions; I'll use the remaining name when propagating updates." - <> "(You can `rename` it back after the merge.)" + <> "(You can" + <> IP.makeExample' IP.moveAll + <> "it back after the merge.)" ) ] ) diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index b77752a7ba..f1ba873f05 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -977,7 +977,7 @@ project/alice> merge /bob there's nothing for me to decide. * `move` or `delete` all but one of the definitions; I'll use the remaining name when propagating updates. (You can - `rename` it back after the merge.) + `move` it back after the merge.) and then try merging again. From 48371c021f51239c93c2f98875819f5f6efaf138 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 10 Jun 2024 16:33:16 -0700 Subject: [PATCH 147/631] Propagate ProjectPath into CLI Main --- parser-typechecker/src/Unison/Codebase.hs | 6 +-- .../src/Unison/Codebase/ProjectPath.hs | 11 ++-- unison-cli/src/Unison/Cli/MonadUtils.hs | 4 +- .../Codebase/Editor/HandleInput/Pull.hs | 6 +-- unison-cli/src/Unison/CommandLine/Main.hs | 52 +++++++++---------- unison-cli/src/Unison/LSP/UCMWorker.hs | 2 +- 6 files changed, 38 insertions(+), 43 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 91d6275d76..fff9c74571 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -229,8 +229,8 @@ getShallowProjectRootByNames (ProjectAndBranch projectName branchName) = runMayb causalHash <- lift $ Q.expectCausalHash causalHashId lift $ Operations.expectCausalBranchByCausalHash causalHash -expectProjectBranchRoot :: (MonadIO m) => Codebase m v a -> ProjectBranch -> m (Branch m) -expectProjectBranchRoot codebase ProjectBranch {projectId, branchId} = do +expectProjectBranchRoot :: (MonadIO m) => Codebase m v a -> Db.ProjectId -> Db.ProjectBranchId -> m (Branch m) +expectProjectBranchRoot codebase projectId branchId = do causalHash <- runTransaction codebase $ do causalHashId <- Q.expectProjectBranchHead projectId branchId Q.expectCausalHash causalHashId @@ -254,7 +254,7 @@ getBranchAtProjectPath :: PP.ProjectPath -> m (Maybe (Branch m)) getBranchAtProjectPath codebase pp = runMaybeT do - rootBranch <- lift $ expectProjectBranchRoot codebase (pp ^. #branch) + rootBranch <- lift $ expectProjectBranchRoot codebase pp.branch.projectId pp.branch.branchId hoistMaybe $ Branch.getAt (pp ^. PP.path_) rootBranch -- | Like 'getBranchForHash', but for when the hash is known to be in the codebase. diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index 55d481794d..fed28739b2 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -8,11 +8,11 @@ module Unison.Codebase.ProjectPath absPath_, path_, path, + toProjectAndBranch, projectAndBranch_, toText, toIds, toNames, - asProjectAndBranch_, projectPathParser, parseProjectPath, ) @@ -71,11 +71,8 @@ toIds (ProjectPath proj branch path) = ProjectPath (proj ^. #projectId) (branch toNames :: ProjectPath -> ProjectPathNames toNames (ProjectPath proj branch path) = ProjectPath (proj ^. #name) (branch ^. #name) path -asProjectAndBranch_ :: Lens' ProjectPath (ProjectAndBranch Project ProjectBranch) -asProjectAndBranch_ = lens get set - where - get (ProjectPath proj branch _) = ProjectAndBranch proj branch - set p (ProjectAndBranch proj branch) = p & #project .~ proj & #branch .~ branch +toProjectAndBranch :: ProjectPathG p b -> ProjectAndBranch p b +toProjectAndBranch (ProjectPath proj branch _) = ProjectAndBranch proj branch instance Bifunctor ProjectPathG where bimap f g (ProjectPath p b path) = ProjectPath (f p) (g b) path @@ -101,7 +98,7 @@ path (ProjectPath _ _ p) = Path.unabsolute p path_ :: Lens' (ProjectPathG p b) Path.Path path_ = absPath_ . Path.absPath_ -projectAndBranch_ :: Lens' (ProjectPathG p b) (ProjectAndBranch p b) +projectAndBranch_ :: Lens (ProjectPathG p b) (ProjectPathG p' b') (ProjectAndBranch p b) (ProjectAndBranch p' b') projectAndBranch_ = lens go set where go (ProjectPath proj branch _) = ProjectAndBranch proj branch diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index d49f4b964e..2e6abfdc30 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -157,7 +157,7 @@ getCurrentProjectPath = do getCurrentProjectAndBranch :: Cli (ProjectAndBranch Project ProjectBranch) getCurrentProjectAndBranch = do - view PP.asProjectAndBranch_ <$> getCurrentProjectPath + PP.toProjectAndBranch <$> getCurrentProjectPath getCurrentProjectBranch :: Cli ProjectBranch getCurrentProjectBranch = do @@ -298,7 +298,7 @@ getBranch0FromProjectPath pp = getProjectBranchRoot :: ProjectBranch -> Cli (Branch IO) getProjectBranchRoot projectBranch = do Cli.Env {codebase} <- ask - liftIO $ Codebase.expectProjectBranchRoot codebase projectBranch + liftIO $ Codebase.expectProjectBranchRoot codebase projectBranch.projectId projectBranch.branchId -- | Get the maybe-branch at an absolute path. getMaybeBranchFromProjectPath :: PP.ProjectPath -> Cli (Maybe (Branch IO)) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index 9eebe820c9..7a844bec50 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -162,7 +162,7 @@ resolveSourceAndTarget includeSquashed = \case resolveImplicitSource :: Share.IncludeSquashedHead -> Cli (ReadRemoteNamespace Share.RemoteProjectBranch) resolveImplicitSource includeSquashed = do pp <- Cli.getCurrentProjectPath - let localProjectAndBranch = pp ^. PP.asProjectAndBranch_ + let localProjectAndBranch = PP.toProjectAndBranch pp (remoteProjectId, remoteProjectName, remoteBranchId, remoteBranchName) <- Cli.runTransactionWithRollback \rollback -> do let localProjectId = localProjectAndBranch.project.projectId @@ -200,7 +200,7 @@ resolveExplicitSource includeSquashed = \case (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName) pure (ReadShare'ProjectBranch remoteProjectBranch) ReadShare'ProjectBranch (That branchNameOrLatestRelease) -> do - localProjectAndBranch <- view PP.asProjectAndBranch_ <$> Cli.getCurrentProjectPath + localProjectAndBranch <- PP.toProjectAndBranch <$> Cli.getCurrentProjectPath let localProjectId = localProjectAndBranch.project.projectId let localBranchId = localProjectAndBranch.branch.branchId Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case @@ -235,7 +235,7 @@ resolveExplicitSource includeSquashed = \case resolveImplicitTarget :: Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) resolveImplicitTarget = do - view PP.asProjectAndBranch_ <$> Cli.getCurrentProjectPath + PP.toProjectAndBranch <$> Cli.getCurrentProjectPath -- | supply `dest0` if you want to print diff messages -- supply unchangedMessage if you want to display it if merge had no effect diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 151c7c3948..a4309e8733 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -6,7 +6,8 @@ where import Compat (withInterruptHandler) import Control.Concurrent.Async qualified as Async import Control.Exception (catch, displayException, finally, mask) -import Control.Lens (preview, (?~)) +import Control.Lens ((?~)) +import Control.Lens.Lens import Crypto.Random qualified as Random import Data.Configurator.Types (Config) import Data.IORef @@ -20,16 +21,13 @@ import System.Console.Haskeline.History qualified as Line import System.IO (hGetEcho, hPutStrLn, hSetEcho, stderr, stdin) import System.IO.Error (isDoesNotExistError) import U.Codebase.HashTags (CausalHash) -import U.Codebase.Sqlite.Operations qualified as Operations -import U.Codebase.Sqlite.Operations qualified as Ops -import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Auth.CredentialManager (newCredentialManager) import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Auth.HTTPClient qualified as AuthN import Unison.Auth.Tokens qualified as AuthN import Unison.Cli.Monad qualified as Cli -import Unison.Cli.Pretty (prettyProjectAndBranchName) -import Unison.Cli.ProjectUtils (projectBranchPathPrism) +import Unison.Cli.Pretty qualified as P +import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch) @@ -38,7 +36,6 @@ import Unison.Codebase.Editor.HandleInput qualified as HandleInput import Unison.Codebase.Editor.Input (Event, Input (..)) import Unison.Codebase.Editor.Output (NumberedArgs, Output) import Unison.Codebase.Editor.UCMVersion (UCMVersion) -import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Runtime import Unison.CommandLine @@ -50,7 +47,6 @@ import Unison.CommandLine.Welcome qualified as Welcome import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyTerminal -import Unison.Project (ProjectAndBranch (..)) import Unison.Runtime.IOSource qualified as IOSource import Unison.Server.CodebaseServer qualified as Server import Unison.Symbol (Symbol) @@ -68,7 +64,7 @@ getUserInput :: IO (Branch IO) -> NumberedArgs -> IO Input -getUserInput codebase authHTTPClient ppCtx currentProjectRoot numberedArgs = +getUserInput codebase authHTTPClient pp currentProjectRoot numberedArgs = Line.runInputT settings (haskelineCtrlCHandling go) @@ -83,15 +79,7 @@ getUserInput codebase authHTTPClient ppCtx currentProjectRoot numberedArgs = Just a -> pure a go :: Line.InputT IO Input go = do - let (PP.ProjectPath projectName projectBranchName path) = PP.toNames ppCtx - let promptString = - P.sep - ":" - ( catMaybes - [ Just (prettyProjectAndBranchName (ProjectAndBranch projectName projectBranchName)), - (Just . P.green . P.shown) path - ] - ) + let promptString = P.prettyProjectPath pp let fullPrompt = P.toANSI 80 (promptString <> fromString prompt) line <- Line.getInputLine fullPrompt case line of @@ -99,7 +87,7 @@ getUserInput codebase authHTTPClient ppCtx currentProjectRoot numberedArgs = Just l -> case words l of [] -> go ws -> do - liftIO (parseInput codebase ppCtx currentProjectRoot numberedArgs IP.patternMap ws) >>= \case + liftIO (parseInput codebase pp currentProjectRoot numberedArgs IP.patternMap ws) >>= \case Left msg -> do -- We still add history that failed to parse so the user can easily reload -- the input and fix it. @@ -123,7 +111,15 @@ getUserInput codebase authHTTPClient ppCtx currentProjectRoot numberedArgs = historyFile = Just ".unisonHistory", autoAddHistory = False } - tabComplete = haskelineTabComplete IP.patternMap codebase authHTTPClient ppCtx + tabComplete = haskelineTabComplete IP.patternMap codebase authHTTPClient pp + +loopStateProjectPath :: + Codebase IO Symbol Ann -> + Cli.LoopState -> + IO PP.ProjectPath +loopStateProjectPath codebase loopState = do + let ppIds = NEL.head $ Cli.projectPathStack loopState + ppIds & PP.projectAndBranch_ %%~ \pabIds -> liftIO . Codebase.runTransaction codebase $ ProjectUtils.expectProjectAndBranchByIds pabIds main :: FilePath -> @@ -138,22 +134,22 @@ main :: Maybe Server.BaseUrl -> UCMVersion -> (CausalHash -> STM ()) -> - (Path.Absolute -> STM ()) -> + (PP.ProjectPath -> STM ()) -> ShouldWatchFiles -> IO () main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion notifyBranchChange notifyPathChange shouldWatchFiles = Ki.scoped \scope -> do rootVar <- newEmptyTMVarIO _ <- Ki.fork scope do - root <- Codebase.getRootBranch codebase + projectRoot <- Codebase.expectProjectBranchRoot codebase ppIds.project ppIds.branch atomically do -- Try putting the root, but if someone else as already written over the root, don't -- overwrite it. - void $ tryPutTMVar rootVar root + void $ tryPutTMVar rootVar projectRoot -- Start forcing thunks in a background thread. -- This might be overly aggressive, maybe we should just evaluate the top level but avoid -- recursive "deep*" things. UnliftIO.concurrently_ - (UnliftIO.evaluate root) + (UnliftIO.evaluate projectRoot) (UnliftIO.evaluate IOSource.typecheckedFile) -- IOSource takes a while to compile, we should start compiling it on startup let initialState = Cli.loopState0 rootVar ppIds Ki.fork_ scope do @@ -184,11 +180,11 @@ main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase currentEcho <- hGetEcho stdin liftIO $ restoreEcho currentEcho let getProjectRoot = atomically $ readTMVar rootVar - Codebase.runTransaction codebase Ops.expectProjectAndBranchNames + pp <- loopStateProjectPath codebase loopState getUserInput codebase authHTTPClient - (NEL.head $ Cli.projectPathStack loopState) + pp getProjectRoot (loopState ^. #numberedArgs) let loadSourceFile :: Text -> IO Cli.LoadSourceResult @@ -283,7 +279,9 @@ main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase Text.hPutStrLn stderr ("Encountered exception:\n" <> Text.pack (displayException e)) loop0 s0 Right (Right (result, s1)) -> do - when ((s0 ^. #currentPath) /= (s1 ^. #currentPath :: Path.Absolute)) (atomically . notifyPathChange $ s1 ^. #currentPath) + oldPP <- loopStateProjectPath codebase s0 + newPP <- loopStateProjectPath codebase s1 + when (oldPP /= newPP) (atomically . notifyPathChange $ newPP) case result of Cli.Success () -> loop0 s1 Cli.Continue -> loop0 s1 diff --git a/unison-cli/src/Unison/LSP/UCMWorker.hs b/unison-cli/src/Unison/LSP/UCMWorker.hs index 70212d29ad..14913f7fa4 100644 --- a/unison-cli/src/Unison/LSP/UCMWorker.hs +++ b/unison-cli/src/Unison/LSP/UCMWorker.hs @@ -31,7 +31,7 @@ ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar getLatestPro Env {codebase, completionsVar} <- ask let loop :: ProjectPath -> Lsp a loop currentProjectPath = do - currentBranch <- liftIO $ Codebase.expectProjectBranchRoot codebase (currentProjectPath ^. #branch) + currentBranch <- liftIO $ Codebase.expectProjectBranchRoot codebase (currentProjectPath ^. #branch . #projectId) (currentProjectPath ^. #branch . #branchId) Debug.debugM Debug.LSP "LSP path: " currentProjectPath let currentBranch0 = Branch.head currentBranch let currentNames = Branch.toNames currentBranch0 From 9691a80ed75ab79d97e8c7380b773e6d50489a1b Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 10 Jun 2024 20:02:01 -0400 Subject: [PATCH 148/631] Improve CLI shared error message This rephrases part of it and includes instructions to run the `help` command (rather than including the `help` output directly). In future, we may directly include shorter `help` outputs or a separate set of examples. But for now the `help` output may overshadow the error message we intend to show the user. --- unison-cli/src/Unison/CommandLine.hs | 10 ++++++++-- unison-src/transcripts/pull-errors.output.md | 20 ++++++++++---------- 2 files changed, 18 insertions(+), 12 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 1431ebeac9..c65454d015 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -154,10 +154,16 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do . first ( \msg -> P.indentN 2 $ - P.wrap (P.text "Sorry, I couldn’t understand your request. " <> msg) + P.wrap (P.text "Sorry, I wasn’t sure how to process your request. " <> msg) <> P.newline <> P.newline - <> P.text "Usage:" + <> P.text + ( "You can run `help " + <> Text.pack command + <> "` for more information on using `" + <> Text.pack command + <> "`" + ) <> P.newline <> P.indentN 2 help ) diff --git a/unison-src/transcripts/pull-errors.output.md b/unison-src/transcripts/pull-errors.output.md index 50e7c776ad..64515d7499 100644 --- a/unison-src/transcripts/pull-errors.output.md +++ b/unison-src/transcripts/pull-errors.output.md @@ -30,12 +30,12 @@ test/main> pull @aryairani/test-almost-empty/main lib.base_latest test/main> pull @aryairani/test-almost-empty/main a.b - Sorry, I couldn’t understand your request. I think you're - wanting to merge @aryairani/test-almost-empty/main into the - a.b namespace, but the `pull` command only supports merging - into the top level of a local project branch. + Sorry, I wasn’t sure how to process your request. I think + you're wanting to merge @aryairani/test-almost-empty/main into + the a.b namespace, but the `pull` command only supports + merging into the top level of a local project branch. - Usage: + You can run `help pull` for more information on using `pull` The `pull` command merges a remote namespace into a local branch @@ -67,12 +67,12 @@ test/main> pull @aryairani/test-almost-empty/main a test/main> pull @aryairani/test-almost-empty/main .a - Sorry, I couldn’t understand your request. I think you're - wanting to merge @aryairani/test-almost-empty/main into the .a - namespace, but the `pull` command only supports merging into - the top level of a local project branch. + Sorry, I wasn’t sure how to process your request. I think + you're wanting to merge @aryairani/test-almost-empty/main into + the .a namespace, but the `pull` command only supports merging + into the top level of a local project branch. - Usage: + You can run `help pull` for more information on using `pull` The `pull` command merges a remote namespace into a local branch From 23fe24ce67dfc3735f9cb3169184acc143f63ab6 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 10 Jun 2024 20:11:42 -0400 Subject: [PATCH 149/631] Improve a few more CLI input error messages --- .../src/Unison/CommandLine/InputPatterns.hs | 49 +++++++++++-------- 1 file changed, 28 insertions(+), 21 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index eecf3217a0..0d03335859 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -290,20 +290,25 @@ searchResultToHQ oprefix = \case addPrefix :: Name -> Name addPrefix = maybe id Path.prefixName2 oprefix -unsupportedStructuredArgument :: Text -> I.Argument -> Either (P.Pretty CT.ColorText) String -unsupportedStructuredArgument expected = - either pure (const . Left . P.text $ "can’t use a numbered argument for " <> expected) +unsupportedStructuredArgument :: Text -> Text -> I.Argument -> Either (P.Pretty CT.ColorText) String +unsupportedStructuredArgument command expected = + either pure . const . Left . P.text $ + "`" + <> command + <> "` can’t accept a numbered argument for " + <> expected + <> " and it’s not yet possible to provide un-expanded numbers as arguments." expectedButActually' :: Text -> String -> P.Pretty CT.ColorText expectedButActually' expected actualValue = - P.text $ "Expected " <> expected <> ", but I saw “" <> Text.pack actualValue <> "”." + P.text $ "I expected " <> expected <> ", but couldn’t recognize “" <> Text.pack actualValue <> "” as one." expectedButActually :: Text -> StructuredArgument -> Text -> P.Pretty CT.ColorText expectedButActually expected actualValue actualType = P.text $ - "Expected " + "I expected " <> expected - <> ", but the numbered arg resulted in “" + <> ", but the numbered argument resulted in “" <> formatStructuredArgument Nothing actualValue <> "”, which is " <> actualType @@ -767,7 +772,7 @@ load = ) \case [] -> pure $ Input.LoadI Nothing - [file] -> Input.LoadI . Just <$> unsupportedStructuredArgument "a file name" file + [file] -> Input.LoadI . Just <$> unsupportedStructuredArgument "load" "a file name" file args -> wrongArgsLength "no more than one argument" args clear :: InputPattern @@ -990,7 +995,7 @@ displayTo = (wrongArgsLength "at least two arguments" [file]) ( \defs -> Input.DisplayI . Input.FileLocation - <$> unsupportedStructuredArgument "a file name" file + <$> unsupportedStructuredArgument "display.to" "a file name" file <*> traverse handleHashQualifiedNameArg defs ) $ NE.nonEmpty defs @@ -1733,7 +1738,7 @@ pullImpl name aliases pullMode addendum = do Right (Input.LibInstallI True (ProjectAndBranch sourceProject (Just sourceBranch))) (Right source, Left _, Right path) -> Left $ - "I think you're wanting to merge" + "I think you want to merge" <> case source of RemoteRepo.ReadShare'LooseCode _sourcePath -> "some non-project code" RemoteRepo.ReadShare'ProjectBranch (This sourceProject) -> @@ -1766,7 +1771,7 @@ debugTabCompletion = P.wrap $ "Completions which are finished are prefixed with a * represent finished completions." ] ) - (fmap Input.DebugTabCompletionI . traverse (unsupportedStructuredArgument "text")) + (fmap Input.DebugTabCompletionI . traverse (unsupportedStructuredArgument "debug.tab-complete" "text")) debugFuzzyOptions :: InputPattern debugFuzzyOptions = @@ -1786,8 +1791,8 @@ debugFuzzyOptions = \case (cmd : args) -> Input.DebugFuzzyOptionsI - <$> unsupportedStructuredArgument "a command" cmd - <*> traverse (unsupportedStructuredArgument "text") args + <$> unsupportedStructuredArgument "debug.fuzzy-options" "a command" cmd + <*> traverse (unsupportedStructuredArgument "debug.fuzzy-options" "text") args args -> wrongArgsLength "at least one argument" args debugFormat :: InputPattern @@ -2231,7 +2236,7 @@ helpTopics = ( \case [] -> Left topics [topic] -> do - topic <- unsupportedStructuredArgument "a help topic" topic + topic <- unsupportedStructuredArgument "help-topics" "a help topic" topic case Map.lookup topic helpTopicsMap of Nothing -> Left . warn $ "I don't know of that topic. Try `help-topics`." Just t -> Left t @@ -2420,7 +2425,7 @@ help = showPatternHelp visibleInputs [cmd] -> do - cmd <- unsupportedStructuredArgument "a command" cmd + cmd <- unsupportedStructuredArgument "help" "a command" cmd case (Map.lookup cmd commandsByName, isHelp cmd) of (Nothing, Just msg) -> Left msg (Nothing, Nothing) -> Left . warn $ "I don't know of that command. Try `help`." @@ -2700,7 +2705,7 @@ docsToHtml = [namespacePath, destinationFilePath] -> Input.DocsToHtmlI <$> handlePath'Arg namespacePath - <*> unsupportedStructuredArgument "a file name" destinationFilePath + <*> unsupportedStructuredArgument "docs.to-html" "a file name" destinationFilePath args -> wrongArgsLength "exactly two arguments" args docToMarkdown :: InputPattern @@ -2740,7 +2745,7 @@ execute = main : args -> Input.ExecuteI <$> handleHashQualifiedNameArg main - <*> traverse (unsupportedStructuredArgument "a command-line argument") args + <*> traverse (unsupportedStructuredArgument "run" "a command-line argument") args [] -> wrongArgsLength "at least one argument" [] saveExecuteResult :: InputPattern @@ -2811,7 +2816,7 @@ makeStandalone = $ \case [main, file] -> Input.MakeStandaloneI - <$> unsupportedStructuredArgument "a file name" file + <$> unsupportedStructuredArgument "compile" "a file name" file <*> handleHashQualifiedNameArg main args -> wrongArgsLength "exactly two arguments" args @@ -2832,7 +2837,7 @@ runScheme = main : args -> Input.ExecuteSchemeI <$> handleHashQualifiedNameArg main - <*> traverse (unsupportedStructuredArgument "a command-line argument") args + <*> traverse (unsupportedStructuredArgument "run.native" "a command-line argument") args [] -> wrongArgsLength "at least one argument" [] compileScheme :: InputPattern @@ -2853,7 +2858,7 @@ compileScheme = $ \case [main, file] -> Input.CompileSchemeI . Text.pack - <$> unsupportedStructuredArgument "a file name" file + <$> unsupportedStructuredArgument "compile.native" "a file name" file <*> handleHashQualifiedNameArg main args -> wrongArgsLength "exactly two arguments" args @@ -2879,7 +2884,9 @@ createAuthor = symbolStr : authorStr@(_ : _) -> Input.CreateAuthorI <$> handleRelativeNameSegmentArg symbolStr - <*> fmap (parseAuthorName . unwords) (traverse (unsupportedStructuredArgument "text") authorStr) + <*> fmap + (parseAuthorName . unwords) + (traverse (unsupportedStructuredArgument "create.author" "text") authorStr) args -> wrongArgsLength "at least two arguments" args where -- let's have a real parser in not too long @@ -3147,7 +3154,7 @@ releaseDraft = bimap (const "Couldn’t parse version number") Input.ReleaseDraftI . tryInto @Semver . Text.pack - =<< unsupportedStructuredArgument "a version number" semverString + =<< unsupportedStructuredArgument "release.draft" "a version number" semverString args -> wrongArgsLength "exactly one argument" args } From 815c1b1f1ca7db6beb50f003361c0e98740f0d9e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Jun 2024 06:28:12 -0700 Subject: [PATCH 150/631] Auto-create project-branches referenced in transcript prompts (#5077) --- .../Codebase/SqliteCodebase/Operations.hs | 15 ++++++++++ .../Editor/HandleInput/ProjectCreate.hs | 21 +++----------- .../src/Unison/Codebase/TranscriptParser.hs | 28 +++++++++++++++--- .../transcripts-manual/gen-racket-libs.md | 1 - unison-src/transcripts/definition-diff-api.md | 5 ++-- .../transcripts/definition-diff-api.output.md | 20 ++----------- .../delete-namespace-dependents-check.md | 1 - .../transcripts/delete-project-branch.md | 1 - .../delete-project-branch.output.md | 16 ---------- .../dont-upgrade-refs-that-exist-in-old.md | 1 - unison-src/transcripts/edit-namespace.md | 1 - unison-src/transcripts/fix-ls.md | 1 - unison-src/transcripts/fix-ls.output.md | 16 ---------- unison-src/transcripts/fix4482.md | 1 - unison-src/transcripts/fix4515.md | 1 - unison-src/transcripts/fix4528.md | 1 - unison-src/transcripts/fix5055.md | 1 - unison-src/transcripts/fix5055.output.md | 16 ---------- unison-src/transcripts/fuzzy-options.md | 1 - .../transcripts/fuzzy-options.output.md | 16 ---------- unison-src/transcripts/merge.md | 29 ------------------- unison-src/transcripts/pull-errors.md | 3 -- unison-src/transcripts/pull-errors.output.md | 18 ------------ .../transcripts/release-draft-command.md | 1 - unison-src/transcripts/reset.md | 1 - unison-src/transcripts/reset.output.md | 16 ---------- unison-src/transcripts/switch-command.md | 2 -- unison-src/transcripts/tab-completion.md | 1 - .../transcripts/tab-completion.output.md | 16 ---------- .../update-suffixifies-properly.md | 1 - unison-src/transcripts/upgrade-happy-path.md | 1 - unison-src/transcripts/upgrade-sad-path.md | 1 - .../upgrade-suffixifies-properly.md | 1 - .../transcripts/upgrade-with-old-alias.md | 1 - 34 files changed, 47 insertions(+), 209 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index eee0dcec4f..98a6db75ef 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -24,11 +24,13 @@ import U.Codebase.Projects qualified as Projects import U.Codebase.Reference qualified as C.Reference import U.Codebase.Referent qualified as C.Referent import U.Codebase.Sqlite.DbId (ObjectId) +import U.Codebase.Sqlite.DbId qualified as Db import U.Codebase.Sqlite.NameLookups (PathSegments (..), ReversedName (..)) import U.Codebase.Sqlite.NamedRef qualified as S import U.Codebase.Sqlite.ObjectType qualified as OT import U.Codebase.Sqlite.Operations (NamesInPerspective (..)) import U.Codebase.Sqlite.Operations qualified as Ops +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle) import Unison.Builtin qualified as Builtins @@ -41,6 +43,7 @@ import Unison.Codebase.SqliteCodebase.Branch.Cache (BranchCache) import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType qualified as CT +import Unison.Core.Project (ProjectBranchName, ProjectName) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as Decl import Unison.Hash (Hash) @@ -731,3 +734,15 @@ makeMaybeCachedTransaction size action = do pure \x -> do conn <- Sqlite.unsafeGetConnection Sqlite.unsafeIO (Cache.applyDefined cache (\x -> Sqlite.unsafeUnTransaction (action x) conn) x) + +insertProjectAndBranch :: Db.ProjectId -> ProjectName -> Db.ProjectBranchId -> ProjectBranchName -> Sqlite.Transaction () +insertProjectAndBranch projectId projectName branchId branchName = do + Q.insertProject projectId projectName + Q.insertProjectBranch + ProjectBranch + { projectId, + branchId, + name = branchName, + parentBranchId = Nothing + } + Q.setMostRecentBranch projectId branchId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs index 9d95ffca8d..8ffe4e9777 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs @@ -10,7 +10,6 @@ import Data.Text qualified as Text import Data.UUID.V4 qualified as UUID import System.Random.Shuffle qualified as RandomShuffle import U.Codebase.Sqlite.DbId -import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare) import Unison.Cli.Monad (Cli) @@ -22,11 +21,11 @@ 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.Codebase.SqliteCodebase.Operations qualified as Ops import Unison.NameSegment qualified as NameSegment import Unison.Prelude -import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) +import Unison.Project (ProjectAndBranch (..), ProjectName) import Unison.Share.API.Hash qualified as Share.API -import Unison.Sqlite qualified as Sqlite import Unison.Sync.Common qualified as Sync.Common import Witch (unsafeFrom) @@ -73,7 +72,7 @@ projectCreate tryDownloadingBase maybeProjectName = do projectName : projectNames -> Queries.projectExistsByName projectName >>= \case False -> do - insertProjectAndBranch projectId projectName branchId branchName + Ops.insertProjectAndBranch projectId projectName branchId branchName pure projectName True -> loop projectNames loop randomProjectNames @@ -81,7 +80,7 @@ projectCreate tryDownloadingBase maybeProjectName = do Cli.runTransactionWithRollback \rollback -> do Queries.projectExistsByName projectName >>= \case False -> do - insertProjectAndBranch projectId projectName branchId branchName + Ops.insertProjectAndBranch projectId projectName branchId branchName pure projectName True -> rollback (Output.ProjectNameAlreadyExists projectName) @@ -152,18 +151,6 @@ projectCreate tryDownloadingBase maybeProjectName = do Nothing -> "project.create" Just projectName -> "project.create " <> into @Text projectName -insertProjectAndBranch :: ProjectId -> ProjectName -> ProjectBranchId -> ProjectBranchName -> Sqlite.Transaction () -insertProjectAndBranch projectId projectName branchId branchName = do - Queries.insertProject projectId projectName - Queries.insertProjectBranch - Sqlite.ProjectBranch - { projectId, - branchId, - name = branchName, - parentBranchId = Nothing - } - Queries.setMostRecentBranch projectId branchId - -- An infinite list of random project names that looks like -- -- [ diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/TranscriptParser.hs index 9746c39f91..b9e82f7ed5 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/unison-cli/src/Unison/Codebase/TranscriptParser.hs @@ -31,6 +31,7 @@ import Data.List (isSubsequenceOf) import Data.Map qualified as Map import Data.Text qualified as Text import Data.These (These (..)) +import Data.UUID.V4 qualified as UUID import Ki qualified import Network.HTTP.Client qualified as HTTP import System.Directory (doesFileExist) @@ -39,7 +40,11 @@ import System.Exit (die) import System.IO qualified as IO import System.IO.Error (catchIOError) import Text.Megaparsec qualified as P +import U.Codebase.Sqlite.DbId qualified as Db import U.Codebase.Sqlite.Operations qualified as Operations +import U.Codebase.Sqlite.Project (Project (..)) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.Queries qualified as Q import Unison.Auth.CredentialManager qualified as AuthN import Unison.Auth.HTTPClient qualified as AuthN import Unison.Auth.Tokens qualified as AuthN @@ -70,6 +75,7 @@ import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (ProjectAndB import Unison.Runtime.Interface qualified as RTI import Unison.Server.Backend qualified as Backend import Unison.Server.CodebaseServer qualified as Server +import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.Parser qualified as Parser import Unison.Util.Pretty qualified as Pretty @@ -349,10 +355,24 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion if curPath == path then pure Nothing else pure $ Just (SwitchBranchI (Path.absoluteToPath' path)) - UcmContextProject (ProjectAndBranch projectName branchName) -> do - ProjectAndBranch project branch <- - ProjectUtils.expectProjectAndBranchByTheseNames (These projectName branchName) - let projectAndBranchIds = ProjectAndBranch (project ^. #projectId) (branch ^. #branchId) + UcmContextProject (ProjectAndBranch projectName branchName) -> Cli.runTransaction do + Project {projectId, name = projectName} <- + Q.loadProjectByName projectName + >>= \case + Nothing -> do + projectId <- Sqlite.unsafeIO (Db.ProjectId <$> UUID.nextRandom) + Q.insertProject projectId projectName + pure $ Project {projectId, name = projectName} + Just project -> pure project + projectBranch <- + Q.loadProjectBranchByName projectId branchName >>= \case + Nothing -> do + branchId <- Sqlite.unsafeIO (Db.ProjectBranchId <$> UUID.nextRandom) + let projectBranch = ProjectBranch {projectId, parentBranchId = Nothing, branchId, name = branchName} + Q.insertProjectBranch projectBranch + pure projectBranch + Just projBranch -> pure projBranch + let projectAndBranchIds = ProjectAndBranch projectBranch.projectId projectBranch.branchId pure if curPath == ProjectUtils.projectBranchPath projectAndBranchIds then Nothing diff --git a/unison-src/transcripts-manual/gen-racket-libs.md b/unison-src/transcripts-manual/gen-racket-libs.md index 44c078db56..811ec14f50 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.md +++ b/unison-src/transcripts-manual/gen-racket-libs.md @@ -4,7 +4,6 @@ When we start out, `./scheme-libs/racket` contains a bunch of library files that Next, we'll download the jit project and generate a few Racket files from it. ```ucm -.> project.create-empty jit-setup jit-setup/main> lib.install @unison/internal/releases/0.0.17 ``` diff --git a/unison-src/transcripts/definition-diff-api.md b/unison-src/transcripts/definition-diff-api.md index 922a3c2776..f8d21d0687 100644 --- a/unison-src/transcripts/definition-diff-api.md +++ b/unison-src/transcripts/definition-diff-api.md @@ -1,10 +1,9 @@ ```ucm -.> project.create-empty diffs diffs/main> builtins.merge ``` ```unison -term = +term = _ = "Here's some text" 1 + 1 @@ -17,7 +16,7 @@ diffs/main> branch.create new ``` ```unison -term = +term = _ = "Here's some different text" 1 + 2 diff --git a/unison-src/transcripts/definition-diff-api.output.md b/unison-src/transcripts/definition-diff-api.output.md index d0c73dc486..192367ff9f 100644 --- a/unison-src/transcripts/definition-diff-api.output.md +++ b/unison-src/transcripts/definition-diff-api.output.md @@ -1,27 +1,11 @@ ```ucm -.> project.create-empty diffs - - 🎉 I've created the project diffs. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - diffs/main> builtins.merge Done. ``` ```unison -term = +term = _ = "Here's some text" 1 + 1 @@ -59,7 +43,7 @@ diffs/main> branch.create new ``` ```unison -term = +term = _ = "Here's some different text" 1 + 2 diff --git a/unison-src/transcripts/delete-namespace-dependents-check.md b/unison-src/transcripts/delete-namespace-dependents-check.md index 9bbf7b94d3..72aacc311d 100644 --- a/unison-src/transcripts/delete-namespace-dependents-check.md +++ b/unison-src/transcripts/delete-namespace-dependents-check.md @@ -5,7 +5,6 @@ This is a regression test, previously `delete.namespace` allowed a delete as long as the deletions had a name _anywhere_ in your codebase, it should only check the current project branch. ```ucm:hide -.> project.create-empty myproject myproject/main> builtins.merge ``` diff --git a/unison-src/transcripts/delete-project-branch.md b/unison-src/transcripts/delete-project-branch.md index e28558c5fc..c84dc95cc2 100644 --- a/unison-src/transcripts/delete-project-branch.md +++ b/unison-src/transcripts/delete-project-branch.md @@ -2,7 +2,6 @@ Deleting the branch you are on takes you to its parent (though this is impossibl your working directory with each command). ```ucm -.> project.create-empty foo foo/main> branch topic foo/topic> delete.branch /topic ``` diff --git a/unison-src/transcripts/delete-project-branch.output.md b/unison-src/transcripts/delete-project-branch.output.md index 1b8baecc37..d4458e8be0 100644 --- a/unison-src/transcripts/delete-project-branch.output.md +++ b/unison-src/transcripts/delete-project-branch.output.md @@ -2,22 +2,6 @@ Deleting the branch you are on takes you to its parent (though this is impossibl your working directory with each command). ```ucm -.> project.create-empty foo - - 🎉 I've created the project foo. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - foo/main> branch topic Done. I've created the topic branch based off of main. diff --git a/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.md b/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.md index 9bd44d5a50..d74ca38e19 100644 --- a/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.md +++ b/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.md @@ -2,7 +2,6 @@ If `foo#old` exists in old, and `foo#new` exists in new, you might think `upgrad `#old` with references to `#new`. And it will... !!unless!! `#old` still exists in new. ```ucm:hide -.> project.create-empty foo foo/main> builtins.merge lib.builtin ``` diff --git a/unison-src/transcripts/edit-namespace.md b/unison-src/transcripts/edit-namespace.md index 816922fe82..ad50bc1b0d 100644 --- a/unison-src/transcripts/edit-namespace.md +++ b/unison-src/transcripts/edit-namespace.md @@ -1,5 +1,4 @@ ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio lib.builtin ``` diff --git a/unison-src/transcripts/fix-ls.md b/unison-src/transcripts/fix-ls.md index 3bd9fe5349..5bb9b950e3 100644 --- a/unison-src/transcripts/fix-ls.md +++ b/unison-src/transcripts/fix-ls.md @@ -1,5 +1,4 @@ ```ucm -.> project.create-empty test-ls test-ls/main> builtins.merge ``` diff --git a/unison-src/transcripts/fix-ls.output.md b/unison-src/transcripts/fix-ls.output.md index 0f6b6ff1f5..56277c6925 100644 --- a/unison-src/transcripts/fix-ls.output.md +++ b/unison-src/transcripts/fix-ls.output.md @@ -1,20 +1,4 @@ ```ucm -.> project.create-empty test-ls - - 🎉 I've created the project test-ls. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - test-ls/main> builtins.merge Done. diff --git a/unison-src/transcripts/fix4482.md b/unison-src/transcripts/fix4482.md index 1e4a9b1a51..380d693c87 100644 --- a/unison-src/transcripts/fix4482.md +++ b/unison-src/transcripts/fix4482.md @@ -1,5 +1,4 @@ ```ucm:hide -.> project.create-empty myproj myproj/main> builtins.merge ``` diff --git a/unison-src/transcripts/fix4515.md b/unison-src/transcripts/fix4515.md index c2dca1d63f..8cae1afc2b 100644 --- a/unison-src/transcripts/fix4515.md +++ b/unison-src/transcripts/fix4515.md @@ -1,5 +1,4 @@ ```ucm:hide -.> project.create-empty myproject myproject/main> builtins.merge ``` diff --git a/unison-src/transcripts/fix4528.md b/unison-src/transcripts/fix4528.md index e1b1e4f0a9..c6c540c959 100644 --- a/unison-src/transcripts/fix4528.md +++ b/unison-src/transcripts/fix4528.md @@ -1,5 +1,4 @@ ```ucm:hide -.> project.create-empty foo foo/main> builtins.merge ``` diff --git a/unison-src/transcripts/fix5055.md b/unison-src/transcripts/fix5055.md index b0218766a1..b5c377d381 100644 --- a/unison-src/transcripts/fix5055.md +++ b/unison-src/transcripts/fix5055.md @@ -1,5 +1,4 @@ ```ucm -.> project.create-empty test-5055 test-5055/main> builtins.merge ``` diff --git a/unison-src/transcripts/fix5055.output.md b/unison-src/transcripts/fix5055.output.md index 8dc31da207..a9fe9ee5d0 100644 --- a/unison-src/transcripts/fix5055.output.md +++ b/unison-src/transcripts/fix5055.output.md @@ -1,20 +1,4 @@ ```ucm -.> project.create-empty test-5055 - - 🎉 I've created the project test-5055. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - test-5055/main> builtins.merge Done. diff --git a/unison-src/transcripts/fuzzy-options.md b/unison-src/transcripts/fuzzy-options.md index 96294ce0a6..13d953c938 100644 --- a/unison-src/transcripts/fuzzy-options.md +++ b/unison-src/transcripts/fuzzy-options.md @@ -40,7 +40,6 @@ Namespace args Project Branch args ```ucm -.> project.create-empty myproject myproject/main> branch mybranch .> debug.fuzzy-options switch _ ``` diff --git a/unison-src/transcripts/fuzzy-options.output.md b/unison-src/transcripts/fuzzy-options.output.md index d5ff9b74cb..f48f5cd6fb 100644 --- a/unison-src/transcripts/fuzzy-options.output.md +++ b/unison-src/transcripts/fuzzy-options.output.md @@ -65,22 +65,6 @@ Namespace args Project Branch args ```ucm -.> project.create-empty myproject - - 🎉 I've created the project myproject. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - myproject/main> branch mybranch Done. I've created the mybranch branch based off of main. diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index d653b84c99..4c6549ac00 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -9,7 +9,6 @@ contains both additions. ## Basic merge: two unconflicted adds ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -52,7 +51,6 @@ project/alice> view foo bar If Alice and Bob also happen to add the same definition, that's not a conflict. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio project/main> branch alice ``` @@ -94,7 +92,6 @@ project/alice> view foo bar Updates that occur in one branch are propagated to the other. In this example, Alice updates `foo`, while Bob adds a new dependent `bar` of the original `foo`. When Bob's branch is merged into Alice's, her update to `foo` is propagated to his `bar`. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -150,7 +147,6 @@ We classify something as an update if its "syntactic hash"—not its normal Unis Let's see an example. We have `foo`, which depends on `bar` and `baz`. Alice updates `bar` (propagating to `foo`), and Bob updates `baz` (propagating to `foo`). When we merge their updates, both updates will be reflected in the final `foo`. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -215,7 +211,6 @@ project/alice> display foo Of course, it's also possible for Alice's update to propagate to one of Bob's updates. In this example, `foo` depends on `bar` which depends on `baz`. Alice updates `baz`, propagating to `bar` and `foo`, while Bob updates `bar` (to something that still depends on `foo`), propagating to `baz`. The merged result will have Alice's update to `foo` incorporated into Bob's updated `bar`, and both updates will propagate to `baz`. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -286,7 +281,6 @@ project/alice> display foo We don't currently consider "update + delete" a conflict like Git does. In this situation, the delete is just ignored, allowing the update to proceed. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -334,7 +328,6 @@ In a future version, we'd like to give the user a warning at least. Library dependencies don't cause merge conflicts, the library dependencies are just unioned together. If two library dependencies have the same name but different namespace hashes, then the merge algorithm makes up two fresh names. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -389,7 +382,6 @@ project/alice> view foo bar baz If Bob is equals Alice, then merging Bob into Alice looks like this. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -408,7 +400,6 @@ project/alice> merge /bob If Bob is behind Alice, then merging Bob into Alice looks like this. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -437,7 +428,6 @@ project/alice> merge /bob If Bob is ahead of Alice, then merging Bob into Alice looks like this. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -470,7 +460,6 @@ This can cause merge failures due to out-of-scope identifiers, and the user may In this example, Alice deletes `foo`, while Bob adds a new dependent of `foo`. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -514,7 +503,6 @@ It may be Alice's and Bob's changes merge together cleanly in the sense that the In this example, Alice updates a `Text` to a `Nat`, while Bob adds a new dependent of the `Text`. Upon merging, propagating Alice's update to Bob's dependent causes a typechecking failure. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -564,7 +552,6 @@ Alice and Bob may disagree about the definition of a term. In this case, the con are presented to the user to resolve. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -629,7 +616,6 @@ project/merge-bob-into-alice> view bar baz Ditto for types; if the hashes don't match, it's a conflict. In this example, Alice and Bob do different things to the same constructor. However, any explicit changes to the same type will result in a conflict, including changes that could concievably be merged (e.g. Alice and Bob both add a new constructor, or edit different constructors). ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -673,7 +659,6 @@ project/alice> merge /bob We model the renaming of a type's constructor as an update, so if Alice updates a type and Bob renames one of its constructors (even without changing its structure), we consider it a conflict. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -717,7 +702,6 @@ project/alice> merge /bob Here is another example demonstrating that constructor renames are modeled as updates. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -756,7 +740,6 @@ project/alice> merge bob A constructor on one side can conflict with a regular term definition on the other. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -798,7 +781,6 @@ project/alice> merge bob Here's a subtle situation where a new type is added on each side of the merge, and an existing term is replaced with a constructor of one of the types. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -848,7 +830,6 @@ project/alice> merge bob Here's a more involved example that demonstrates the same idea. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -928,7 +909,6 @@ which is a parse error. We will resolve this situation automatically in a future version. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -978,7 +958,6 @@ There are a number of conditions under which we can't perform a merge, and the u If `foo` and `bar` are aliases in the nearest common ancestor, but not in Alice's branch, then we don't know whether to update Bob's dependents to Alice's `foo` or Alice's `bar` (and vice-versa). ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -1036,7 +1015,6 @@ conflict involving a builtin, we can't perform a merge. One way to fix this in the future would be to introduce a syntax for defining aliases in the scratch file. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -1075,7 +1053,6 @@ project/alice> merge /bob Each naming of a decl may not have more than one name for each constructor, within the decl's namespace. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -1122,7 +1099,6 @@ project/alice> merge /bob Each naming of a decl must have a name for each constructor, within the decl's namespace. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -1170,7 +1146,6 @@ project/alice> merge /bob A decl cannot be aliased within the namespace of another of its aliased. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -1219,7 +1194,6 @@ project/alice> merge /bob Constructors may only exist within the corresponding decl's namespace. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -1264,7 +1238,6 @@ project/alice> merge bob By convention, `lib` can only namespaces; each of these represents a library dependencies. Individual terms and types are not allowed at the top level of `lib`. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -1309,7 +1282,6 @@ Here's an example. We'll delete a constructor name from the LCA and still be abl together. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` @@ -1374,7 +1346,6 @@ project/alice> merge /bob ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio ``` diff --git a/unison-src/transcripts/pull-errors.md b/unison-src/transcripts/pull-errors.md index f314ad5abb..784221bb8e 100644 --- a/unison-src/transcripts/pull-errors.md +++ b/unison-src/transcripts/pull-errors.md @@ -1,6 +1,3 @@ -```ucm -.> project.create-empty test -``` ```ucm:error test/main> pull @aryairani/test-almost-empty/main lib.base_latest test/main> pull @aryairani/test-almost-empty/main a.b diff --git a/unison-src/transcripts/pull-errors.output.md b/unison-src/transcripts/pull-errors.output.md index 963eaabb52..a2894f6468 100644 --- a/unison-src/transcripts/pull-errors.output.md +++ b/unison-src/transcripts/pull-errors.output.md @@ -1,22 +1,4 @@ ```ucm -.> project.create-empty test - - 🎉 I've created the project test. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - -``` -```ucm test/main> pull @aryairani/test-almost-empty/main lib.base_latest The use of `pull` to install libraries is now deprecated. diff --git a/unison-src/transcripts/release-draft-command.md b/unison-src/transcripts/release-draft-command.md index 7a5652a079..bac0e991b0 100644 --- a/unison-src/transcripts/release-draft-command.md +++ b/unison-src/transcripts/release-draft-command.md @@ -1,7 +1,6 @@ The `release.draft` command drafts a release from the current branch. ```ucm:hide -.> project.create-empty foo foo/main> builtins.merge ``` diff --git a/unison-src/transcripts/reset.md b/unison-src/transcripts/reset.md index 412b173337..a01351233d 100644 --- a/unison-src/transcripts/reset.md +++ b/unison-src/transcripts/reset.md @@ -29,7 +29,6 @@ foo.a = 5 # reset branch ```ucm -.> project.create-empty foo foo/main> history ``` diff --git a/unison-src/transcripts/reset.output.md b/unison-src/transcripts/reset.output.md index d4035c9257..344b2c16f9 100644 --- a/unison-src/transcripts/reset.output.md +++ b/unison-src/transcripts/reset.output.md @@ -103,22 +103,6 @@ foo.a = 5 # reset branch ```ucm -.> project.create-empty foo - - 🎉 I've created the project foo. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - foo/main> history ☝️ The namespace is empty. diff --git a/unison-src/transcripts/switch-command.md b/unison-src/transcripts/switch-command.md index d75b4a9592..c1a2bca962 100644 --- a/unison-src/transcripts/switch-command.md +++ b/unison-src/transcripts/switch-command.md @@ -1,8 +1,6 @@ The `switch` command switches to an existing project or branch. ```ucm:hide -.> project.create-empty foo -.> project.create-empty bar foo/main> builtins.merge bar/main> builtins.merge ``` diff --git a/unison-src/transcripts/tab-completion.md b/unison-src/transcripts/tab-completion.md index a5c7b090ec..c35c4ba347 100644 --- a/unison-src/transcripts/tab-completion.md +++ b/unison-src/transcripts/tab-completion.md @@ -69,7 +69,6 @@ add b = b ## Tab complete projects and branches ```ucm -.> project.create-empty myproject myproject/main> branch mybranch myproject/main> debug.tab-complete branch.delete /mybr myproject/main> debug.tab-complete project.rename my diff --git a/unison-src/transcripts/tab-completion.output.md b/unison-src/transcripts/tab-completion.output.md index 34ce96db90..82961cfd5c 100644 --- a/unison-src/transcripts/tab-completion.output.md +++ b/unison-src/transcripts/tab-completion.output.md @@ -173,22 +173,6 @@ add b = b ## Tab complete projects and branches ```ucm -.> project.create-empty myproject - - 🎉 I've created the project myproject. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - myproject/main> branch mybranch Done. I've created the mybranch branch based off of main. diff --git a/unison-src/transcripts/update-suffixifies-properly.md b/unison-src/transcripts/update-suffixifies-properly.md index 4cd042b494..d983959770 100644 --- a/unison-src/transcripts/update-suffixifies-properly.md +++ b/unison-src/transcripts/update-suffixifies-properly.md @@ -1,5 +1,4 @@ ```ucm:hide -.> project.create-empty myproject myproject/main> builtins.merge lib.builtin ``` diff --git a/unison-src/transcripts/upgrade-happy-path.md b/unison-src/transcripts/upgrade-happy-path.md index c234e9ac7d..068c8ccf1c 100644 --- a/unison-src/transcripts/upgrade-happy-path.md +++ b/unison-src/transcripts/upgrade-happy-path.md @@ -1,5 +1,4 @@ ```ucm:hide -.> project.create-empty proj proj/main> builtins.merge lib.builtin ``` diff --git a/unison-src/transcripts/upgrade-sad-path.md b/unison-src/transcripts/upgrade-sad-path.md index ccf51fd605..c2c1fe459a 100644 --- a/unison-src/transcripts/upgrade-sad-path.md +++ b/unison-src/transcripts/upgrade-sad-path.md @@ -1,5 +1,4 @@ ```ucm:hide -.> project.create-empty proj proj/main> builtins.merge lib.builtin ``` diff --git a/unison-src/transcripts/upgrade-suffixifies-properly.md b/unison-src/transcripts/upgrade-suffixifies-properly.md index 5aba271c10..08c4b002d9 100644 --- a/unison-src/transcripts/upgrade-suffixifies-properly.md +++ b/unison-src/transcripts/upgrade-suffixifies-properly.md @@ -1,5 +1,4 @@ ```ucm:hide -.> project.create-empty myproject myproject/main> builtins.merge lib.builtin ``` diff --git a/unison-src/transcripts/upgrade-with-old-alias.md b/unison-src/transcripts/upgrade-with-old-alias.md index ed1ae1c184..aeb818947e 100644 --- a/unison-src/transcripts/upgrade-with-old-alias.md +++ b/unison-src/transcripts/upgrade-with-old-alias.md @@ -1,5 +1,4 @@ ```ucm:hide -.> project.create-empty myproject myproject/main> builtins.merge lib.builtin ``` From 23fd0a005bcd0126480096b6bf36153ab0386d95 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Jun 2024 10:08:49 -0700 Subject: [PATCH 151/631] Allow passing project and branch as starting path --- .../U/Codebase/Sqlite/Queries.hs | 8 ++--- parser-typechecker/src/Unison/Codebase.hs | 19 +++++------- unison-cli/src/ArgParse.hs | 30 ++++++++++++------- unison-cli/src/Unison/Main.hs | 15 ++++------ unison-core/src/Unison/Project.hs | 15 ++++++++++ .../Unison/Server/Local/Endpoints/Current.hs | 10 ++----- 6 files changed, 55 insertions(+), 42 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 08cd1fe977..c1ec796c9c 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -238,7 +238,7 @@ module U.Codebase.Sqlite.Queries elaborateHashes, -- * current project path - loadCurrentProjectPath, + expectCurrentProjectPath, setCurrentProjectPath, -- * migrations @@ -4283,9 +4283,9 @@ data JsonParseFailure = JsonParseFailure deriving anyclass (SqliteExceptionReason) -- | Get the most recent namespace the user has visited. -loadCurrentProjectPath :: Transaction (Maybe (ProjectId, ProjectBranchId, [NameSegment])) -loadCurrentProjectPath = - queryMaybeRowCheck +expectCurrentProjectPath :: Transaction (ProjectId, ProjectBranchId, [NameSegment]) +expectCurrentProjectPath = + queryOneRowCheck [sql| SELECT project_id, branch_id, path FROM current_project_path diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index fff9c74571..3c1a5bde87 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -2,7 +2,7 @@ module Unison.Codebase ( Codebase, -- * UCM session state - loadCurrentProjectPath, + expectCurrentProjectPath, setCurrentProjectPath, -- * Terms @@ -536,16 +536,13 @@ unsafeGetTermComponent codebase hash = Nothing -> error (reportBug "E769004" ("term component " ++ show hash ++ " not found")) Just terms -> terms -loadCurrentProjectPath :: Sqlite.Transaction (Maybe PP.ProjectPath) -loadCurrentProjectPath = do - mProjectInfo <- Q.loadCurrentProjectPath - case mProjectInfo of - Nothing -> pure Nothing - Just (projectId, projectBranchId, path) -> do - proj <- Q.expectProject projectId - projBranch <- Q.expectProjectBranch projectId projectBranchId - let absPath = Path.Absolute (Path.fromList path) - pure $ Just (PP.ProjectPath proj projBranch absPath) +expectCurrentProjectPath :: Sqlite.Transaction PP.ProjectPath +expectCurrentProjectPath = do + (projectId, projectBranchId, path) <- Q.expectCurrentProjectPath + proj <- Q.expectProject projectId + projBranch <- Q.expectProjectBranch projectId projectBranchId + let absPath = Path.Absolute (Path.fromList path) + pure $ PP.ProjectPath proj projBranch absPath setCurrentProjectPath :: PP.ProjectPathIds -> Sqlite.Transaction () setCurrentProjectPath (PP.ProjectPath projectId projectBranchId path) = diff --git a/unison-cli/src/ArgParse.hs b/unison-cli/src/ArgParse.hs index ab24fd16c5..0b354f9f57 100644 --- a/unison-cli/src/ArgParse.hs +++ b/unison-cli/src/ArgParse.hs @@ -52,16 +52,19 @@ import Options.Applicative.Help (bold, (<+>)) import Options.Applicative.Help.Pretty qualified as P import Stats import System.Environment (lookupEnv) +import Text.Megaparsec qualified as Megaparsec import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path import Unison.Codebase.ProjectPath (ProjectPathNames) import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.Types (ShouldWatchFiles (..)) +import Unison.Core.Project (ProjectAndBranch, ProjectBranchName, ProjectName) import Unison.HashQualified (HashQualified) import Unison.LSP (LspFormattingConfig (..)) import Unison.Name (Name) import Unison.Prelude import Unison.PrettyTerminal qualified as PT +import Unison.Project qualified as Project import Unison.Server.CodebaseServer (CodebaseServerOpts (..)) import Unison.Server.CodebaseServer qualified as Server import Unison.Syntax.HashQualified qualified as HQ @@ -104,8 +107,8 @@ data Command = Launch IsHeadless CodebaseServerOpts - -- Starting path - (Maybe Path.Absolute) + -- Starting project + (Maybe (ProjectAndBranch ProjectName ProjectBranchName)) ShouldWatchFiles | PrintVersion | -- @deprecated in trunk after M2g. Remove the Init command completely after M2h has been released @@ -359,9 +362,9 @@ launchParser :: CodebaseServerOpts -> IsHeadless -> Parser Command launchParser envOpts isHeadless = do -- ApplicativeDo codebaseServerOpts <- codebaseServerOptsParser envOpts - startingPath <- startingPathOption + startingProject <- startingProjectOption shouldWatchFiles <- noFileWatchFlag - pure (Launch isHeadless codebaseServerOpts startingPath shouldWatchFiles) + pure (Launch isHeadless codebaseServerOpts startingProject shouldWatchFiles) initParser :: Parser Command initParser = pure Init @@ -428,15 +431,15 @@ saveCodebaseToFlag = do _ -> DontSaveCodebase ) -startingPathOption :: Parser (Maybe Path.Absolute) -startingPathOption = +startingProjectOption :: Parser (Maybe (ProjectAndBranch ProjectName ProjectBranchName)) +startingProjectOption = let meta = - metavar ".path.in.codebase" - <> long "path" + metavar "project/branch" + <> long "project" <> short 'p' - <> help "Launch the UCM session at the provided path location." + <> help "Launch the UCM session at the provided project and branch." <> noGlobal - in optional $ option readAbsolutePath meta + in optional (option readProjectAndBranchNames meta) noFileWatchFlag :: Parser ShouldWatchFiles noFileWatchFlag = @@ -475,6 +478,13 @@ readPath' = do Left err -> OptParse.readerError (Text.unpack err) Right path' -> pure path' +readProjectAndBranchNames :: ReadM (ProjectAndBranch ProjectName ProjectBranchName) +readProjectAndBranchNames = do + str <- OptParse.str + case Megaparsec.parse Project.fullyQualifiedProjectAndBranchNamesParser "arg" str of + Left errBundle -> OptParse.readerError $ Megaparsec.errorBundlePretty errBundle + Right projectAndBranch -> pure projectAndBranch + fileArgument :: String -> Parser FilePath fileArgument varName = strArgument diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index 1d58ddb03f..97d9700fd7 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -70,6 +70,7 @@ import Unison.Codebase.Init (CodebaseInitOptions (..), InitError (..), InitResul import Unison.Codebase.Init qualified as CodebaseInit import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (..)) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Rt import Unison.Codebase.SqliteCodebase qualified as SC import Unison.Codebase.TranscriptParser qualified as TR @@ -158,7 +159,7 @@ main version = do Run (RunFromSymbol mainName) args -> do getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, _, theCodebase) -> do RTI.withRuntime False RTI.OneOff (Version.gitDescribeWithDate version) \runtime -> do - withArgs args (execute theCodebase runtime mainName) >>= \case + withArgs args (execute theCodebase runtime _ mainName) >>= \case Left err -> exitError err Right () -> pure () Run (RunFromFile file mainName) args @@ -296,8 +297,7 @@ main version = do case mayStartingPath of Just startingPath -> pure startingPath Nothing -> do - segments <- Codebase.runTransaction theCodebase Queries.expectMostRecentNamespace - pure (Path.Absolute (Path.fromList segments)) + Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath Headless -> pure $ fromMaybe defaultInitialPath mayStartingPath rootCausalHash <- Codebase.runTransaction theCodebase (Queries.expectNamespaceRoot >>= Queries.expectCausalHash) rootCausalHashVar <- newTVarIO rootCausalHash @@ -512,9 +512,6 @@ runTranscripts version verbosity renderUsageInfo shouldFork shouldSaveTempCodeba ) when (not completed) $ Exit.exitWith (Exit.ExitFailure 1) -defaultInitialPath :: Path.Absolute -defaultInitialPath = Path.absoluteEmpty - launch :: Version -> FilePath -> @@ -525,13 +522,13 @@ launch :: Codebase.Codebase IO Symbol Ann -> [Either Input.Event Input.Input] -> Maybe Server.BaseUrl -> - Maybe Path.Absolute -> + PP.ProjectPathIds -> InitResult -> (CausalHash -> STM ()) -> (Path.Absolute -> STM ()) -> CommandLine.ShouldWatchFiles -> IO () -launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl mayStartingPath initResult notifyRootChange notifyPathChange shouldWatchFiles = do +launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl startingPath initResult notifyRootChange notifyPathChange shouldWatchFiles = do showWelcomeHint <- Codebase.runTransaction codebase Queries.doProjectsExist let isNewCodebase = case initResult of CreatedCodebase -> NewlyCreatedCodebase @@ -541,7 +538,7 @@ launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseU in CommandLine.main dir welcome - (fromMaybe defaultInitialPath mayStartingPath) + startingPath config inputs runtime diff --git a/unison-core/src/Unison/Project.hs b/unison-core/src/Unison/Project.hs index 77a96a448a..73070e7a1d 100644 --- a/unison-core/src/Unison/Project.hs +++ b/unison-core/src/Unison/Project.hs @@ -17,6 +17,7 @@ module Unison.Project ProjectBranchSpecifier (..), ProjectAndBranch (..), projectAndBranchNamesParser, + fullyQualifiedProjectAndBranchNamesParser, projectAndOptionalBranchParser, branchWithOptionalProjectParser, ProjectAndBranchNames (..), @@ -414,6 +415,20 @@ projectAndBranchNamesParser specifier = do Just branch -> These project branch else pure (This project) +-- | Parse a fully specified myproject/mybranch name. +-- +-- >>> import Text.Megaparsec (parseMaybe) +-- >>> parseMaybe fullyQualifiedProjectAndBranchNamesParser ("myproject/mybranch" :: Text) +-- Just (ProjectAndBranch {project = UnsafeProjectName "myproject", branch = UnsafeProjectBranchName "mybranch"}) +fullyQualifiedProjectAndBranchNamesParser :: Megaparsec.Parsec Void Text (ProjectAndBranch ProjectName ProjectBranchName) +fullyQualifiedProjectAndBranchNamesParser = do + (project, hadSlash) <- projectNameParser + if hadSlash + then pure () + else void $ Megaparsec.char '/' + branch <- projectBranchNameParser False + pure (ProjectAndBranch project branch) + -- | @project/branch@ syntax, where the branch is optional. instance From (ProjectAndBranch ProjectName (Maybe ProjectBranchName)) Text where from = \case diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs index 9065c5de45..68c10ce4b2 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs @@ -3,7 +3,6 @@ module Unison.Server.Local.Endpoints.Current where -import Control.Lens hiding ((.=)) import Control.Monad.Except import Data.Aeson import Data.OpenApi (ToSchema (..)) @@ -53,11 +52,6 @@ serveCurrent = lift . getCurrentProjectBranch getCurrentProjectBranch :: MonadIO m => Codebase m v a -> m Current getCurrentProjectBranch codebase = do - pp <- - Codebase.runTransaction codebase Codebase.loadCurrentProjectPath <&> \case - Nothing -> - -- TODO: Come up with a better solution for this - error "No current project path context" - Just pp -> pp - let (PP.ProjectPath projName branchName path) = PP.toNames pp + pp <- Codebase.runTransaction codebase Codebase.expectCurrentProjectPath + let (PP.ProjectPath projName branchName path) = PP.toNames pp pure $ Current (Just projName) (Just branchName) path From 7298bbeffe4c3f3cc2668c7d3b67a304e706a8d4 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Jun 2024 10:43:53 -0700 Subject: [PATCH 152/631] Revive causal hash signal in LSP --- unison-cli/src/Unison/LSP.hs | 23 ++++++++++++++++------- unison-cli/src/Unison/LSP/UCMWorker.hs | 24 ++++++++++++++---------- 2 files changed, 30 insertions(+), 17 deletions(-) diff --git a/unison-cli/src/Unison/LSP.hs b/unison-cli/src/Unison/LSP.hs index 4ef4b92750..5ec56f6967 100644 --- a/unison-cli/src/Unison/LSP.hs +++ b/unison-cli/src/Unison/LSP.hs @@ -27,6 +27,7 @@ import Language.LSP.VFS import Network.Simple.TCP qualified as TCP import System.Environment (lookupEnv) import System.IO (hPutStrLn) +import U.Codebase.HashTags import Unison.Codebase import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) @@ -60,8 +61,14 @@ getLspPort :: IO String getLspPort = fromMaybe "5757" <$> lookupEnv "UNISON_LSP_PORT" -- | Spawn an LSP server on the configured port. -spawnLsp :: LspFormattingConfig -> Codebase IO Symbol Ann -> Runtime Symbol -> STM PP.ProjectPath -> IO () -spawnLsp lspFormattingConfig codebase runtime latestPath = +spawnLsp :: + LspFormattingConfig -> + Codebase IO Symbol Ann -> + Runtime Symbol -> + STM CausalHash -> + STM PP.ProjectPath -> + IO () +spawnLsp lspFormattingConfig codebase runtime latestProjectRootHash latestPath = ifEnabled . TCP.withSocketsDo $ do lspPort <- getLspPort UnliftIO.handleIO (handleFailure lspPort) $ do @@ -81,7 +88,7 @@ spawnLsp lspFormattingConfig codebase runtime latestPath = -- different un-saved state for the same file. initVFS $ \vfs -> do vfsVar <- newMVar vfs - void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestPath) + void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestProjectRootHash latestPath) where handleFailure :: String -> IOException -> IO () handleFailure lspPort ioerr = @@ -112,15 +119,16 @@ serverDefinition :: Codebase IO Symbol Ann -> Runtime Symbol -> Ki.Scope -> + STM CausalHash -> STM PP.ProjectPath -> ServerDefinition Config -serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestPath = +serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestProjectRootHash latestPath = ServerDefinition { defaultConfig = defaultLSPConfig, configSection = "unison", parseConfig = Config.parseConfig, onConfigChange = Config.updateConfig, - doInitialize = lspDoInitialize vfsVar codebase runtime scope latestPath, + doInitialize = lspDoInitialize vfsVar codebase runtime scope latestProjectRootHash latestPath, staticHandlers = lspStaticHandlers lspFormattingConfig, interpretHandler = lspInterpretHandler, options = lspOptions @@ -132,11 +140,12 @@ lspDoInitialize :: Codebase IO Symbol Ann -> Runtime Symbol -> Ki.Scope -> + STM CausalHash -> STM PP.ProjectPath -> LanguageContextEnv Config -> Msg.TMessage 'Msg.Method_Initialize -> IO (Either Msg.ResponseError Env) -lspDoInitialize vfsVar codebase runtime scope latestPath lspContext _initMsg = do +lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath lspContext _initMsg = do checkedFilesVar <- newTVarIO mempty dirtyFilesVar <- newTVarIO mempty ppedCacheVar <- newEmptyTMVarIO @@ -155,7 +164,7 @@ lspDoInitialize vfsVar codebase runtime scope latestPath lspContext _initMsg = d } let lspToIO = flip runReaderT lspContext . unLspT . flip runReaderT env . runLspM Ki.fork scope (lspToIO Analysis.fileAnalysisWorker) - Ki.fork scope (lspToIO $ ucmWorker ppedCacheVar currentNamesCacheVar nameSearchCacheVar currentPathCacheVar latestPath) + Ki.fork scope (lspToIO $ ucmWorker ppedCacheVar currentNamesCacheVar nameSearchCacheVar currentPathCacheVar latestRootHash latestPath) pure $ Right $ env -- | LSP request handlers that don't register/unregister dynamically diff --git a/unison-cli/src/Unison/LSP/UCMWorker.hs b/unison-cli/src/Unison/LSP/UCMWorker.hs index 14913f7fa4..b0614c23e8 100644 --- a/unison-cli/src/Unison/LSP/UCMWorker.hs +++ b/unison-cli/src/Unison/LSP/UCMWorker.hs @@ -1,6 +1,7 @@ module Unison.LSP.UCMWorker where import Control.Monad.Reader +import U.Codebase.HashTags (CausalHash) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch @@ -25,12 +26,13 @@ ucmWorker :: TMVar Names -> TMVar (NameSearch Sqlite.Transaction) -> TMVar ProjectPath -> + STM CausalHash -> STM ProjectPath -> Lsp () -ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar getLatestProjectPath = do +ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar getLatestProjectRootHash getLatestProjectPath = do Env {codebase, completionsVar} <- ask - let loop :: ProjectPath -> Lsp a - loop currentProjectPath = do + let loop :: CausalHash -> ProjectPath -> Lsp a + loop currentProjectRootHash currentProjectPath = do currentBranch <- liftIO $ Codebase.expectProjectBranchRoot codebase (currentProjectPath ^. #branch . #projectId) (currentProjectPath ^. #branch . #branchId) Debug.debugM Debug.LSP "LSP path: " currentProjectPath let currentBranch0 = Branch.head currentBranch @@ -47,16 +49,18 @@ ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar getLatestPro atomically do writeTMVar completionsVar (namesToCompletionTree currentNames) Debug.debugLogM Debug.LSP "LSP Initialized" - latest <- atomically $ do + (latestRootHash, latestProjectPath) <- atomically $ do + latestRootHash <- getLatestProjectRootHash latestPath <- getLatestProjectPath - guard $ (currentProjectPath /= latestPath) - pure latestPath + guard $ (currentProjectRootHash /= latestRootHash || currentProjectPath /= latestPath) + pure (latestRootHash, latestPath) Debug.debugLogM Debug.LSP "LSP Change detected" - loop latest - currentProjectPath <- atomically $ do + loop latestRootHash latestProjectPath + (currentProjectRootHash, currentProjectPath) <- atomically $ do + latestProjectRootHash <- getLatestProjectRootHash currentProjectPath <- getLatestProjectPath - pure currentProjectPath - loop currentProjectPath + pure (latestProjectRootHash, currentProjectPath) + loop currentProjectRootHash currentProjectPath where -- This is added in stm-2.5.1, remove this if we upgrade. writeTMVar :: TMVar a -> a -> STM () From 7aabcf5d8927408b181a95e15f9c110ef2316c9e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Jun 2024 10:43:53 -0700 Subject: [PATCH 153/631] Fix up Execute --- .../src/Unison/Codebase/Execute.hs | 27 ++++++-- unison-cli/src/Unison/Main.hs | 62 +++++++++++-------- 2 files changed, 58 insertions(+), 31 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Execute.hs b/parser-typechecker/src/Unison/Codebase/Execute.hs index 1149c5ee79..788bc5abe1 100644 --- a/parser-typechecker/src/Unison/Codebase/Execute.hs +++ b/parser-typechecker/src/Unison/Codebase/Execute.hs @@ -7,15 +7,22 @@ module Unison.Codebase.Execute where import Control.Exception (finally) import Control.Monad.Except +import U.Codebase.Sqlite.Project (Project (..)) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.Queries qualified as Q import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.MainTerm (getMainTerm) import Unison.Codebase.MainTerm qualified as MainTerm +import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPathG (..)) +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) import Unison.Codebase.Runtime qualified as Runtime import Unison.HashQualified qualified as HQ -import Unison.Name (Name) -import Unison.Names (Names) import Unison.Parser.Ann (Ann) +import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE import Unison.Symbol (Symbol) import Unison.Syntax.HashQualified qualified as HQ (toText) @@ -24,14 +31,22 @@ import Unison.Util.Pretty qualified as P execute :: Codebase.Codebase IO Symbol Ann -> Runtime Symbol -> - Names -> - HQ.HashQualified Name -> + PP.ProjectPathNames -> IO (Either Runtime.Error ()) -execute codebase runtime names mainName = +execute codebase runtime mainPath = (`finally` Runtime.terminate runtime) . runExceptT $ do + (project, branch) <- ExceptT $ (Codebase.runTransactionWithRollback codebase) \rollback -> do + project <- Q.loadProjectByName mainPath.project `whenNothingM` rollback (Left . P.text $ ("Project not found: " <> into @Text mainPath.project)) + branch <- Q.loadProjectBranchByName project.projectId mainPath.branch `whenNothingM` rollback (Left . P.text $ ("Branch not found: " <> into @Text mainPath.branch)) + pure . Right $ (project, branch) + projectRootNames <- fmap (Branch.toNames . Branch.head) . liftIO $ Codebase.expectProjectBranchRoot codebase project.projectId branch.branchId let loadTypeOfTerm = Codebase.getTypeOfTerm codebase let mainType = Runtime.mainType runtime - mt <- liftIO $ Codebase.runTransaction codebase $ getMainTerm loadTypeOfTerm names mainName mainType + mainName <- case Path.toName (mainPath ^. PP.path_) of + Just n -> pure (HQ.NameOnly n) + Nothing -> throwError ("Path must lead to an executable term: " <> P.text (Path.toText (PP.path mainPath))) + + mt <- liftIO $ Codebase.runTransaction codebase $ getMainTerm loadTypeOfTerm projectRootNames mainName mainType case mt of MainTerm.NotFound s -> throwError ("Not found: " <> P.text (HQ.toText s)) MainTerm.BadType s _ -> throwError (P.text (HQ.toText s) <> " is not of type '{IO} ()") diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index 97d9700fd7..1149589063 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -48,6 +48,7 @@ import System.Directory ) import System.Environment (getExecutablePath, getProgName, withArgs) import System.Exit qualified as Exit +import System.Exit qualified as System import System.FilePath ( replaceExtension, takeDirectory, @@ -62,6 +63,7 @@ import System.IO.Temp qualified as Temp import System.Path qualified as Path import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.Queries qualified as Queries +import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase, CodebasePath) import Unison.Codebase qualified as Codebase import Unison.Codebase.Editor.Input qualified as Input @@ -159,7 +161,7 @@ main version = do Run (RunFromSymbol mainName) args -> do getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, _, theCodebase) -> do RTI.withRuntime False RTI.OneOff (Version.gitDescribeWithDate version) \runtime -> do - withArgs args (execute theCodebase runtime _ mainName) >>= \case + withArgs args (execute theCodebase runtime mainName) >>= \case Left err -> exitError err Right () -> pure () Run (RunFromFile file mainName) args @@ -175,7 +177,7 @@ main version = do let noOpRootNotifier _ = pure () let noOpPathNotifier _ = pure () let serverUrl = Nothing - let startPath = Nothing + startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath launch version currentDir @@ -186,7 +188,7 @@ main version = do theCodebase [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] serverUrl - startPath + (PP.toIds startProjectPath) initRes noOpRootNotifier noOpPathNotifier @@ -202,7 +204,7 @@ main version = do let noOpRootNotifier _ = pure () let noOpPathNotifier _ = pure () let serverUrl = Nothing - let startPath = Nothing + startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath launch version currentDir @@ -213,7 +215,7 @@ main version = do theCodebase [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] serverUrl - startPath + (PP.toIds startProjectPath) initRes noOpRootNotifier noOpPathNotifier @@ -287,32 +289,42 @@ main version = do case mrtsStatsFp of Nothing -> action Just fp -> recordRtsStats fp action - Launch isHeadless codebaseServerOpts mayStartingPath shouldWatchFiles -> do + Launch isHeadless codebaseServerOpts mayStartingProject shouldWatchFiles -> do getCodebaseOrExit mCodePathOption (SC.MigrateAfterPrompt SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do withRuntimes nrtp RTI.Persistent \(runtime, sbRuntime, nRuntime) -> do - startingPath <- case isHeadless of - WithCLI -> do - -- If the user didn't provide a starting path on the command line, put them in the most recent - -- path they cd'd to - case mayStartingPath of - Just startingPath -> pure startingPath - Nothing -> do - Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath - Headless -> pure $ fromMaybe defaultInitialPath mayStartingPath + startingProjectPath <- do + -- If the user didn't provide a starting path on the command line, put them in the most recent + -- path they cd'd to + case mayStartingProject of + Just startingProject -> do + Codebase.runTransaction theCodebase (ProjectUtils.getProjectAndBranchByNames startingProject) >>= \case + Nothing -> do + PT.putPrettyLn $ + P.callout + "❓" + ( P.lines + [ P.indentN 2 "I couldn't find the project branch: " <> P.text (into @Text startingProject) + ] + ) + System.exitFailure + Just pab -> do + pure $ PP.fromProjectAndBranch pab Path.absoluteEmpty + Nothing -> do + Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath rootCausalHash <- Codebase.runTransaction theCodebase (Queries.expectNamespaceRoot >>= Queries.expectCausalHash) - rootCausalHashVar <- newTVarIO rootCausalHash - pathVar <- newTVarIO startingPath + projectRootHashVar <- newTVarIO rootCausalHash + projectPathVar <- newTVarIO startingProjectPath let notifyOnRootChanges :: CausalHash -> STM () notifyOnRootChanges b = do - writeTVar rootCausalHashVar b - let notifyOnPathChanges :: Path.Absolute -> STM () - notifyOnPathChanges = writeTVar pathVar + writeTVar projectRootHashVar b + let notifyOnPathChanges :: PP.ProjectPath -> STM () + notifyOnPathChanges = writeTVar projectPathVar -- Unfortunately, the windows IO manager on GHC 8.* is prone to just hanging forever -- when waiting for input on handles, so if we listen for LSP connections it will -- prevent UCM from shutting down properly. Hopefully we can re-enable LSP on -- Windows when we move to GHC 9.* -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1224 - void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime (readTVar rootCausalHashVar) (readTVar pathVar) + void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime (readTVar projectRootHashVar) (readTVar projectPathVar) Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) codebaseServerOpts sbRuntime theCodebase $ \baseUrl -> do case exitOption of DoNotExit -> do @@ -346,7 +358,7 @@ main version = do theCodebase [] (Just baseUrl) - (Just startingPath) + (PP.toIds startingProjectPath) initRes notifyOnRootChanges notifyOnPathChanges @@ -525,10 +537,10 @@ launch :: PP.ProjectPathIds -> InitResult -> (CausalHash -> STM ()) -> - (Path.Absolute -> STM ()) -> + (PP.ProjectPath -> STM ()) -> CommandLine.ShouldWatchFiles -> IO () -launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl startingPath initResult notifyRootChange notifyPathChange shouldWatchFiles = do +launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl startingPath initResult notifyRootChange notifyProjPathChange shouldWatchFiles = do showWelcomeHint <- Codebase.runTransaction codebase Queries.doProjectsExist let isNewCodebase = case initResult of CreatedCodebase -> NewlyCreatedCodebase @@ -548,7 +560,7 @@ launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseU serverBaseUrl ucmVersion notifyRootChange - notifyPathChange + notifyProjPathChange shouldWatchFiles newtype MarkdownFile = MarkdownFile FilePath From 95fd37ad3fff82e987d80318382ccf3ba7b369c9 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Jun 2024 12:39:33 -0700 Subject: [PATCH 154/631] Bootstrap scratch project in migration --- .../Migrations/MigrateSchema16To17.hs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs index 269f88de43..1a462706fc 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs @@ -3,12 +3,27 @@ module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 (migrateSchema16To17) where +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q +import Unison.Codebase qualified as Codebase +import Unison.Codebase.SqliteCodebase.Operations qualified as Ops +import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName), ProjectName (UnsafeProjectName)) import Unison.Sqlite qualified as Sqlite --- | This migration adds the causal_object_id column to the project_branches table. +-- | This migration adds a new table to the schema, `currentProjectPath`, and sets it to contain the path to the scratch project. migrateSchema16To17 :: Sqlite.Transaction () migrateSchema16To17 = do Q.expectSchemaVersion 16 + scratchMain <- + Q.loadProjectBranchByNames scratchProjectName scratchBranchName >>= \case + Just pb -> pure pb + Nothing -> do + (_, emptyCausalHashId) <- Codebase.emptyCausalHash + (_proj, pb) <- Ops.insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId + pure pb Q.addCurrentProjectPathTable + Q.setCurrentProjectPath scratchMain.projectId scratchMain.branchId [] Q.setSchemaVersion 17 + where + scratchProjectName = UnsafeProjectName "scratch" + scratchBranchName = UnsafeProjectBranchName "main" From 53923da774dc1db7cf9f52e30278f7cb6a875983 Mon Sep 17 00:00:00 2001 From: Eduard Date: Wed, 12 Jun 2024 21:54:43 +0100 Subject: [PATCH 155/631] No longer need special instructions for Mac Silicon. --- README.md | 2 - docs/m1-mac-setup-tips.markdown | 164 -------------------------------- 2 files changed, 166 deletions(-) delete mode 100644 docs/m1-mac-setup-tips.markdown diff --git a/README.md b/README.md index 3a857d3801..ee703bcc22 100644 --- a/README.md +++ b/README.md @@ -43,8 +43,6 @@ If these instructions don't work for you or are incomplete, please file an issue The build uses [Stack](http://docs.haskellstack.org/). If you don't already have it installed, [follow the install instructions](http://docs.haskellstack.org/en/stable/README.html#how-to-install) for your platform. (Hint: `brew update && brew install stack`) -If you have not set up the Haskell toolchain before and are trying to contribute to Unison on an M1 Mac, we have [some tips specifically for you](docs/m1-mac-setup-tips.markdown). - ```sh $ git clone https://github.com/unisonweb/unison.git $ cd unison diff --git a/docs/m1-mac-setup-tips.markdown b/docs/m1-mac-setup-tips.markdown deleted file mode 100644 index 207e2382cf..0000000000 --- a/docs/m1-mac-setup-tips.markdown +++ /dev/null @@ -1,164 +0,0 @@ - -# M1 Mac Haskell toolchain setup - -If you are a newcomer to the Haskell ecosystem trying to set up your dev environment on a Mac M1 computer, welcome, you can do this! The tips in this document provide one way to get a working development setup, but are not the only path forward. If you haven't downloaded the Haskell toolchain before, our recommendation is to use GHCup. We've found that issues can arise if you mix ARM native binaries with x86 binaries to be run with Rosetta. If you're a veteran Haskell developer, much of this won't apply to you as it's likely you already have a working development environment. - -Here is a working set of versions you can use to build the Unison executable: - -- GHC version: 8.10.7 -- Stack version: 2.9.1 -- Cabal version 3.6.2.0 -- Haskell language server version: 1.7.0.0 - -The GHC version for the project can be confirmed by looking at the `resolver` key in this project's `stack.yaml`. - -## Newcomer setup tips - -[Install GHCup using the instructions on their website.](https://www.haskell.org/ghcup/) Once it's installed make sure `ghcup` is on your path. - -``` -export PATH="$HOME/.ghcup/bin:$PATH" -``` - -GHCup has a nice ui for setting Haskell toolchain versions for the project. Enter `ghcup tui` to open it up and follow the instructions for installing and setting the versions there. GHCup will try to download M1 native binaries for the versions given. - -Check your clang version. For [hand-wavey reasons](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/301) we recommend you use llvm version 12. See troubleshooting note below about changing your LLVM if your version is different. - -```shell -$ clang --version -Homebrew clang version 12.0.1 -Target: arm64-apple-darwin20.2.0 -Thread model: posix -InstalledDir: /opt/homebrew/opt/llvm@12/bin -``` - -At the end of the process you should see something like the following for executable locations and versions. - -```shell -$ which ghcup -~/.ghcup/bin/ghcup -$ ghcup --version -The GHCup Haskell installer, version 0.1.19.0 -``` - -```bash -$ which stack -~/.ghcup/bin/stack -$ stack --version -Version 2.9.1, Git revision 13c9c8772a6dce093dbeacc08bb5877bdb6cfc2e (dirty) (155 commits) aarch64 -``` - -```shell -$ which ghc -~/.ghcup/bin/ghc -$ ghc --version -The Glorious Glasgow Haskell Compilation System, version 8.10.7 -``` - -Check which GHC version Stack thinks it's using too, for good measure: - -```shell -$ stack ghc -- --version -The Glorious Glasgow Haskell Compilation System, version 8.10.7 -$ stack exec -- which ghc -~/.ghcup/ghc/8.10.7/bin/ghc -``` - -```shell -$ which haskell-language-server-wrapper -~/.ghcup/bin/haskell-language-server-wrapper -$ haskell-language-server-wrapper - -Found "...unison/hie.yaml" for "...unison/a" -Run entered for haskell-language-server-wrapper(haskell-language-server-wrapper) Version 1.7.0.0 aarch64 ghc-9.2.2 -Current directory: ...unison -Operating system: darwin -Arguments: [] -Cradle directory: ...unison -Cradle type: Stack - -Tool versions found on the $PATH -cabal: 3.6.2.0 -stack: 2.9.1 -ghc: 8.10.7 -``` - -If you're a VS Code user, you can download the Haskell extension for IDE support. You may need to configure it in `settings.json`. - -```json - "haskell.manageHLS": "GHCup", - "haskell.toolchain": { - "stack": "2.9.1", - "ghc": "8.10.7", - "cabal": "recommended", - "hls": "1.7.0.0" - } -``` - -These setting blocks say that the VS Code extension will use GHCup for your Haskell language server distribution, and sets the versions for elements in the toolchain. - -## Troubleshooting: - -The VS Code extension has compiled a helpful list of troubleshooting steps here: https://github.com/haskell/vscode-haskell#troubleshooting - -### "Couldn't figure out LLVM version" or "failed to compile a sanity check" errors - -``` -: error: - Warning: Couldn't figure out LLVM version! - Make sure you have installed LLVM between [9 and 13) -ghc: could not execute: opt -``` - -Or - -``` -ld: symbol(s) not found for architecture x86_64 -clang: error: linker command failed with exit code 1 (use -v to see invocation) -`gcc' failed in phase `Linker'. (Exit code: 1) -``` - -Try installing llvm version 12 -`brew install llvm@12` - -and prepend it to your path -``` -export PATH="$(brew --prefix)/opt/llvm@12/bin:$PATH" -``` - -(The GHC version 8.10.7 mentions it supports LLVM versions up to 12. https://www.haskell.org/ghc/download_ghc_8_10_7.html) - -### "GHC ABIs don't match!" - -Follow the steps here: - -https://github.com/haskell/vscode-haskell#ghc-abis-dont-match - -We found some success telling Stack to use the system's GHC instead of managing its own version of GHC. You can try this by setting the following two configuration flags in ~/.stack/config.yaml - -``` -system-ghc: true -install-ghc: false -``` - -This is telling Stack to use the GHC executable that it finds on your $PATH. Make sure the ghc being provided is the proper version, 8.10.7, from ghcup. - -Note that you may need to clean the cache for the project after this failure with `stack clean --full` if you have previously built things with a different stack distribution. - -### "stack" commands like "stack build" cause a segfault: - -1. Make sure your stack state is clean. `stack clean --full` removes the project's stack work directories (things in .stack-work). -2. [Wait for this bug to be fixed (or help fix this bug!)](https://github.com/commercialhaskell/stack/issues/5607) -3. Or subshell out your stack commands `$(stack commandHere)` -4. Or use bash instead of zsh - -### Help! Everything is broken and I want to start over - -Warning, the following will remove ghcup, configuration files, cached packages, and versions of the toolchain. - -``` -ghcup nuke -rm -rf ~/.ghcup -rm -rf ~/.stack -rm -rf ~/.cabal -``` From 203f2ce0c20a8d9b81d3eb8551351eb9095ee3da Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Jun 2024 12:39:33 -0700 Subject: [PATCH 156/631] Add better callstacks to sqlite exceptions. --- .../src/Unison/Sqlite/Connection.hs | 34 ++++++------- .../src/Unison/Sqlite/Exception.hs | 10 ++-- .../src/Unison/Sqlite/Transaction.hs | 48 +++++++++---------- 3 files changed, 46 insertions(+), 46 deletions(-) diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs b/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs index f46917ddc8..d749559298 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs @@ -151,7 +151,7 @@ logQuery (Sql sql params) result = -- Without results -execute :: Connection -> Sql -> IO () +execute :: HasCallStack => Connection -> Sql -> IO () execute conn@(Connection _ _ conn0) sql@(Sql s params) = do logQuery sql Nothing doExecute `catch` \(exception :: Sqlite.SQLError) -> @@ -171,7 +171,7 @@ execute conn@(Connection _ _ conn0) sql@(Sql s params) = do -- | Execute one or more semicolon-delimited statements. -- -- This function does not support parameters, and is mostly useful for executing DDL and migrations. -executeStatements :: Connection -> Text -> IO () +executeStatements :: HasCallStack => Connection -> Text -> IO () executeStatements conn@(Connection _ _ (Sqlite.Connection database)) sql = do logQuery (Sql sql []) Nothing Direct.Sqlite.exec database sql `catch` \(exception :: Sqlite.SQLError) -> @@ -184,7 +184,7 @@ executeStatements conn@(Connection _ _ (Sqlite.Connection database)) sql = do -- With results, without checks -queryStreamRow :: Sqlite.FromRow a => Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r +queryStreamRow :: (HasCallStack, Sqlite.FromRow a) => Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r queryStreamRow conn@(Connection _ _ conn0) sql@(Sql s params) callback = run `catch` \(exception :: Sqlite.SQLError) -> throwSqliteQueryException @@ -201,7 +201,7 @@ queryStreamRow conn@(Connection _ _ conn0) sql@(Sql s params) callback = queryStreamCol :: forall a r. - (Sqlite.FromField a) => + (HasCallStack, Sqlite.FromField a) => Connection -> Sql -> (IO (Maybe a) -> IO r) -> @@ -212,7 +212,7 @@ queryStreamCol = @(Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r) queryStreamRow -queryListRow :: forall a. (Sqlite.FromRow a) => Connection -> Sql -> IO [a] +queryListRow :: forall a. (Sqlite.FromRow a, HasCallStack) => Connection -> Sql -> IO [a] queryListRow conn@(Connection _ _ conn0) sql@(Sql s params) = do result <- doQuery @@ -237,35 +237,35 @@ queryListRow conn@(Connection _ _ conn0) sql@(Sql s params) = do Just row -> loop (row : rows) loop [] -queryListCol :: forall a. (Sqlite.FromField a) => Connection -> Sql -> IO [a] +queryListCol :: forall a. (Sqlite.FromField a, HasCallStack) => Connection -> Sql -> IO [a] queryListCol = coerce @(Connection -> Sql -> IO [Sqlite.Only a]) @(Connection -> Sql -> IO [a]) queryListRow -queryMaybeRow :: (Sqlite.FromRow a) => Connection -> Sql -> IO (Maybe a) +queryMaybeRow :: (Sqlite.FromRow a, HasCallStack) => Connection -> Sql -> IO (Maybe a) queryMaybeRow conn s = queryListRowCheck conn s \case [] -> Right Nothing [x] -> Right (Just x) xs -> Left (ExpectedAtMostOneRowException (anythingToString xs)) -queryMaybeCol :: forall a. (Sqlite.FromField a) => Connection -> Sql -> IO (Maybe a) +queryMaybeCol :: forall a. (Sqlite.FromField a, HasCallStack) => Connection -> Sql -> IO (Maybe a) queryMaybeCol conn s = coerce @(IO (Maybe (Sqlite.Only a))) @(IO (Maybe a)) (queryMaybeRow conn s) -queryOneRow :: (Sqlite.FromRow a) => Connection -> Sql -> IO a +queryOneRow :: (Sqlite.FromRow a, HasCallStack) => Connection -> Sql -> IO a queryOneRow conn s = queryListRowCheck conn s \case [x] -> Right x xs -> Left (ExpectedExactlyOneRowException (anythingToString xs)) -queryOneCol :: forall a. (Sqlite.FromField a) => Connection -> Sql -> IO a +queryOneCol :: forall a. (Sqlite.FromField a, HasCallStack) => Connection -> Sql -> IO a queryOneCol conn s = do coerce @(IO (Sqlite.Only a)) @(IO a) (queryOneRow conn s) -- With results, with checks queryListRowCheck :: - (Sqlite.FromRow a, SqliteExceptionReason e) => + (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) => Connection -> Sql -> ([a] -> Either e r) -> @@ -274,7 +274,7 @@ queryListRowCheck conn s check = gqueryListCheck conn s (mapLeft SomeSqliteExceptionReason . check) gqueryListCheck :: - (Sqlite.FromRow a) => + (Sqlite.FromRow a, HasCallStack) => Connection -> Sql -> ([a] -> Either SomeSqliteExceptionReason r) -> @@ -293,7 +293,7 @@ gqueryListCheck conn sql check = do queryListColCheck :: forall a e r. - (Sqlite.FromField a, SqliteExceptionReason e) => + (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) => Connection -> Sql -> ([a] -> Either e r) -> @@ -302,7 +302,7 @@ queryListColCheck conn s check = queryListRowCheck conn s (coerce @([a] -> Either e r) @([Sqlite.Only a] -> Either e r) check) queryMaybeRowCheck :: - (Sqlite.FromRow a, SqliteExceptionReason e) => + (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) => Connection -> Sql -> (a -> Either e r) -> @@ -315,7 +315,7 @@ queryMaybeRowCheck conn s check = queryMaybeColCheck :: forall a e r. - (Sqlite.FromField a, SqliteExceptionReason e) => + (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) => Connection -> Sql -> (a -> Either e r) -> @@ -324,7 +324,7 @@ queryMaybeColCheck conn s check = queryMaybeRowCheck conn s (coerce @(a -> Either e r) @(Sqlite.Only a -> Either e r) check) queryOneRowCheck :: - (Sqlite.FromRow a, SqliteExceptionReason e) => + (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) => Connection -> Sql -> (a -> Either e r) -> @@ -336,7 +336,7 @@ queryOneRowCheck conn s check = queryOneColCheck :: forall a e r. - (Sqlite.FromField a, SqliteExceptionReason e) => + (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) => Connection -> Sql -> (a -> Either e r) -> diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs b/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs index cf760c4936..a573727461 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs @@ -24,7 +24,8 @@ where import Control.Concurrent (ThreadId, myThreadId) import Data.Typeable (cast) import Database.SQLite.Simple qualified as Sqlite -import GHC.Stack (currentCallStack) +import GHC.Stack (CallStack) +import GHC.Stack qualified as Stack import Unison.Prelude import Unison.Sqlite.Connection.Internal (Connection) import Unison.Sqlite.Sql (Sql (..)) @@ -112,7 +113,7 @@ data SqliteQueryException = SqliteQueryException -- | The inner exception. It is intentionally not 'SomeException', so that calling code cannot accidentally -- 'throwIO' domain-specific exception types, but must instead use a @*Check@ query variant. exception :: SomeSqliteExceptionReason, - callStack :: [String], + callStack :: CallStack, connection :: Connection, threadId :: ThreadId } @@ -137,16 +138,15 @@ data SqliteQueryExceptionInfo = SqliteQueryExceptionInfo exception :: SomeSqliteExceptionReason } -throwSqliteQueryException :: SqliteQueryExceptionInfo -> IO a +throwSqliteQueryException :: HasCallStack => SqliteQueryExceptionInfo -> IO a throwSqliteQueryException SqliteQueryExceptionInfo {connection, exception, sql = Sql sql params} = do threadId <- myThreadId - callStack <- currentCallStack throwIO SqliteQueryException { sql, params, exception, - callStack, + callStack = Stack.callStack, connection, threadId } diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs b/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs index 49a5e01aa8..e40f4a7639 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs @@ -88,7 +88,7 @@ instance MonadIO TransactionWithMonadIO where coerce @(IO a -> Transaction a) unsafeIO -- | Run a transaction on the given connection. -runTransaction :: (MonadIO m) => Connection -> Transaction a -> m a +runTransaction :: (MonadIO m, HasCallStack) => Connection -> Transaction a -> m a runTransaction conn (Transaction f) = liftIO do uninterruptibleMask \restore -> do Connection.begin conn @@ -117,7 +117,7 @@ instance Show RollingBack where -- | Run a transaction on the given connection, providing a function that can short-circuit (and roll back) the -- transaction. runTransactionWithRollback :: - (MonadIO m) => + (MonadIO m, HasCallStack) => Connection -> ((forall void. a -> Transaction void) -> Transaction a) -> m a @@ -137,13 +137,13 @@ runTransactionWithRollback conn transaction = liftIO do -- -- The transaction is never retried, so it is (more) safe to interleave arbitrary IO actions. If the transaction does -- attempt a write and gets SQLITE_BUSY, it's your fault! -runReadOnlyTransaction :: (MonadUnliftIO m) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a +runReadOnlyTransaction :: (MonadUnliftIO m, HasCallStack) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a runReadOnlyTransaction conn f = withRunInIO \runInIO -> runReadOnlyTransaction_ conn (runInIO (f (\transaction -> liftIO (unsafeUnTransaction transaction conn)))) {-# SPECIALIZE runReadOnlyTransaction :: Connection -> ((forall x. Transaction x -> IO x) -> IO a) -> IO a #-} -runReadOnlyTransaction_ :: Connection -> IO a -> IO a +runReadOnlyTransaction_ :: HasCallStack => Connection -> IO a -> IO a runReadOnlyTransaction_ conn action = do bracketOnError_ (Connection.begin conn) @@ -160,7 +160,7 @@ runReadOnlyTransaction_ conn action = do -- BEGIN/COMMIT statements. -- -- The transaction is never retried, so it is (more) safe to interleave arbitrary IO actions. -runWriteTransaction :: (MonadUnliftIO m) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a +runWriteTransaction :: (HasCallStack, MonadUnliftIO m) => Connection -> ((forall x. Transaction x -> m x) -> m a) -> m a runWriteTransaction conn f = withRunInIO \runInIO -> uninterruptibleMask \restore -> @@ -170,7 +170,7 @@ runWriteTransaction conn f = (runInIO (f (\transaction -> liftIO (unsafeUnTransaction transaction conn)))) {-# SPECIALIZE runWriteTransaction :: Connection -> ((forall x. Transaction x -> IO x) -> IO a) -> IO a #-} -runWriteTransaction_ :: (forall x. IO x -> IO x) -> Connection -> IO a -> IO a +runWriteTransaction_ :: HasCallStack => (forall x. IO x -> IO x) -> Connection -> IO a -> IO a runWriteTransaction_ restore conn transaction = do keepTryingToBeginImmediate restore conn result <- restore transaction `onException` ignoringExceptions (Connection.rollback conn) @@ -178,7 +178,7 @@ runWriteTransaction_ restore conn transaction = do pure result -- @BEGIN IMMEDIATE@ until success. -keepTryingToBeginImmediate :: (forall x. IO x -> IO x) -> Connection -> IO () +keepTryingToBeginImmediate :: HasCallStack => (forall x. IO x -> IO x) -> Connection -> IO () keepTryingToBeginImmediate restore conn = let loop = try @_ @SqliteQueryException (Connection.beginImmediate conn) >>= \case @@ -217,7 +217,7 @@ savepoint (Transaction action) = do -- transaction needs to retry. -- -- /Warning/: attempting to run a transaction inside a transaction will cause an exception! -unsafeIO :: IO a -> Transaction a +unsafeIO :: HasCallStack => IO a -> Transaction a unsafeIO action = Transaction \_ -> action @@ -232,18 +232,18 @@ unsafeUnTransaction (Transaction action) = -- Without results -execute :: Sql -> Transaction () +execute :: HasCallStack => Sql -> Transaction () execute s = Transaction \conn -> Connection.execute conn s -executeStatements :: Text -> Transaction () +executeStatements :: HasCallStack => Text -> Transaction () executeStatements s = Transaction \conn -> Connection.executeStatements conn s -- With results, without checks queryStreamRow :: - (Sqlite.FromRow a) => + (Sqlite.FromRow a, HasCallStack) => Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r @@ -254,7 +254,7 @@ queryStreamRow sql callback = queryStreamCol :: forall a r. - (Sqlite.FromField a) => + (Sqlite.FromField a, HasCallStack) => Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r @@ -264,34 +264,34 @@ queryStreamCol = @(Sql -> (Transaction (Maybe a) -> Transaction r) -> Transaction r) queryStreamRow -queryListRow :: (Sqlite.FromRow a) => Sql -> Transaction [a] +queryListRow :: (Sqlite.FromRow a, HasCallStack) => Sql -> Transaction [a] queryListRow s = Transaction \conn -> Connection.queryListRow conn s -queryListCol :: (Sqlite.FromField a) => Sql -> Transaction [a] +queryListCol :: (Sqlite.FromField a, HasCallStack) => Sql -> Transaction [a] queryListCol s = Transaction \conn -> Connection.queryListCol conn s -queryMaybeRow :: (Sqlite.FromRow a) => Sql -> Transaction (Maybe a) +queryMaybeRow :: (Sqlite.FromRow a, HasCallStack) => Sql -> Transaction (Maybe a) queryMaybeRow s = Transaction \conn -> Connection.queryMaybeRow conn s -queryMaybeCol :: (Sqlite.FromField a) => Sql -> Transaction (Maybe a) +queryMaybeCol :: (Sqlite.FromField a, HasCallStack) => Sql -> Transaction (Maybe a) queryMaybeCol s = Transaction \conn -> Connection.queryMaybeCol conn s -queryOneRow :: (Sqlite.FromRow a) => Sql -> Transaction a +queryOneRow :: (Sqlite.FromRow a, HasCallStack) => Sql -> Transaction a queryOneRow s = Transaction \conn -> Connection.queryOneRow conn s -queryOneCol :: (Sqlite.FromField a) => Sql -> Transaction a +queryOneCol :: (Sqlite.FromField a, HasCallStack) => Sql -> Transaction a queryOneCol s = Transaction \conn -> Connection.queryOneCol conn s -- With results, with parameters, with checks queryListRowCheck :: - (Sqlite.FromRow a, SqliteExceptionReason e) => + (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) => Sql -> ([a] -> Either e r) -> Transaction r @@ -299,7 +299,7 @@ queryListRowCheck sql check = Transaction \conn -> Connection.queryListRowCheck conn sql check queryListColCheck :: - (Sqlite.FromField a, SqliteExceptionReason e) => + (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) => Sql -> ([a] -> Either e r) -> Transaction r @@ -307,7 +307,7 @@ queryListColCheck sql check = Transaction \conn -> Connection.queryListColCheck conn sql check queryMaybeRowCheck :: - (Sqlite.FromRow a, SqliteExceptionReason e) => + (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction (Maybe r) @@ -315,7 +315,7 @@ queryMaybeRowCheck s check = Transaction \conn -> Connection.queryMaybeRowCheck conn s check queryMaybeColCheck :: - (Sqlite.FromField a, SqliteExceptionReason e) => + (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction (Maybe r) @@ -323,7 +323,7 @@ queryMaybeColCheck s check = Transaction \conn -> Connection.queryMaybeColCheck conn s check queryOneRowCheck :: - (Sqlite.FromRow a, SqliteExceptionReason e) => + (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction r @@ -331,7 +331,7 @@ queryOneRowCheck s check = Transaction \conn -> Connection.queryOneRowCheck conn s check queryOneColCheck :: - (Sqlite.FromField a, SqliteExceptionReason e) => + (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) => Sql -> (a -> Either e r) -> Transaction r From d53f26775c754a74889c5c7f4b28da4d7dc560e7 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Jun 2024 12:39:33 -0700 Subject: [PATCH 157/631] Create scratch project during codebase creation --- .../U/Codebase/Sqlite/Operations.hs | 14 +++++ .../U/Codebase/Sqlite/ProjectReflog.hs | 37 +++++++++++ .../U/Codebase/Sqlite/Queries.hs | 62 +++++++++++-------- codebase2/codebase-sqlite/package.yaml | 1 + .../013-add-project-branch-reflog-table.sql | 26 ++++++++ .../unison-codebase-sqlite.cabal | 3 + parser-typechecker/src/Unison/Codebase.hs | 14 +---- .../src/Unison/Codebase/SqliteCodebase.hs | 4 +- .../Codebase/SqliteCodebase/Operations.hs | 41 +++++++++++- 9 files changed, 162 insertions(+), 40 deletions(-) create mode 100644 codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs create mode 100644 codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index c3965c1432..39dcd072ed 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -101,6 +101,8 @@ module U.Codebase.Sqlite.Operations -- * reflog getReflog, appendReflog, + getProjectReflog, + appendProjectReflog, -- * low-level stuff expectDbBranch, @@ -183,6 +185,7 @@ import U.Codebase.Sqlite.Patch.TypeEdit qualified as S import U.Codebase.Sqlite.Patch.TypeEdit qualified as S.TypeEdit import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Reference qualified as S import U.Codebase.Sqlite.Reference qualified as S.Reference @@ -1455,6 +1458,17 @@ appendReflog entry = do dbEntry <- (bitraverse Q.saveCausalHash pure) entry Q.appendReflog dbEntry +-- | Gets the specified number of reflog entries in chronological order, most recent first. +getProjectReflog :: Int -> Transaction [ProjectReflog.Entry CausalHash] +getProjectReflog numEntries = do + entries <- Q.getProjectReflog numEntries + (traverse . traverse) Q.expectCausalHash entries + +appendProjectReflog :: ProjectReflog.Entry CausalHash -> Transaction () +appendProjectReflog entry = do + dbEntry <- traverse Q.saveCausalHash entry + Q.appendProjectReflog dbEntry + -- | Delete any name lookup that's not in the provided list. -- -- This can be used to garbage collect unreachable name lookups. diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs new file mode 100644 index 0000000000..a01bb7a2c6 --- /dev/null +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +module U.Codebase.Sqlite.ProjectReflog where + +import Control.Lens +import Data.Text (Text) +import Data.Time (UTCTime) +import U.Codebase.Sqlite.DbId (CausalHashId, ProjectBranchId, ProjectId) +import Unison.Sqlite (FromRow (..), ToRow (..), field) + +data Entry causal = Entry + { project :: ProjectId, + branch :: ProjectBranchId, + time :: UTCTime, + fromRootCausalHash :: causal, + toRootCausalHash :: causal, + reason :: Text + } + deriving stock (Show, Functor, Foldable, Traversable) + +instance ToRow (Entry CausalHashId) where + toRow (Entry proj branch time fromRootCausalHash toRootCausalHash reason) = + toRow (proj, branch, time, fromRootCausalHash, toRootCausalHash, reason) + +instance FromRow (Entry CausalHashId) where + fromRow = do + project <- field + branch <- field + time <- field + fromRootCausalHash <- field + toRootCausalHash <- field + reason <- field + pure $ Entry {..} + +causals_ :: Traversal (Entry causal) (Entry causal') causal causal' +causals_ f (Entry {..}) = Entry project branch time <$> f fromRootCausalHash <*> f toRootCausalHash <*> pure reason diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index c1ec796c9c..dc4e1de82c 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -217,6 +217,8 @@ module U.Codebase.Sqlite.Queries -- * Reflog appendReflog, getReflog, + appendProjectReflog, + getProjectReflog, -- * garbage collection garbageCollectObjectsWithoutHashes, @@ -242,7 +244,7 @@ module U.Codebase.Sqlite.Queries setCurrentProjectPath, -- * migrations - createSchema, + runCreateSql, addTempEntityTables, addReflogTable, addNamespaceStatsTables, @@ -255,6 +257,7 @@ module U.Codebase.Sqlite.Queries addSquashResultTableIfNotExists, cdToProjectRoot, addCurrentProjectPathTable, + addProjectBranchReflogTable, -- ** schema version currentSchemaVersion, @@ -368,6 +371,7 @@ import U.Codebase.Sqlite.Orphans () import U.Codebase.Sqlite.Patch.Format qualified as PatchFormat import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog import U.Codebase.Sqlite.Reference qualified as Reference import U.Codebase.Sqlite.Reference qualified as S import U.Codebase.Sqlite.Reference qualified as S.Reference @@ -415,27 +419,11 @@ type TextPathSegments = [Text] -- * main squeeze currentSchemaVersion :: SchemaVersion -currentSchemaVersion = 16 +currentSchemaVersion = 17 -createSchema :: Transaction () -createSchema = do +runCreateSql :: Transaction () +runCreateSql = executeStatements $(embedProjectStringFile "sql/create.sql") - addTempEntityTables - addNamespaceStatsTables - addReflogTable - fixScopedNameLookupTables - addProjectTables - addMostRecentBranchTable - addNameLookupMountTables - addMostRecentNamespaceTable - execute insertSchemaVersionSql - addSquashResultTable - where - insertSchemaVersionSql = - [sql| - INSERT INTO schema_version (version) - VALUES (:currentSchemaVersion) - |] addTempEntityTables :: Transaction () addTempEntityTables = @@ -445,6 +433,7 @@ addNamespaceStatsTables :: Transaction () addNamespaceStatsTables = executeStatements $(embedProjectStringFile "sql/003-namespace-statistics.sql") +-- | Deprecated in favour of project-branch reflog addReflogTable :: Transaction () addReflogTable = executeStatements $(embedProjectStringFile "sql/002-reflog-table.sql") @@ -483,6 +472,15 @@ cdToProjectRoot :: Transaction () cdToProjectRoot = executeStatements $(embedProjectStringFile "sql/011-cd-to-project-root.sql") +addCurrentProjectPathTable :: Transaction () +addCurrentProjectPathTable = + executeStatements $(embedProjectStringFile "sql/012-add-current-project-path-table.sql") + +-- | Deprecated in favour of project-branch reflog +addProjectBranchReflogTable :: Transaction () +addProjectBranchReflogTable = + executeStatements $(embedProjectStringFile "sql/013-add-project-branch-reflog-table.sql") + schemaVersion :: Transaction SchemaVersion schemaVersion = queryOneCol @@ -491,10 +489,6 @@ schemaVersion = FROM schema_version |] -addCurrentProjectPathTable :: Transaction () -addCurrentProjectPathTable = - executeStatements $(embedProjectStringFile "sql/012-add-current-project-path-table.sql") - data UnexpectedSchemaVersion = UnexpectedSchemaVersion { actual :: SchemaVersion, expected :: SchemaVersion @@ -3397,6 +3391,24 @@ getReflog numEntries = LIMIT :numEntries |] +appendProjectReflog :: ProjectReflog.Entry CausalHashId -> Transaction () +appendProjectReflog entry = + execute + [sql| + INSERT INTO project_branch_reflog (project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason) + VALUES (@entry, @, @, @, @, @) + |] + +getProjectReflog :: Int -> Transaction [ProjectReflog.Entry CausalHashId] +getProjectReflog numEntries = + queryListRow + [sql| + SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason + FROM project_branch_reflog + ORDER BY time DESC + LIMIT :numEntries + |] + -- | Does a project exist with this id? projectExists :: ProjectId -> Transaction Bool projectExists projectId = @@ -4283,7 +4295,7 @@ data JsonParseFailure = JsonParseFailure deriving anyclass (SqliteExceptionReason) -- | Get the most recent namespace the user has visited. -expectCurrentProjectPath :: Transaction (ProjectId, ProjectBranchId, [NameSegment]) +expectCurrentProjectPath :: HasCallStack => Transaction (ProjectId, ProjectBranchId, [NameSegment]) expectCurrentProjectPath = queryOneRowCheck [sql| diff --git a/codebase2/codebase-sqlite/package.yaml b/codebase2/codebase-sqlite/package.yaml index a04fce3a56..cff3b6823f 100644 --- a/codebase2/codebase-sqlite/package.yaml +++ b/codebase2/codebase-sqlite/package.yaml @@ -27,6 +27,7 @@ dependencies: - nonempty-containers - safe - text + - time - transformers - unison-codebase - unison-codebase-sync diff --git a/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql b/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql new file mode 100644 index 0000000000..d5c66031ae --- /dev/null +++ b/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql @@ -0,0 +1,26 @@ +CREATE TABLE project_branch_reflog ( + project_id INTEGER NOT NULL, + project_branch_id INTEGER NOT NULL, + -- Reminder that SQLITE doesn't have any actual 'time' type, + -- This column contains TEXT values formatted as ISO8601 strings + -- ("YYYY-MM-DD HH:MM:SS.SSS") + time TEXT NOT NULL, + -- from_root_causal_id will be null if the branch was just created + from_root_causal_id INTEGER NULL REFERENCES causal(self_hash_id), + to_root_causal_id INTEGER NOT NULL REFERENCES causal(self_hash_id), + reason TEXT NOT NULL, + + foreign key (project_id, branch_id) + references project_branch (project_id, branch_id) + on delete cascade +); + +CREATE INDEX project_branch_reflog_by_time ON reflog ( + project_branch_id, time DESC +); + + +CREATE INDEX project_reflog_by_time ON reflog ( + project_id, time DESC +); + diff --git a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal index 0791856217..090bc0d204 100644 --- a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal +++ b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal @@ -22,6 +22,7 @@ extra-source-files: sql/010-ensure-squash-cache-table.sql sql/011-cd-to-project-root.sql sql/012-add-current-project-path-table.sql + sql/013-add-project-branch-reflog-table.sql sql/create.sql source-repository head @@ -55,6 +56,7 @@ library U.Codebase.Sqlite.Patch.TypeEdit U.Codebase.Sqlite.Project U.Codebase.Sqlite.ProjectBranch + U.Codebase.Sqlite.ProjectReflog U.Codebase.Sqlite.Queries U.Codebase.Sqlite.Reference U.Codebase.Sqlite.Referent @@ -121,6 +123,7 @@ library , nonempty-containers , safe , text + , time , transformers , unison-codebase , unison-codebase-sync diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 3c1a5bde87..45fd7c50ce 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -106,7 +106,7 @@ module Unison.Codebase toCodeLookup, typeLookupForDependencies, unsafeGetComponentLength, - emptyCausalHash, + SqliteCodebase.Operations.emptyCausalHash, ) where @@ -536,7 +536,7 @@ unsafeGetTermComponent codebase hash = Nothing -> error (reportBug "E769004" ("term component " ++ show hash ++ " not found")) Just terms -> terms -expectCurrentProjectPath :: Sqlite.Transaction PP.ProjectPath +expectCurrentProjectPath :: HasCallStack => Sqlite.Transaction PP.ProjectPath expectCurrentProjectPath = do (projectId, projectBranchId, path) <- Q.expectCurrentProjectPath proj <- Q.expectProject projectId @@ -547,13 +547,3 @@ expectCurrentProjectPath = do setCurrentProjectPath :: PP.ProjectPathIds -> Sqlite.Transaction () setCurrentProjectPath (PP.ProjectPath projectId projectBranchId path) = Q.setCurrentProjectPath projectId projectBranchId (Path.toList (Path.unabsolute path)) - --- | Often we need to assign something to an empty causal, this ensures the empty causal --- exists in the codebase and returns its hash. -emptyCausalHash :: Sqlite.Transaction (CausalHash, Db.CausalHashId) -emptyCausalHash = do - let emptyBranch = Branch.empty - SqliteCodebase.Operations.putBranch emptyBranch - let causalHash = Branch.headHash emptyBranch - causalHashId <- Queries.expectCausalHashIdByCausalHash causalHash - pure (causalHash, causalHashId) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs index 734020509e..1b15f79677 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs @@ -101,7 +101,7 @@ createCodebaseOrError onCreate debugName path lockOption action = do withConnection (debugName ++ ".createSchema") path \conn -> do Sqlite.trySetJournalMode conn Sqlite.JournalMode'WAL Sqlite.runTransaction conn do - Q.createSchema + CodebaseOps.createSchema onCreate sqliteCodebase debugName path Local lockOption DontMigrate action >>= \case @@ -130,7 +130,7 @@ initSchemaIfNotExist path = liftIO do createDirectoryIfMissing True (makeCodebaseDirPath path) unlessM (doesFileExist $ makeCodebasePath path) $ withConnection "initSchemaIfNotExist" path \conn -> - Sqlite.runTransaction conn Q.createSchema + Sqlite.runTransaction conn CodebaseOps.createSchema -- 1) buffer up the component -- 2) in the event that the component is complete, then what? diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index b6a5464f1f..c82e467145 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} -- | This module contains sqlite-specific operations on high-level "parser-typechecker" types all in the Transaction -- monad. @@ -38,6 +40,7 @@ import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle) import Unison.Builtin qualified as Builtins import Unison.Codebase.Branch (Branch (..)) +import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Patch (Patch) import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path @@ -46,7 +49,7 @@ import Unison.Codebase.SqliteCodebase.Branch.Cache (BranchCache) import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType qualified as CT -import Unison.Core.Project (ProjectBranchName, ProjectName) +import Unison.Core.Project (ProjectBranchName (..), ProjectName (..)) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as Decl import Unison.Hash (Hash) @@ -77,6 +80,32 @@ import Unison.Util.Set qualified as Set import Unison.WatchKind qualified as UF import UnliftIO.STM +createSchema :: Transaction () +createSchema = do + Q.runCreateSql + Q.addTempEntityTables + Q.addNamespaceStatsTables + Q.addReflogTable + Q.fixScopedNameLookupTables + Q.addProjectTables + Q.addMostRecentBranchTable + Q.addNameLookupMountTables + Q.addMostRecentNamespaceTable + Sqlite.execute insertSchemaVersionSql + Q.addSquashResultTable + (_, emptyCausalHashId) <- emptyCausalHash + void $ insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId + Q.addProjectBranchReflogTable + where + scratchProjectName = UnsafeProjectName "scratch" + scratchBranchName = UnsafeProjectBranchName "main" + currentSchemaVersion = Q.currentSchemaVersion + insertSchemaVersionSql = + [Sqlite.sql| + INSERT INTO schema_version (version) + VALUES (:currentSchemaVersion) + |] + ------------------------------------------------------------------------------------------------------------------------ -- Buffer entry @@ -740,3 +769,13 @@ insertProjectAndBranch projectName branchName chId = do projectBranch Q.setMostRecentBranch projectId branchId pure (Project {name = projectName, projectId}, ProjectBranch {projectId, name = branchName, branchId, parentBranchId = Nothing}) + +-- | Often we need to assign something to an empty causal, this ensures the empty causal +-- exists in the codebase and returns its hash. +emptyCausalHash :: Sqlite.Transaction (CausalHash, Db.CausalHashId) +emptyCausalHash = do + let emptyBranch = Branch.empty + putBranch emptyBranch + let causalHash = Branch.headHash emptyBranch + causalHashId <- Q.expectCausalHashIdByCausalHash causalHash + pure (causalHash, causalHashId) From 6ba3e87b8586b186e9157de3dd1085351fc6bc4f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Jun 2024 15:07:16 -0700 Subject: [PATCH 158/631] Add to project reflog --- .../U/Codebase/Sqlite/ProjectReflog.hs | 6 +--- .../U/Codebase/Sqlite/Queries.hs | 30 +++++++++++++++---- 2 files changed, 26 insertions(+), 10 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs index a01bb7a2c6..4b7ff67a05 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs @@ -3,7 +3,6 @@ module U.Codebase.Sqlite.ProjectReflog where -import Control.Lens import Data.Text (Text) import Data.Time (UTCTime) import U.Codebase.Sqlite.DbId (CausalHashId, ProjectBranchId, ProjectId) @@ -13,7 +12,7 @@ data Entry causal = Entry { project :: ProjectId, branch :: ProjectBranchId, time :: UTCTime, - fromRootCausalHash :: causal, + fromRootCausalHash :: Maybe causal, toRootCausalHash :: causal, reason :: Text } @@ -32,6 +31,3 @@ instance FromRow (Entry CausalHashId) where toRootCausalHash <- field reason <- field pure $ Entry {..} - -causals_ :: Traversal (Entry causal) (Entry causal') causal causal' -causals_ f (Entry {..}) = Entry project branch time <$> f fromRootCausalHash <*> f toRootCausalHash <*> pure reason diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index dc4e1de82c..bf79576875 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -319,6 +319,7 @@ import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Text.Lazy qualified as Text.Lazy +import Data.Time qualified as Time import Data.Vector qualified as Vector import GHC.Stack (callStack) import Network.URI (URI) @@ -405,6 +406,7 @@ import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.Sqlite +import Unison.Sqlite qualified as Sqlite import Unison.Util.Alternative qualified as Alternative import Unison.Util.FileEmbed (embedProjectStringFile) import Unison.Util.Lens qualified as Lens @@ -3700,12 +3702,10 @@ loadProjectAndBranchNames projectId branchId = -- | Insert a project branch. insertProjectBranch :: Text -> CausalHashId -> ProjectBranch -> Transaction () -insertProjectBranch _description causalHashId (ProjectBranch projectId branchId branchName maybeParentBranchId) = do +insertProjectBranch description causalHashId (ProjectBranch projectId branchId branchName maybeParentBranchId) = do -- Ensure we never point at a causal we don't have the branch for. _ <- expectBranchObjectIdByCausalHashId causalHashId - error "Implement project branch reflog" - execute [sql| INSERT INTO project_branch (project_id, branch_id, name, causal_hash_id) @@ -3717,6 +3717,16 @@ insertProjectBranch _description causalHashId (ProjectBranch projectId branchId INSERT INTO project_branch_parent (project_id, parent_branch_id, branch_id) VALUES (:projectId, :parentBranchId, :branchId) |] + time <- Sqlite.unsafeIO $ Time.getCurrentTime + appendProjectReflog $ + ProjectReflog.Entry + { project = projectId, + branch = branchId, + time, + fromRootCausalHash = Nothing, + toRootCausalHash = causalHashId, + reason = description + } -- | Rename a project branch. -- @@ -3791,16 +3801,26 @@ deleteProjectBranch projectId branchId = do -- | Set project branch HEAD setProjectBranchHead :: Text -> ProjectId -> ProjectBranchId -> CausalHashId -> Transaction () -setProjectBranchHead _description projectId branchId causalHashId = do - error "Implement project branch reflog" +setProjectBranchHead description projectId branchId causalHashId = do -- Ensure we never point at a causal we don't have the branch for. _ <- expectBranchObjectIdByCausalHashId causalHashId + oldRootCausalHashId <- expectProjectBranchHead projectId branchId execute [sql| UPDATE project_branch SET causal_hash_id = :causalHashId WHERE project_id = :projectId AND branch_id = :branchId |] + time <- Sqlite.unsafeIO $ Time.getCurrentTime + appendProjectReflog $ + ProjectReflog.Entry + { project = projectId, + branch = branchId, + time = time, + fromRootCausalHash = Just oldRootCausalHashId, + toRootCausalHash = causalHashId, + reason = description + } expectProjectBranchHead :: ProjectId -> ProjectBranchId -> Transaction CausalHashId expectProjectBranchHead projectId branchId = From e903a1c1556c6385ee5be12b0d0d22f858b6e501 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 13 Jun 2024 08:29:02 -0400 Subject: [PATCH 159/631] add merge.commit failure test --- unison-src/transcripts/merge.md | 23 ++++++++++++++++++++++- unison-src/transcripts/merge.output.md | 21 ++++++++++++++++++++- 2 files changed, 42 insertions(+), 2 deletions(-) diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 1b341fd785..6dd0bdaf91 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -974,7 +974,7 @@ project/alice> merge bob .> project.delete project ``` -## `merge.commit` example +## `merge.commit` example (success) After merge conflicts are resolved, you can use `merge.commit` rather than `switch` + `merge` + `branch.delete` to "commit" your changes. @@ -1040,6 +1040,27 @@ project/alice> branches .> project.delete project ``` +## `merge.commit` example (failure) + +`merge.commit` can only be run on a "merge branch". + +```ucm:hide +.> project.create-empty project +project/main> builtins.mergeio +``` + +```ucm +project/main> branch topic +``` + +```ucm:error +project/topic> merge.commit +``` + +```ucm:hide +.> project.delete project +``` + ## Precondition violations diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 79d4e373d3..8875bb5cc9 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1070,7 +1070,7 @@ bob _ = 19 ``` -## `merge.commit` example +## `merge.commit` example (success) After merge conflicts are resolved, you can use `merge.commit` rather than `switch` + `merge` + `branch.delete` to "commit" your changes. @@ -1173,6 +1173,25 @@ project/alice> branches 2. bob 3. main +``` +## `merge.commit` example (failure) + +`merge.commit` can only be run on a "merge branch". + +```ucm +project/main> branch topic + + Done. I've created the topic branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic`. + +``` +```ucm +project/topic> merge.commit + + It doesn't look like there's a merge in progress. + ``` ## Precondition violations From 84273a556fd170182f9156ad6abfcc14d88b79ad Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 13 Jun 2024 08:36:03 -0400 Subject: [PATCH 160/631] revert tweak to merge failure output --- .../src/Unison/CommandLine/OutputMessages.hs | 2 +- unison-src/transcripts/merge.output.md | 22 +++++++++---------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 370f22f667..bd33365eed 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2089,7 +2089,7 @@ notifyUser dir = \case "I couldn't automatically merge" <> prettyMergeSource aliceAndBob.bob <> "into" - <> P.group (prettyProjectBranchName aliceAndBob.alice.branch <> ".") + <> P.group (prettyProjectAndBranchName aliceAndBob.alice <> ".") <> "However, I've added the definitions that need attention to the top of" <> P.group (prettyFilePath path <> "."), "", diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 8875bb5cc9..1ead9f4581 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -506,7 +506,7 @@ project/bob> add project/alice> merge /bob - I couldn't automatically merge project/bob into alice. + I couldn't automatically merge project/bob into project/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -559,7 +559,7 @@ bar = foo ++ " - " ++ foo ```ucm project/alice> merge /bob - I couldn't automatically merge project/bob into alice. + I couldn't automatically merge project/bob into project/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -624,7 +624,7 @@ baz = "bobs baz" ```ucm project/alice> merge /bob - I couldn't automatically merge project/bob into alice. + I couldn't automatically merge project/bob into project/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -693,7 +693,7 @@ unique type Foo = MkFoo Nat Text ```ucm project/alice> merge /bob - I couldn't automatically merge project/bob into alice. + I couldn't automatically merge project/bob into project/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -742,7 +742,7 @@ unique type Foo = Baz Nat | BobQux Text ```ucm project/alice> merge /bob - I couldn't automatically merge project/bob into alice. + I couldn't automatically merge project/bob into project/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -795,7 +795,7 @@ project/bob> move.term Foo.Qux Foo.Bob ```ucm project/alice> merge bob - I couldn't automatically merge project/bob into alice. + I couldn't automatically merge project/bob into project/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -841,7 +841,7 @@ unique ability my.cool where ```ucm project/alice> merge bob - I couldn't automatically merge project/bob into alice. + I couldn't automatically merge project/bob into project/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -899,7 +899,7 @@ These won't cleanly merge. ```ucm project/alice> merge bob - I couldn't automatically merge project/bob into alice. + I couldn't automatically merge project/bob into project/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -973,7 +973,7 @@ Notably, Alice's "unconflicted" update on the name "Foo.Bar.Baz" (because she ch ```ucm project/alice> merge bob - I couldn't automatically merge project/bob into alice. + I couldn't automatically merge project/bob into project/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -1032,7 +1032,7 @@ bob _ = 19 ```ucm project/alice> merge bob - I couldn't automatically merge project/bob into alice. + I couldn't automatically merge project/bob into project/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -1099,7 +1099,7 @@ Attempt to merge: ```ucm project/alice> merge /bob - I couldn't automatically merge project/bob into alice. + I couldn't automatically merge project/bob into project/alice. However, I've added the definitions that need attention to the top of scratch.u. From 87f1544ad2c2d188d9d171a71bd78f63ae8bea07 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 13 Jun 2024 08:47:37 -0400 Subject: [PATCH 161/631] move `todo` input handler into its own module --- .../src/Unison/Codebase/Editor/HandleInput.hs | 85 +------------ .../Codebase/Editor/HandleInput/Todo.hs | 117 ++++++++++++++++++ unison-cli/unison-cli.cabal | 3 +- 3 files changed, 121 insertions(+), 84 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 30d241b40f..c8b66f3a95 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -41,7 +41,6 @@ import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.NamesUtils qualified as Cli import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils -import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch (..), Branch0) import Unison.Codebase.Branch qualified as Branch @@ -51,7 +50,6 @@ import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Causal qualified as Causal import Unison.Codebase.Editor.AuthorInfo (AuthorInfo (..)) import Unison.Codebase.Editor.AuthorInfo qualified as AuthorInfo -import Unison.Codebase.Editor.DisplayObject import Unison.Codebase.Editor.HandleInput.AddRun (handleAddRun) import Unison.Codebase.Editor.HandleInput.AuthLogin (authLogin) import Unison.Codebase.Editor.HandleInput.Branch (handleBranch) @@ -77,6 +75,7 @@ import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper) import Unison.Codebase.Editor.HandleInput.ProjectClone (handleClone) import Unison.Codebase.Editor.HandleInput.ProjectCreate (projectCreate) import Unison.Codebase.Editor.HandleInput.ProjectRename (handleProjectRename) +import Unison.Codebase.Editor.HandleInput.Todo (handleTodo) import Unison.Codebase.Editor.HandleInput.ProjectSwitch (projectSwitch) import Unison.Codebase.Editor.HandleInput.Projects (handleProjects) import Unison.Codebase.Editor.HandleInput.Pull (handlePull, mergeBranchAndPropagateDefaultPatch) @@ -100,11 +99,8 @@ import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Editor.Slurp qualified as Slurp import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult import Unison.Codebase.Editor.StructuredArgument qualified as SA -import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Codebase.IntegrityCheck qualified as IntegrityCheck (integrityCheckFullCodebase) import Unison.Codebase.Metadata qualified as Metadata -import Unison.Codebase.Patch (Patch (..)) -import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path (Path, Path' (..)) import Unison.Codebase.Path qualified as HQSplit' import Unison.Codebase.Path qualified as Path @@ -181,7 +177,6 @@ import Unison.Util.Relation qualified as R import Unison.Util.Relation qualified as Relation import Unison.Util.Set qualified as Set import Unison.Util.Star2 qualified as Star2 -import Unison.Util.TransitiveClosure (transitiveClosure) import Unison.Var (Var) import Unison.Var qualified as Var import Unison.WatchKind qualified as WK @@ -742,10 +737,7 @@ loop e = do currentNames <- Branch.toNames <$> Cli.getCurrentBranch0 let sr = Slurp.slurpFile uf vars Slurp.UpdateOp currentNames previewResponse sourceName sr uf - TodoI patchPath branchPath' -> do - patch <- Cli.getPatchAt (fromMaybe Cli.defaultPatchPath patchPath) - branchPath <- Cli.resolvePath' branchPath' - doShowTodoOutput patch branchPath + TodoI patchPath branchPath -> handleTodo patchPath branchPath TestI testInput -> Tests.handleTest testInput ExecuteI main args -> handleRun False main args MakeStandaloneI output main -> doCompile False output main @@ -1430,58 +1422,6 @@ doDisplay outputLoc names tm = do else do writeUtf8 filePath txt --- | Show todo output if there are any conflicts or edits. -doShowTodoOutput :: Patch -> Path.Absolute -> Cli () -doShowTodoOutput patch scopePath = do - Cli.Env {codebase} <- ask - names0 <- Branch.toNames <$> Cli.getBranch0At scopePath - todo <- Cli.runTransaction (checkTodo codebase patch names0) - if TO.noConflicts todo && TO.noEdits todo - then Cli.respond NoConflictsOrEdits - else do - Cli.setNumberedArgs $ - SA.HashQualified . HQ.HashOnly . Reference.toShortHash . view _2 - <$> fst (TO.todoFrontierDependents todo) - pped <- Cli.currentPrettyPrintEnvDecl - Cli.respondNumbered $ TodoOutput pped todo - -checkTodo :: Codebase m Symbol Ann -> Patch -> Names -> Sqlite.Transaction (TO.TodoOutput Symbol Ann) -checkTodo codebase patch names0 = do - let -- Get the dependents of a reference which: - -- 1. Don't appear on the LHS of this patch - -- 2. Have a name in this namespace - getDependents :: Reference -> Sqlite.Transaction (Set Reference) - getDependents ref = do - dependents <- Codebase.dependents Queries.ExcludeSelf ref - pure (dependents & removeEditedThings & removeNamelessThings) - -- (r,r2) ∈ dependsOn if r depends on r2, excluding self-references (i.e. (r,r)) - dependsOn <- Monoid.foldMapM (\ref -> R.fromManyDom <$> getDependents ref <*> pure ref) edited - let dirty = R.dom dependsOn - transitiveDirty <- transitiveClosure getDependents dirty - (frontierTerms, frontierTypes) <- loadDisplayInfo codebase (R.ran dependsOn) - (dirtyTerms, dirtyTypes) <- loadDisplayInfo codebase dirty - pure $ - TO.TodoOutput - (Set.size transitiveDirty) - (frontierTerms, frontierTypes) - (score dirtyTerms, score dirtyTypes) - (Names.conflicts names0) - (Patch.conflicts patch) - where - -- Remove from a all references that were edited, i.e. appear on the LHS of this patch. - removeEditedThings :: Set Reference -> Set Reference - removeEditedThings = - (`Set.difference` edited) - -- Remove all references that don't have a name in the given namespace - removeNamelessThings :: Set Reference -> Set Reference - removeNamelessThings = - Set.filter (Names.contains names0) - -- todo: something more intelligent here? - score :: [(a, b)] -> [(TO.Score, a, b)] - score = map (\(x, y) -> (1, x, y)) - edited :: Set Reference - edited = R.dom (Patch._termEdits patch) <> R.dom (Patch._typeEdits patch) - confirmedCommand :: Input -> Cli Bool confirmedCommand i = do loopState <- State.get @@ -1780,27 +1720,6 @@ docsI src = do displayI ConsoleLocation (Names.longestTermName 10 (Set.findMin s) namesInFile) _ -> displayI ConsoleLocation dotDoc -loadDisplayInfo :: - Codebase m Symbol Ann -> - Set Reference -> - Sqlite.Transaction - ( [(Reference, Maybe (Type Symbol Ann))], - [(Reference, DisplayObject () (DD.Decl Symbol Ann))] - ) -loadDisplayInfo codebase refs = do - termRefs <- filterM (Codebase.isTerm codebase) (toList refs) - typeRefs <- filterM (Codebase.isType codebase) (toList refs) - terms <- forM termRefs $ \r -> (r,) <$> Codebase.getTypeOfTerm codebase r - types <- forM typeRefs $ \r -> (r,) <$> loadTypeDisplayObject codebase r - pure (terms, types) - -loadTypeDisplayObject :: Codebase m Symbol Ann -> Reference -> Sqlite.Transaction (DisplayObject () (DD.Decl Symbol Ann)) -loadTypeDisplayObject codebase = \case - Reference.Builtin _ -> pure (BuiltinObject ()) - Reference.DerivedId id -> - maybe (MissingObject $ Reference.idToShortHash id) UserObject - <$> Codebase.getTypeDeclaration codebase id - lexedSource :: Text -> Text -> Cli (Text, [L.Token L.Lexeme]) lexedSource name src = do let tokens = L.lexer (Text.unpack name) (Text.unpack src) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs new file mode 100644 index 0000000000..a34d48bc4f --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -0,0 +1,117 @@ +-- | @todo@ input handler +module Unison.Codebase.Editor.HandleInput.Todo + ( handleTodo, + ) +where + +import Control.Lens hiding (from) +import Control.Monad.Reader (ask) +import Data.Set qualified as Set +import U.Codebase.Sqlite.Queries qualified as Queries +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.PrettyPrintUtils qualified as Cli +import Unison.Codebase (Codebase) +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Editor.DisplayObject +import Unison.Codebase.Editor.Output +import Unison.Codebase.Editor.StructuredArgument qualified as SA +import Unison.Codebase.Editor.TodoOutput qualified as TO +import Unison.Codebase.Patch (Patch (..)) +import Unison.Codebase.Patch qualified as Patch +import Unison.Codebase.Path qualified as Path +import Unison.DataDeclaration qualified as DD +import Unison.HashQualified qualified as HQ +import Unison.Names (Names) +import Unison.Names qualified as Names +import Unison.Parser.Ann (Ann (..)) +import Unison.Prelude +import Unison.Reference (Reference) +import Unison.Reference qualified as Reference +import Unison.Sqlite qualified as Sqlite +import Unison.Symbol (Symbol) +import Unison.Type (Type) +import Unison.Util.Monoid qualified as Monoid +import Unison.Util.Relation qualified as R +import Unison.Util.TransitiveClosure (transitiveClosure) + +handleTodo :: Maybe Path.Split' -> Path.Path' -> Cli () +handleTodo patchPath branchPath' = do + patch <- Cli.getPatchAt (fromMaybe Cli.defaultPatchPath patchPath) + branchPath <- Cli.resolvePath' branchPath' + doShowTodoOutput patch branchPath + +-- | Show todo output if there are any conflicts or edits. +doShowTodoOutput :: Patch -> Path.Absolute -> Cli () +doShowTodoOutput patch scopePath = do + Cli.Env {codebase} <- ask + names0 <- Branch.toNames <$> Cli.getBranch0At scopePath + todo <- Cli.runTransaction (checkTodo codebase patch names0) + if TO.noConflicts todo && TO.noEdits todo + then Cli.respond NoConflictsOrEdits + else do + Cli.setNumberedArgs $ + SA.HashQualified . HQ.HashOnly . Reference.toShortHash . view _2 + <$> fst (TO.todoFrontierDependents todo) + pped <- Cli.currentPrettyPrintEnvDecl + Cli.respondNumbered $ TodoOutput pped todo + +checkTodo :: Codebase m Symbol Ann -> Patch -> Names -> Sqlite.Transaction (TO.TodoOutput Symbol Ann) +checkTodo codebase patch names0 = do + let -- Get the dependents of a reference which: + -- 1. Don't appear on the LHS of this patch + -- 2. Have a name in this namespace + getDependents :: Reference -> Sqlite.Transaction (Set Reference) + getDependents ref = do + dependents <- Codebase.dependents Queries.ExcludeSelf ref + pure (dependents & removeEditedThings & removeNamelessThings) + -- (r,r2) ∈ dependsOn if r depends on r2, excluding self-references (i.e. (r,r)) + dependsOn <- Monoid.foldMapM (\ref -> R.fromManyDom <$> getDependents ref <*> pure ref) edited + let dirty = R.dom dependsOn + transitiveDirty <- transitiveClosure getDependents dirty + (frontierTerms, frontierTypes) <- loadDisplayInfo codebase (R.ran dependsOn) + (dirtyTerms, dirtyTypes) <- loadDisplayInfo codebase dirty + pure $ + TO.TodoOutput + (Set.size transitiveDirty) + (frontierTerms, frontierTypes) + (score dirtyTerms, score dirtyTypes) + (Names.conflicts names0) + (Patch.conflicts patch) + where + -- Remove from a all references that were edited, i.e. appear on the LHS of this patch. + removeEditedThings :: Set Reference -> Set Reference + removeEditedThings = + (`Set.difference` edited) + -- Remove all references that don't have a name in the given namespace + removeNamelessThings :: Set Reference -> Set Reference + removeNamelessThings = + Set.filter (Names.contains names0) + -- todo: something more intelligent here? + score :: [(a, b)] -> [(TO.Score, a, b)] + score = map (\(x, y) -> (1, x, y)) + edited :: Set Reference + edited = R.dom (Patch._termEdits patch) <> R.dom (Patch._typeEdits patch) + +loadDisplayInfo :: + Codebase m Symbol Ann -> + Set Reference -> + Sqlite.Transaction + ( [(Reference, Maybe (Type Symbol Ann))], + [(Reference, DisplayObject () (DD.Decl Symbol Ann))] + ) +loadDisplayInfo codebase refs = do + termRefs <- filterM (Codebase.isTerm codebase) (toList refs) + typeRefs <- filterM (Codebase.isType codebase) (toList refs) + terms <- forM termRefs $ \r -> (r,) <$> Codebase.getTypeOfTerm codebase r + types <- forM typeRefs $ \r -> (r,) <$> loadTypeDisplayObject codebase r + pure (terms, types) + +loadTypeDisplayObject :: Codebase m Symbol Ann -> Reference -> Sqlite.Transaction (DisplayObject () (DD.Decl Symbol Ann)) +loadTypeDisplayObject codebase = \case + Reference.Builtin _ -> pure (BuiltinObject ()) + Reference.DerivedId id -> + maybe (MissingObject $ Reference.idToShortHash id) UserObject + <$> Codebase.getTypeDeclaration codebase id diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 403d2f7e73..de8288ccce 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -85,6 +85,7 @@ library Unison.Codebase.Editor.HandleInput.ShowDefinition Unison.Codebase.Editor.HandleInput.TermResolution Unison.Codebase.Editor.HandleInput.Tests + Unison.Codebase.Editor.HandleInput.Todo Unison.Codebase.Editor.HandleInput.UI Unison.Codebase.Editor.HandleInput.Update Unison.Codebase.Editor.HandleInput.Update2 From 6e04dbd08302322d7629c2ad08eb122fb3404dca Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 13 Jun 2024 10:29:42 -0400 Subject: [PATCH 162/631] gut existing todo implementation --- .../src/Unison/Codebase/Editor/HandleInput.hs | 2 +- .../Codebase/Editor/HandleInput/Todo.hs | 112 +------ .../src/Unison/Codebase/Editor/Input.hs | 2 +- .../src/Unison/Codebase/Editor/Output.hs | 5 +- .../src/Unison/Codebase/Editor/TodoOutput.hs | 69 +---- .../src/Unison/CommandLine/InputPatterns.hs | 29 +- .../src/Unison/CommandLine/OutputMessages.hs | 151 +-------- unison-src/transcripts/fix2000.output.md | 4 - unison-src/transcripts/fix2254.output.md | 4 - unison-src/transcripts/todo.md | 139 --------- unison-src/transcripts/todo.output.md | 292 ------------------ 11 files changed, 32 insertions(+), 777 deletions(-) delete mode 100644 unison-src/transcripts/todo.md delete mode 100644 unison-src/transcripts/todo.output.md diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index c8b66f3a95..5064159af6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -737,7 +737,7 @@ loop e = do currentNames <- Branch.toNames <$> Cli.getCurrentBranch0 let sr = Slurp.slurpFile uf vars Slurp.UpdateOp currentNames previewResponse sourceName sr uf - TodoI patchPath branchPath -> handleTodo patchPath branchPath + TodoI -> handleTodo TestI testInput -> Tests.handleTest testInput ExecuteI main args -> handleRun False main args MakeStandaloneI output main -> doCompile False output main diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index a34d48bc4f..4cfe62d3b8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -4,114 +4,22 @@ module Unison.Codebase.Editor.HandleInput.Todo ) where -import Control.Lens hiding (from) -import Control.Monad.Reader (ask) -import Data.Set qualified as Set -import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.PrettyPrintUtils qualified as Cli -import Unison.Codebase (Codebase) -import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch.Names qualified as Branch -import Unison.Codebase.Editor.DisplayObject import Unison.Codebase.Editor.Output -import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.Codebase.Editor.TodoOutput qualified as TO -import Unison.Codebase.Patch (Patch (..)) -import Unison.Codebase.Patch qualified as Patch -import Unison.Codebase.Path qualified as Path -import Unison.DataDeclaration qualified as DD -import Unison.HashQualified qualified as HQ -import Unison.Names (Names) import Unison.Names qualified as Names -import Unison.Parser.Ann (Ann (..)) -import Unison.Prelude -import Unison.Reference (Reference) -import Unison.Reference qualified as Reference -import Unison.Sqlite qualified as Sqlite -import Unison.Symbol (Symbol) -import Unison.Type (Type) -import Unison.Util.Monoid qualified as Monoid -import Unison.Util.Relation qualified as R -import Unison.Util.TransitiveClosure (transitiveClosure) -handleTodo :: Maybe Path.Split' -> Path.Path' -> Cli () -handleTodo patchPath branchPath' = do - patch <- Cli.getPatchAt (fromMaybe Cli.defaultPatchPath patchPath) - branchPath <- Cli.resolvePath' branchPath' - doShowTodoOutput patch branchPath - --- | Show todo output if there are any conflicts or edits. -doShowTodoOutput :: Patch -> Path.Absolute -> Cli () -doShowTodoOutput patch scopePath = do - Cli.Env {codebase} <- ask - names0 <- Branch.toNames <$> Cli.getBranch0At scopePath - todo <- Cli.runTransaction (checkTodo codebase patch names0) - if TO.noConflicts todo && TO.noEdits todo - then Cli.respond NoConflictsOrEdits - else do - Cli.setNumberedArgs $ - SA.HashQualified . HQ.HashOnly . Reference.toShortHash . view _2 - <$> fst (TO.todoFrontierDependents todo) - pped <- Cli.currentPrettyPrintEnvDecl - Cli.respondNumbered $ TodoOutput pped todo - -checkTodo :: Codebase m Symbol Ann -> Patch -> Names -> Sqlite.Transaction (TO.TodoOutput Symbol Ann) -checkTodo codebase patch names0 = do - let -- Get the dependents of a reference which: - -- 1. Don't appear on the LHS of this patch - -- 2. Have a name in this namespace - getDependents :: Reference -> Sqlite.Transaction (Set Reference) - getDependents ref = do - dependents <- Codebase.dependents Queries.ExcludeSelf ref - pure (dependents & removeEditedThings & removeNamelessThings) - -- (r,r2) ∈ dependsOn if r depends on r2, excluding self-references (i.e. (r,r)) - dependsOn <- Monoid.foldMapM (\ref -> R.fromManyDom <$> getDependents ref <*> pure ref) edited - let dirty = R.dom dependsOn - transitiveDirty <- transitiveClosure getDependents dirty - (frontierTerms, frontierTypes) <- loadDisplayInfo codebase (R.ran dependsOn) - (dirtyTerms, dirtyTypes) <- loadDisplayInfo codebase dirty - pure $ - TO.TodoOutput - (Set.size transitiveDirty) - (frontierTerms, frontierTypes) - (score dirtyTerms, score dirtyTypes) - (Names.conflicts names0) - (Patch.conflicts patch) - where - -- Remove from a all references that were edited, i.e. appear on the LHS of this patch. - removeEditedThings :: Set Reference -> Set Reference - removeEditedThings = - (`Set.difference` edited) - -- Remove all references that don't have a name in the given namespace - removeNamelessThings :: Set Reference -> Set Reference - removeNamelessThings = - Set.filter (Names.contains names0) - -- todo: something more intelligent here? - score :: [(a, b)] -> [(TO.Score, a, b)] - score = map (\(x, y) -> (1, x, y)) - edited :: Set Reference - edited = R.dom (Patch._termEdits patch) <> R.dom (Patch._typeEdits patch) - -loadDisplayInfo :: - Codebase m Symbol Ann -> - Set Reference -> - Sqlite.Transaction - ( [(Reference, Maybe (Type Symbol Ann))], - [(Reference, DisplayObject () (DD.Decl Symbol Ann))] - ) -loadDisplayInfo codebase refs = do - termRefs <- filterM (Codebase.isTerm codebase) (toList refs) - typeRefs <- filterM (Codebase.isType codebase) (toList refs) - terms <- forM termRefs $ \r -> (r,) <$> Codebase.getTypeOfTerm codebase r - types <- forM typeRefs $ \r -> (r,) <$> loadTypeDisplayObject codebase r - pure (terms, types) - -loadTypeDisplayObject :: Codebase m Symbol Ann -> Reference -> Sqlite.Transaction (DisplayObject () (DD.Decl Symbol Ann)) -loadTypeDisplayObject codebase = \case - Reference.Builtin _ -> pure (BuiltinObject ()) - Reference.DerivedId id -> - maybe (MissingObject $ Reference.idToShortHash id) UserObject - <$> Codebase.getTypeDeclaration codebase id +handleTodo :: Cli () +handleTodo = do + branch0 <- Cli.getCurrentBranch0 + let names0 = Branch.toNames branch0 + let todo = + TO.TodoOutput + { nameConflicts = Names.conflicts names0 + } + pped <- Cli.currentPrettyPrintEnvDecl + Cli.respondNumbered $ TodoOutput pped todo diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index a29d2ac660..4df4338122 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -150,7 +150,7 @@ data Input | UpdateI OptionalPatch (Set Name) | Update2I | PreviewUpdateI (Set Name) - | TodoI (Maybe PatchPath) Path' + | TodoI | UndoI | -- First `Maybe Int` is cap on number of results, if any -- Second `Maybe Int` is cap on diff elements shown, if any diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index e6b5608e26..027d95ceb0 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -293,8 +293,6 @@ data Output | PreviewMergeAlreadyUpToDate (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)) - | -- | No conflicts or edits remain for the current patch. - NoConflictsOrEdits | NotImplemented | NoBranchWithHash ShortCausalHash | ListDependencies PPE.PrettyPrintEnv (Set LabeledDependency) [HQ.HashQualified Name] [HQ.HashQualified Name] -- types, terms @@ -554,7 +552,6 @@ isFailure o = case o of MergeAlreadyUpToDate {} -> False MergeAlreadyUpToDate2 {} -> False PreviewMergeAlreadyUpToDate {} -> False - NoConflictsOrEdits {} -> False ListShallow _ es -> null es HashAmbiguous {} -> True ShowReflog {} -> False @@ -669,4 +666,4 @@ isNumberedFailure = \case ShowDiffAfterUndo {} -> False ShowDiffNamespace _ _ _ bd -> BD.isEmpty bd ListNamespaceDependencies {} -> False - TodoOutput _ todo -> TO.todoScore todo > 0 || not (TO.noConflicts todo) + TodoOutput {} -> False diff --git a/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs b/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs index f6458ca57b..e4c859a9f1 100644 --- a/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs @@ -1,70 +1,15 @@ -{-# LANGUAGE RecordWildCards #-} +module Unison.Codebase.Editor.TodoOutput + ( TodoOutput (..), + noConflicts, + ) +where -module Unison.Codebase.Editor.TodoOutput where - -import Data.Set qualified as Set -import Unison.Codebase.Editor.DisplayObject (DisplayObject (UserObject)) -import Unison.Codebase.Patch (Patch) -import Unison.Codebase.Patch qualified as Patch -import Unison.DataDeclaration (Decl) -import Unison.DataDeclaration qualified as DD -import Unison.LabeledDependency (LabeledDependency) -import Unison.LabeledDependency qualified as LD import Unison.Names (Names) -import Unison.Names qualified as Names -import Unison.Prelude -import Unison.Reference (Reference) -import Unison.Type (Type) -import Unison.Type qualified as Type -import Unison.Util.Relation qualified as R - -type Score = Int data TodoOutput v a = TodoOutput - { todoScore :: Score, - todoFrontier :: - ( [(Reference, Maybe (Type v a))], - [(Reference, DisplayObject () (Decl v a))] - ), - todoFrontierDependents :: - ( [(Score, Reference, Maybe (Type v a))], - [(Score, Reference, DisplayObject () (Decl v a))] - ), - nameConflicts :: Names, - editConflicts :: Patch + { nameConflicts :: Names } -labeledDependencies :: (Ord v) => TodoOutput v a -> Set LabeledDependency -labeledDependencies TodoOutput {..} = - Set.fromList - ( -- term refs - [LD.termRef r | (r, _) <- fst todoFrontier] - <> [LD.termRef r | (_, r, _) <- fst todoFrontierDependents] - <> [LD.typeRef r | (r, _) <- snd todoFrontier] - <> [LD.typeRef r | (_, r, _) <- snd todoFrontierDependents] - <> - -- types of term refs - [ LD.typeRef r | (_, Just t) <- fst todoFrontier, r <- toList (Type.dependencies t) - ] - <> [ LD.typeRef r | (_, _, Just t) <- fst todoFrontierDependents, r <- toList (Type.dependencies t) - ] - <> - -- and decls of type refs - [ labeledDep | (declRef, UserObject d) <- snd todoFrontier, labeledDep <- toList (DD.labeledDeclDependenciesIncludingSelf declRef d) - ] - <> [ labeledDep | (_, declRef, UserObject d) <- snd todoFrontierDependents, labeledDep <- toList (DD.labeledDeclDependenciesIncludingSelf declRef d) - ] - ) - <> - -- name conflicts - Set.map LD.referent (R.ran (Names.terms nameConflicts)) - <> Set.map LD.typeRef (R.ran (Names.types nameConflicts)) - <> Patch.labeledDependencies editConflicts - noConflicts :: TodoOutput v a -> Bool noConflicts todo = - nameConflicts todo == mempty && editConflicts todo == Patch.empty - -noEdits :: TodoOutput v a -> Bool -noEdits todo = - todoScore todo == 0 + nameConflicts todo == mempty diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index e56b5c8ace..aa49f968ea 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -756,30 +756,15 @@ todo = "todo" [] I.Visible - [("patch", Optional, patchArg), ("namespace", Optional, namespaceArg)] - ( P.wrapColumn2 - [ ( makeExample' todo, - "lists the refactor work remaining in the default patch for the current" - <> " namespace." - ), - ( makeExample todo [""], - "lists the refactor work remaining in the given patch in the current " - <> "namespace." - ), - ( makeExample todo ["", "[path]"], - "lists the refactor work remaining in the given patch in given namespace." - ) - ] + [] + ( P.wrap $ + makeExample' todo + <> "lists the current namespace's outstanding issues, including conflicted names, dependencies with missing" + <> "names, and merge precondition violations." ) \case - patchStr : ws -> first warn $ do - patch <- handleSplit'Arg patchStr - branch <- case ws of - [] -> pure Path.relativeEmpty' - [pathStr] -> handlePath'Arg pathStr - _ -> Left "`todo` just takes a patch and one optional namespace" - Right $ Input.TodoI (Just patch) branch - [] -> Right $ Input.TodoI Nothing Path.relativeEmpty' + [] -> Right Input.TodoI + _ -> Left (I.help todo) load :: InputPattern load = diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 76355438a9..20ff1a4f53 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -65,7 +65,6 @@ import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Codebase.IntegrityCheck (IntegrityResult (..), prettyPrintIntegrityErrors) -import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path qualified as Path import Unison.Codebase.PushBehavior qualified as PushBehavior @@ -73,8 +72,6 @@ import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv -import Unison.Codebase.TermEdit qualified as TermEdit -import Unison.Codebase.TypeEdit qualified as TypeEdit import Unison.CommandLine (bigproblem, note, tip) import Unison.CommandLine.FZFResolvers qualified as FZFResolvers import Unison.CommandLine.InputPattern (InputPattern) @@ -137,7 +134,6 @@ import Unison.Syntax.NamePrinter prettyReference, prettyReferent, prettyShortHash, - styleHashQualified, ) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.TermPrinter qualified as TermPrinter @@ -1483,8 +1479,6 @@ notifyUser dir = \case <> P.group (prettyNamespaceKey src <> ".") DumpNumberedArgs schLength args -> pure . P.numberedList $ fmap (P.text . IP.formatStructuredArgument (pure schLength)) args - NoConflictsOrEdits -> - pure (P.okCallout "No conflicts or edits in progress.") HelpMessage pat -> pure $ IP.showPatternHelp pat NoOp -> pure $ P.string "I didn't make any changes." DumpBitBooster head map -> @@ -2628,66 +2622,6 @@ renderNameConflicts ppe conflictedNames = do ) `P.hang` P.lines prettyConflicts -renderEditConflicts :: - PPE.PrettyPrintEnv -> Patch -> Numbered Pretty -renderEditConflicts ppe Patch {..} = do - formattedConflicts <- for editConflicts formatConflict - pure . Monoid.unlessM (null editConflicts) . P.callout "❓" . P.sep "\n\n" $ - [ P.wrap $ - "These" - <> P.bold "definitions were edited differently" - <> "in namespaces that have been merged into this one." - <> "You'll have to tell me what to use as the new definition:", - P.indentN 2 (P.lines formattedConflicts) - -- , tip $ "Use " <> makeExample IP.resolve [name (head editConflicts), " "] <> " to pick a replacement." -- todo: eventually something with `edit` - ] - where - -- todo: could possibly simplify all of this, but today is a copy/paste day. - editConflicts :: [Either (Reference, Set TypeEdit.TypeEdit) (Reference, Set TermEdit.TermEdit)] - editConflicts = - (fmap Left . Map.toList . R.toMultimap . R.filterManyDom $ _typeEdits) - <> (fmap Right . Map.toList . R.toMultimap . R.filterManyDom $ _termEdits) - numberedHQName :: HQ.HashQualified Name -> Numbered Pretty - numberedHQName hqName = do - n <- addNumberedArg $ SA.HashQualified hqName - pure $ formatNum n <> styleHashQualified P.bold hqName - formatTypeEdits :: - (Reference, Set TypeEdit.TypeEdit) -> - Numbered Pretty - formatTypeEdits (r, toList -> es) = do - replacedType <- numberedHQName (PPE.typeName ppe r) - replacements <- for [PPE.typeName ppe r | TypeEdit.Replace r <- es] numberedHQName - pure . P.wrap $ - "The type" - <> replacedType - <> "was" - <> ( if TypeEdit.Deprecate `elem` es - then "deprecated and also replaced with" - else "replaced with" - ) - `P.hang` P.lines replacements - formatTermEdits :: - (Reference.TermReference, Set TermEdit.TermEdit) -> - Numbered Pretty - formatTermEdits (r, toList -> es) = do - replacedTerm <- numberedHQName (PPE.termName ppe (Referent.Ref r)) - replacements <- for [PPE.termName ppe (Referent.Ref r) | TermEdit.Replace r _ <- es] numberedHQName - pure . P.wrap $ - "The term" - <> replacedTerm - <> "was" - <> ( if TermEdit.Deprecate `elem` es - then "deprecated and also replaced with" - else "replaced with" - ) - `P.hang` P.lines replacements - formatConflict :: - Either - (Reference, Set TypeEdit.TypeEdit) - (Reference.TermReference, Set TermEdit.TermEdit) -> - Numbered Pretty - formatConflict = either formatTypeEdits formatTermEdits - type Numbered = State.State (Int, Seq.Seq StructuredArgument) addNumberedArg :: StructuredArgument -> Numbered Int @@ -2706,88 +2640,13 @@ runNumbered m = todoOutput :: (Var v) => PPED.PrettyPrintEnvDecl -> TO.TodoOutput v a -> (Pretty, NumberedArgs) todoOutput ppe todo = runNumbered do - conflicts <- todoConflicts - edits <- todoEdits - pure (conflicts <> edits) + if TO.noConflicts todo + then pure mempty + else do + nameConflicts <- renderNameConflicts ppeu (TO.nameConflicts todo) + pure $ P.lines $ P.nonEmpty [nameConflicts] where ppeu = PPED.unsuffixifiedPPE ppe - ppes = PPED.suffixifiedPPE ppe - (frontierTerms, frontierTypes) = TO.todoFrontier todo - (dirtyTerms, dirtyTypes) = TO.todoFrontierDependents todo - corruptTerms = - [(PPE.termName ppeu (Referent.Ref r), r) | (r, Nothing) <- frontierTerms] - corruptTypes = - [(PPE.typeName ppeu r, r) | (r, MissingObject _) <- frontierTypes] - goodTerms ts = - [(Referent.Ref r, PPE.termName ppeu (Referent.Ref r), typ) | (r, Just typ) <- ts] - todoConflicts :: Numbered Pretty - todoConflicts = do - if TO.noConflicts todo - then pure mempty - else do - editConflicts <- renderEditConflicts ppeu (TO.editConflicts todo) - nameConflicts <- renderNameConflicts ppeu conflictedNames - pure $ P.lines . P.nonEmpty $ [editConflicts, nameConflicts] - where - -- If a conflict is both an edit and a name conflict, we show it in the edit - -- conflicts section - conflictedNames :: Names - conflictedNames = removeEditConflicts (TO.editConflicts todo) (TO.nameConflicts todo) - -- e.g. `foo#a` has been independently updated to `foo#b` and `foo#c`. - -- This means there will be a name conflict: - -- foo -> #b - -- foo -> #c - -- as well as an edit conflict: - -- #a -> #b - -- #a -> #c - -- We want to hide/ignore the name conflicts that are also targets of an - -- edit conflict, so that the edit conflict will be dealt with first. - -- For example, if hash `h` has multiple edit targets { #x, #y, #z, ...}, - -- we'll temporarily remove name conflicts pointing to { #x, #y, #z, ...}. - removeEditConflicts :: Patch -> Names -> Names - removeEditConflicts Patch {..} Names {..} = Names terms' types' - where - terms' = R.filterRan (`Set.notMember` conflictedTermEditTargets) terms - types' = R.filterRan (`Set.notMember` conflictedTypeEditTargets) types - conflictedTypeEditTargets :: Set Reference - conflictedTypeEditTargets = - Set.fromList $ toList (R.ran typeEditConflicts) >>= TypeEdit.references - conflictedTermEditTargets :: Set Referent.Referent - conflictedTermEditTargets = - Set.fromList . fmap Referent.Ref $ - toList (R.ran termEditConflicts) >>= TermEdit.references - typeEditConflicts = R.filterDom (`R.manyDom` _typeEdits) _typeEdits - termEditConflicts = R.filterDom (`R.manyDom` _termEdits) _termEdits - - todoEdits :: Numbered Pretty - todoEdits = do - numberedTypes <- for (unscore <$> dirtyTypes) \(ref, displayObj) -> do - n <- addNumberedArg . SA.HashQualified $ PPE.typeName ppeu ref - pure $ formatNum n <> prettyDeclPair ppeu (ref, displayObj) - let filteredTerms = goodTerms (unscore <$> dirtyTerms) - termNumbers <- for filteredTerms \(ref, _, _) -> do - n <- addNumberedArg . SA.HashQualified $ PPE.termName ppeu ref - pure $ formatNum n - let formattedTerms = TypePrinter.prettySignaturesCT ppes filteredTerms - numberedTerms = zipWith (<>) termNumbers formattedTerms - pure $ - Monoid.unlessM (TO.noEdits todo) . P.callout "🚧" . P.sep "\n\n" . P.nonEmpty $ - [ P.wrap - ( "The namespace has" - <> fromString (show (TO.todoScore todo)) - <> "transitive dependent(s) left to upgrade." - <> "Your edit frontier is the dependents of these definitions:" - ), - P.indentN 2 . P.lines $ - ( (prettyDeclPair ppeu <$> toList frontierTypes) - ++ TypePrinter.prettySignaturesCT ppes (goodTerms frontierTerms) - ), - P.wrap "I recommend working on them in the following order:", - P.lines $ numberedTypes ++ numberedTerms, - formatMissingStuff corruptTerms corruptTypes - ] - unscore :: (a, b, c) -> (b, c) - unscore (_score, b, c) = (b, c) listOfDefinitions :: (Var v) => Input.FindScope -> PPE.PrettyPrintEnv -> E.ListDetailed -> [SR'.SearchResult' v a] -> IO Pretty diff --git a/unison-src/transcripts/fix2000.output.md b/unison-src/transcripts/fix2000.output.md index 84a674b1d7..cd388f7e55 100644 --- a/unison-src/transcripts/fix2000.output.md +++ b/unison-src/transcripts/fix2000.output.md @@ -179,14 +179,10 @@ Merge back into the ancestor. .s> todo - ✅ - No conflicts or edits in progress. .m> todo - ✅ - No conflicts or edits in progress. ``` diff --git a/unison-src/transcripts/fix2254.output.md b/unison-src/transcripts/fix2254.output.md index 61af269b2c..dbbdf46852 100644 --- a/unison-src/transcripts/fix2254.output.md +++ b/unison-src/transcripts/fix2254.output.md @@ -106,9 +106,7 @@ Let's do the update now, and verify that the definitions all look good and there .a2> todo - ✅ - No conflicts or edits in progress. ``` ## Record updates @@ -213,8 +211,6 @@ And checking that after updating this record, there's nothing `todo`: .a4> todo - ✅ - No conflicts or edits in progress. ``` diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md deleted file mode 100644 index 39fece2f61..0000000000 --- a/unison-src/transcripts/todo.md +++ /dev/null @@ -1,139 +0,0 @@ -# Test the `todo` command - -## Simple type-changing update. - -```ucm:hide -.simple> builtins.merge -``` - -```unison:hide -x = 1 -useX = x + 10 - -type MyType = MyType Nat -useMyType = match MyType 1 with - MyType a -> a + 10 -``` - -```ucm:hide -.simple> add -``` - -Perform a type-changing update so dependents are added to our update frontier. - -```unison:hide -x = -1 - -type MyType = MyType Text -``` - -```ucm:error -.simple> update.old -.simple> todo -``` - -## A merge with conflicting updates. - -```ucm:hide -.mergeA> builtins.merge -``` - -```unison:hide -x = 1 -type MyType = MyType -``` - -Set up two branches with the same starting point. - -```ucm:hide -.mergeA> add -.> fork .mergeA .mergeB -``` - -Update `x` to a different term in each branch. - -```unison:hide -x = 2 -type MyType = MyType Nat -``` - -```ucm:hide -.mergeA> update.old -``` - -```unison:hide -x = 3 -type MyType = MyType Int -``` - -```ucm:hide -.mergeB> update.old -``` - -```ucm:error -.mergeA> merge.old .mergeB -.mergeA> todo -``` - -## A named value that appears on the LHS of a patch isn't shown - -```ucm:hide -.lhs> builtins.merge -``` - -```unison -foo = 801 -``` - -```ucm -.lhs> add -``` - -```unison -foo = 802 -``` - -```ucm -.lhs> update.old -``` - -```unison -oldfoo = 801 -``` - -```ucm -.lhs> add -.lhs> todo -``` - -## A type-changing update to one element of a cycle, which doesn't propagate to the other - -```ucm:hide -.cycle2> builtins.merge -``` - -```unison -even = cases - 0 -> true - n -> odd (drop 1 n) - -odd = cases - 0 -> false - n -> even (drop 1 n) -``` - -```ucm -.cycle2> add -``` - -```unison -even = 17 -``` - -```ucm -.cycle2> update.old -``` - -```ucm:error -.cycle2> todo -``` diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md deleted file mode 100644 index b0a9d69c6d..0000000000 --- a/unison-src/transcripts/todo.output.md +++ /dev/null @@ -1,292 +0,0 @@ -# Test the `todo` command - -## Simple type-changing update. - -```unison -x = 1 -useX = x + 10 - -type MyType = MyType Nat -useMyType = match MyType 1 with - MyType a -> a + 10 -``` - -Perform a type-changing update so dependents are added to our update frontier. - -```unison -x = -1 - -type MyType = MyType Text -``` - -```ucm -.simple> update.old - - ⍟ I've updated these names to your new definition: - - type MyType - x : Int - -.simple> todo - - 🚧 - - The namespace has 2 transitive dependent(s) left to upgrade. - Your edit frontier is the dependents of these definitions: - - type #vijug0om28 - #gjmq673r1v : Nat - - I recommend working on them in the following order: - - 1. useMyType : Nat - 2. useX : Nat - - - -``` -## A merge with conflicting updates. - -```unison -x = 1 -type MyType = MyType -``` - -Set up two branches with the same starting point. - -Update `x` to a different term in each branch. - -```unison -x = 2 -type MyType = MyType Nat -``` - -```unison -x = 3 -type MyType = MyType Int -``` - -```ucm -.mergeA> merge.old .mergeB - - Here's what's changed in the current namespace after the - merge: - - New name conflicts: - - 1. type MyType#ig1g2ka7lv - ↓ - 2. ┌ type MyType#8c6f40i3tj - 3. └ type MyType#ig1g2ka7lv - - 4. MyType.MyType#ig1g2ka7lv#0 : Nat -> MyType#ig1g2ka7lv - ↓ - 5. ┌ MyType.MyType#8c6f40i3tj#0 : Int -> MyType#8c6f40i3tj - 6. └ MyType.MyType#ig1g2ka7lv#0 : Nat -> MyType#ig1g2ka7lv - - 7. x#dcgdua2lj6 : Nat - ↓ - 8. ┌ x#dcgdua2lj6 : Nat - 9. └ x#f3lgjvjqoo : Nat - - Updates: - - 10. patch patch (added 2 updates) - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - - I tried to auto-apply the patch, but couldn't because it - contained contradictory entries. - -.mergeA> todo - - ❓ - - These definitions were edited differently in namespaces that - have been merged into this one. You'll have to tell me what to - use as the new definition: - - The type 1. #8h7qq3ougl was replaced with - 2. MyType#8c6f40i3tj - 3. MyType#ig1g2ka7lv - The term 4. #gjmq673r1v was replaced with - 5. x#dcgdua2lj6 - 6. x#f3lgjvjqoo - ❓ - - The term MyType.MyType has conflicting definitions: - 7. MyType.MyType#8c6f40i3tj#0 - 8. MyType.MyType#ig1g2ka7lv#0 - - Tip: This occurs when merging branches that both independently - introduce the same name. Use `move.term` or `delete.term` - to resolve the conflicts. - -``` -## A named value that appears on the LHS of a patch isn't shown - -```unison -foo = 801 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - foo : Nat - -``` -```ucm -.lhs> add - - ⍟ I've added these definitions: - - foo : Nat - -``` -```unison -foo = 802 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These names already exist. You can `update` them to your - new definition: - - foo : Nat - -``` -```ucm -.lhs> update.old - - ⍟ I've updated these names to your new definition: - - foo : Nat - -``` -```unison -oldfoo = 801 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - oldfoo : Nat - -``` -```ucm -.lhs> add - - ⍟ I've added these definitions: - - oldfoo : Nat - -.lhs> todo - - ✅ - - No conflicts or edits in progress. - -``` -## A type-changing update to one element of a cycle, which doesn't propagate to the other - -```unison -even = cases - 0 -> true - n -> odd (drop 1 n) - -odd = cases - 0 -> false - n -> even (drop 1 n) -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - even : Nat -> Boolean - odd : Nat -> Boolean - -``` -```ucm -.cycle2> add - - ⍟ I've added these definitions: - - even : Nat -> Boolean - odd : Nat -> Boolean - -``` -```unison -even = 17 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These names already exist. You can `update` them to your - new definition: - - even : Nat - -``` -```ucm -.cycle2> update.old - - ⍟ I've updated these names to your new definition: - - even : Nat - -``` -```ucm -.cycle2> todo - - 🚧 - - The namespace has 1 transitive dependent(s) left to upgrade. - Your edit frontier is the dependents of these definitions: - - #kkohl7ba1e : Nat -> Boolean - - I recommend working on them in the following order: - - 1. odd : Nat -> Boolean - - - -``` From a9c32c10dab7be18343fc53ded4c35e4ca5a9948 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 13 Jun 2024 11:30:58 -0400 Subject: [PATCH 163/631] Various changes to definitions in preparation for cont serialization - The define-unison macro has been reworked in various ways. It can now accept some hint flags that influence its behavior. It also, by default, generates definitions that will annotate the continuation with procedure arguments so that they can later be recovered and reflected for continuation serialization. - A helper macro define-unison-builtin has been added and made use of in the builtin files. This uses hints that turn off the continuation management, because they'll never occur in a captured continuation. The macro also auto-generates termlink information for builtins, so it's no longer necessary to separately define/declare those (required porting some files to racket language). - The unison-continuation struct now acts as the slow path. Static calls to a unison procedure are now macros that either build a closure or call directly into the fast path. - One thing to note: the auto-generation features of the macro are based on the name that occurs in the definition. So declaring abbreviated names and using `prefix-out` is not an option with them. I think this seems like a decent trade off. --- scheme-libs/racket/unison/arithmetic.rkt | 105 +- scheme-libs/racket/unison/boot.ss | 351 +- scheme-libs/racket/unison/concurrent.ss | 12 +- scheme-libs/racket/unison/core.ss | 2 +- scheme-libs/racket/unison/data.ss | 57 +- scheme-libs/racket/unison/io-handles.rkt | 103 +- scheme-libs/racket/unison/io.rkt | 75 +- scheme-libs/racket/unison/math.rkt | 102 +- .../racket/unison/primops-generated.rkt | 59 +- scheme-libs/racket/unison/primops.ss | 2961 ++++++++--------- scheme-libs/racket/unison/sandbox.rkt | 2 +- scheme-libs/racket/unison/udp.rkt | 125 +- 12 files changed, 2155 insertions(+), 1799 deletions(-) diff --git a/scheme-libs/racket/unison/arithmetic.rkt b/scheme-libs/racket/unison/arithmetic.rkt index d9a63d9eb5..a50364eb55 100644 --- a/scheme-libs/racket/unison/arithmetic.rkt +++ b/scheme-libs/racket/unison/arithmetic.rkt @@ -1,70 +1,103 @@ #!racket/base (provide - (prefix-out - builtin- - (combine-out - Nat.toFloat - Nat.increment - Nat.+ - Nat.drop - Float.* - Float.fromRepresentation - Float.toRepresentation - Float.ceiling - Int.+ - Int.- - Int./ - Int.increment - Int.negate - Int.fromRepresentation - Int.toRepresentation - Int.signum - ))) + builtin-Nat.+ + builtin-Nat.+:termlink + builtin-Nat.toFloat + builtin-Nat.toFloat:termlink + builtin-Nat.increment + builtin-Nat.increment:termlink + builtin-Nat.drop + builtin-Nat.drop:termlink + builtin-Float.* + builtin-Float.*:termlink + builtin-Float.fromRepresentation + builtin-Float.fromRepresentation:termlink + builtin-Float.toRepresentation + builtin-Float.toRepresentation:termlink + builtin-Float.ceiling + builtin-Float.ceiling:termlink + builtin-Int.+ + builtin-Int.+:termlink + builtin-Int.- + builtin-Int.-:termlink + builtin-Int./ + builtin-Int./:termlink + builtin-Int.increment + builtin-Int.increment:termlink + builtin-Int.negate + builtin-Int.negate:termlink + builtin-Int.fromRepresentation + builtin-Int.fromRepresentation:termlink + builtin-Int.toRepresentation + builtin-Int.toRepresentation:termlink + builtin-Int.signum + builtin-Int.signum:termlink) (require racket racket/fixnum racket/flonum racket/performance-hint + unison/data unison/boot) (begin-encourage-inline - (define-unison (Nat.+ m n) (clamp-natural (+ m n))) - (define-unison (Nat.drop m n) (max 0 (- m n))) + (define-unison-builtin + (builtin-Nat.+ m n) + (clamp-natural (+ m n))) - (define-unison (Nat.increment n) (clamp-natural (add1 n))) - (define-unison (Int.increment i) (clamp-integer (add1 i))) - (define-unison (Int.negate i) (if (> i nbit63) (- i) i)) - (define-unison (Int.+ i j) (clamp-integer (+ i j))) - (define-unison (Int.- i j) (clamp-integer (- i j))) - (define-unison (Int./ i j) (floor (/ i j))) - (define-unison (Int.signum i) (sgn i)) - (define-unison (Float.* x y) (fl* x y)) + (define-unison-builtin + (builtin-Nat.drop m n) + (max 0 (- m n))) - (define-unison (Nat.toFloat n) (->fl n)) + (define-unison-builtin + (builtin-Nat.increment n) + (clamp-natural (add1 n))) + (define-unison-builtin + (builtin-Int.increment i) (clamp-integer (add1 i))) + (define-unison-builtin + (builtin-Int.negate i) (if (> i nbit63) (- i) i)) + (define-unison-builtin + (builtin-Int.+ i j) (clamp-integer (+ i j))) + (define-unison-builtin + (builtin-Int.- i j) (clamp-integer (- i j))) + (define-unison-builtin + (builtin-Int./ i j) (floor (/ i j))) + (define-unison-builtin + (builtin-Int.signum i) (sgn i)) + (define-unison-builtin + (builtin-Float.* x y) (fl* x y)) - (define-unison (Float.ceiling f) + (define-unison-builtin + (builtin-Nat.toFloat n) (->fl n)) + + (define-unison-builtin + (builtin-Float.ceiling f) (clamp-integer (fl->exact-integer (ceiling f)))) ; If someone can suggest a better mechanism for these, ; that would be appreciated. - (define-unison (Float.toRepresentation fl) + (define-unison-builtin + (builtin-Float.toRepresentation fl) (integer-bytes->integer (real->floating-point-bytes fl 8 #t) ; big endian #f ; unsigned #t)) ; big endian - (define-unison (Float.fromRepresentation n) + (define-unison-builtin + (builtin-Float.fromRepresentation n) (floating-point-bytes->real (integer->integer-bytes n 8 #f #t) ; unsigned, big endian #t)) ; big endian - (define-unison (Int.toRepresentation i) + (define-unison-builtin + (builtin-Int.toRepresentation i) (integer-bytes->integer (integer->integer-bytes i 8 #t #t) ; signed, big endian #f #t)) ; unsigned, big endian - (define-unison (Int.fromRepresentation n) + (define-unison-builtin + (builtin-Int.fromRepresentation n) (integer-bytes->integer (integer->integer-bytes n 8 #f #t) ; unsigned, big endian #t #t)) ; signed, big endian diff --git a/scheme-libs/racket/unison/boot.ss b/scheme-libs/racket/unison/boot.ss index 67d390f9cf..64b1342344 100644 --- a/scheme-libs/racket/unison/boot.ss +++ b/scheme-libs/racket/unison/boot.ss @@ -55,6 +55,7 @@ bytes control define-unison + define-unison-builtin handle name data @@ -116,7 +117,8 @@ (require (for-syntax racket/set - (only-in racket partition flatten)) + (only-in racket partition flatten split-at) + (only-in racket/syntax format-id)) (rename-in (except-in racket false true unit any) [make-continuation-prompt-tag make-prompt]) @@ -151,78 +153,287 @@ (syntax-rules () [(with-name name e) (let ([name e]) name)])) -; function definition with slow/fast path. Slow path allows for -; under/overapplication. Fast path is exact application. +; Our definition macro needs to generate multiple entry points for the +; defined procedures, so this is a function for making up names for +; those based on the original. +(define-for-syntax (adjust-symbol name post) + (string->symbol + (string-append + (symbol->string name) + ":" + post))) + +(define-for-syntax (adjust-name name post) + (datum->syntax name (adjust-symbol (syntax->datum name) post) name)) + +; Helper function. Turns a list of syntax objects into a +; list-syntax object. +(define-for-syntax (list->syntax l) #`(#,@l)) + +; These are auxiliary functions for manipulating a unison definition +; into a form amenable for the right runtime behavior. This involves +; multiple separate definitions: ; -; The intent is for the scheme compiler to be able to recognize and -; optimize static, fast path calls itself, while still supporting -; unison-like automatic partial application and such. -(define-syntax (define-unison x) - (define (fast-path-symbol name) - (string->symbol - (string-append - (symbol->string name) - ":fast-path"))) - - (define (fast-path-name name) - (datum->syntax name (fast-path-symbol (syntax->datum name)))) - - ; Helper function. Turns a list of syntax objects into a - ; list-syntax object. - (define (list->syntax l) #`(#,@l)) - ; Builds partial application cases for unison functions. - ; It seems most efficient to have a case for each posible - ; under-application. - (define (build-partials name formals) - (let rec ([us formals] [acc '()]) - (syntax-case us () - [() (list->syntax (cons #`[() #,name] acc))] - [(a ... z) - (rec #'(a ...) - (cons - #`[(a ... z) - (with-name - #,(datum->syntax name (syntax->datum name)) - (partial-app #,name a ... z))] - acc))]))) - - ; Given an overall function name, a fast path name, and a list of - ; arguments, builds the case-lambda body of a unison function that - ; enables applying to arbitrary numbers of arguments. - (define (func-cases name name:fast args) - (syntax-case args () - [() (quasisyntax/loc x - (case-lambda - [() (#,name:fast)] - [r (apply (#,name:fast) r)]))] - [(a ... z) - (quasisyntax/loc x - (case-lambda - #,@(build-partials name #'(a ...)) - [(a ... z) (#,name:fast a ... z)] - [(a ... z . r) (apply (#,name:fast a ... z) r)]))])) - - (syntax-case x () - [(define-unison (name a ...) e ...) - (let ([fname (fast-path-name #'name)]) - (with-syntax ([name:fast fname] - [fast (syntax/loc x (lambda (a ...) e ...))] - [slow (func-cases #'name fname #'(a ...))]) - (syntax/loc x - (define-values (name:fast name) (values fast slow)))))])) +; 1. an :impl definition is generated containing the actual code body +; 2. a :fast definition, which takes exactly the number of arguments +; as the original, but checks if stack information needs to be +; stored for continuation serialization. +; 3. a :slow path which implements under/over application to unison +; definitions, so they act like curried functions, not scheme +; procedures +; 4. a macro that implements the actual occurrences, and directly +; calls the fast path for static calls with exactly the right +; number of arguments +; +; Additionally, arguments are threaded through the internal +; definitions that indicate whether an ability handler is in place +; that could potentially result in the continuation being serialized. +; If so, then calls write additional information to the continuation +; for that serialization. This isn't cheap for tight loops, so we +; attempt to avoid this as much as possible (conditioning the +; annotation on a flag checkseems to cause no performance loss). + + +; This builds the core definition for a unison definition. It is just +; a lambda expression with the original code, but with an additional +; keyword argument for threading purity information. +(define-for-syntax (make-impl name:impl:stx arg:stx body:stx) + (with-syntax ([name:impl name:impl:stx] + [args arg:stx] + [body body:stx]) + (syntax/loc body:stx + (define (name:impl #:pure pure? . args) . body)))) + +(define frame-contents (gensym)) + +; Builds the wrapper definition, 'fast path,' which just tests the +; purity, writes the stack information if necessary, and calls the +; implementation. If #:force-pure is specified, the fast path just +; directly calls the implementation procedure. This should allow +; tight loops to still perform well if we can detect that they +; (hereditarily) cannot make ability requests, even in contexts +; where a handler is present. +(define-for-syntax + (make-fast-path + #:force-pure force-pure? + loc ; original location + name:fast:stx name:impl:stx + arg:stx) + + (with-syntax ([name:impl name:impl:stx] + [name:fast name:fast:stx] + [args arg:stx]) + (if force-pure? + (syntax/loc loc + (define name:fast name:impl)) + + (syntax/loc loc + (define (name:fast #:pure pure? . args) + (if pure? + (name:impl #:pure pure? . args) + (with-continuation-mark + frame-contents + (vector . args) + (name:impl #:pure pure? . args)))))))) + +; Slow path -- unnecessary +; (define-for-syntax (make-slow-path loc name argstx) +; (with-syntax ([name:slow (adjust-symbol name "slow")] +; [n (length (syntax->list argstx))]) +; (syntax/loc loc +; (define (name:slow #:pure pure? . as) +; (define k (length as)) +; (cond +; [(< k n) (unison-closure n name:slow as)] +; [(= k n) (apply name:fast #:pure pure? as)] +; [(> k n) +; (define-values (h t) (split-at as n)) +; (apply +; (apply name:fast #:pure pure? h) +; #:pure pure? +; t)]))))) + +; This definition builds a macro that defines the behavior of actual +; occurences of the definition names. It has the following behavior: +; +; 1. Exactly saturated occurences directly call the fast path +; 2. Undersaturated or unapplied occurrences become closure +; construction +; 3. Oversaturated occurrences become an appropriate nested +; application +; +; Because of point 2, all function values end up represented as +; unison-closure objects, so a slow path procedure is no longer +; necessary; it is handled by the prop:procedure of the closure +; structure. This should also make various universal operations easier +; to handle, because we can just test for unison-closures, instead of +; having to deal with raw procedures. +(define-for-syntax + (make-callsite-macro + #:internal internal? + loc ; original location + name:stx name:fast:stx + arity:val) + (with-syntax ([name name:stx] + [name:fast name:fast:stx] + [arity arity:val]) + (cond + [internal? + (syntax/loc loc + (define-syntax (name stx) + (syntax-case stx () + [(_ #:by-name . bs) + (syntax/loc stx + (unison-closure arity name:fast (list . bs)))] + [(_ . bs) + (let ([k (length (syntax->list #'bs))]) + (cond + [(= arity k) ; saturated + (syntax/loc stx + (name:fast #:pure #t . bs))] + [(> arity k) ; undersaturated + (syntax/loc stx + (unison-closure arity name:fast (list . bs)))] + [(< arity k) ; oversaturated + (define-values (h t) + (split-at (syntax->list #'bs) arity)) + + (quasisyntax/loc stx + ((name:fast #:pure #t #,@h) #,@t))]))] + [_ (syntax/loc stx + (unison-closure arity name:fast (list)))])))] + [else + (syntax/loc loc + (define-syntax (name stx) + (syntax-case stx () + [(_ #:by-name . bs) + (syntax/loc stx + (unison-closure arity name:fast (list . bs)))] + [(_ . bs) + (let ([k (length (syntax->list #'bs))]) + + ; todo: purity + + ; capture local pure? + (with-syntax ([pure? (format-id stx "pure?")]) + (cond + [(= arity k) ; saturated + (syntax/loc stx + (name:fast #:pure pure? . bs))] + [(> arity k) + (syntax/loc stx + (unison-closure n name:fast (list . bs)))] + [(< arity k) ; oversaturated + (define-values (h t) + (split-at (syntax->list #'bs) arity)) + + ; TODO: pending argument frame + (quasisyntax/loc stx + ((name:fast #:pure pure? #,@h) + #:pure pure? + #,@t))])))] + ; non-applied occurrence; partial ap immediately + [_ (syntax/loc stx + (unison-closure arity name:fast (list)))])))]))) + +(define-for-syntax + (link-decl no-link-decl? loc name:stx name:fast:stx name:impl:stx) + (if no-link-decl? + #'() + (let ([name:link:stx (adjust-name name:stx "termlink")]) + (with-syntax + ([name:fast name:fast:stx] + [name:impl name:impl:stx] + [name:link name:link:stx]) + (syntax/loc loc + ((declare-function-link name:fast name:link) + (declare-function-link name:impl name:link))))))) + +(define-for-syntax (process-hints hs) + (for/fold ([internal? #f] + [force-pure? #f] + [gen-link? #f] + [no-link-decl? #f]) + ([h hs]) + (values + (or internal? (eq? h 'internal)) + (or force-pure? (eq? h 'force-pure) (eq? h 'internal)) + (or gen-link? (eq? h 'gen-link)) + (or no-link-decl? (eq? h 'no-link-decl))))) + +(define-for-syntax + (make-link-def gen-link? loc name:stx name:link:stx) + + (define name:txt (symbol->string (syntax->datum name:stx))) + + (cond + [gen-link? + (with-syntax ([name:link name:link:stx]) + (quasisyntax/loc loc + ((define name:link + (unison-termlink-builtin #,name:txt)))))] + [else #'()])) + +(define-for-syntax + (expand-define-unison + #:hints hints + loc name:stx arg:stx expr:stx) + + (define-values + (internal? force-pure? gen-link? no-link-decl?) + (process-hints hints)) + + (let ([name:fast:stx (adjust-name name:stx "fast")] + [name:impl:stx (adjust-name name:stx "impl")] + [name:link:stx (adjust-name name:stx "termlink")] + [arity (length (syntax->list arg:stx))]) + (with-syntax + ([(link ...) (make-link-def gen-link? loc name:stx name:link:stx)] + [fast (make-fast-path + #:force-pure force-pure? + loc name:fast:stx name:impl:stx arg:stx)] + [impl (make-impl name:impl:stx arg:stx expr:stx)] + [call (make-callsite-macro + #:internal internal? + loc name:stx name:fast:stx arity)] + [(decls ...) + (link-decl no-link-decl? loc name:stx name:fast:stx name:impl:stx)]) + (syntax/loc loc + (begin link ... impl fast call decls ...))))) + +; Function definition supporting various unison features, like +; partial application and continuation serialization. See above for +; details. +; +; `#:internal #t` indicates that the definition is for builtin +; functions. These should always be built in a way that does not +; annotate the stack, because they don't make relevant ability +; requests. This is important for performance and some correct +; behavior (i.e. they may occur in non-unison contexts where a +; `pure?` indicator is not being threaded). +(define-syntax (define-unison stx) + (syntax-case stx () + [(define-unison #:hints hs (name . args) . exprs) + (expand-define-unison + #:hints (syntax->datum #'hs) + stx #'name #'args #'exprs)] + [(define-unison (name . args) . exprs) + (expand-define-unison + #:hints '[internal] + stx #'name #'args #'exprs)])) + +(define-syntax (define-unison-builtin stx) + (syntax-case stx () + [(define-unison-builtin . rest) + (syntax/loc stx + (define-unison #:hints [internal gen-link] . rest))])) ; call-by-name bindings -(define-syntax name - (lambda (stx) - (syntax-case stx () - ((name ([v (f . args)] ...) body ...) - (with-syntax ([(lam ...) - (map (lambda (body) - (quasisyntax/loc stx - (lambda r #,body))) - (syntax->list #'[(apply f (append (list . args) r)) ...]))]) - #`(let ([v lam] ...) - body ...)))))) +(define-syntax (name stx) + (syntax-case stx () + [(name ([v (f . args)] ...) body ...) + (syntax/loc stx + (let ([v (f #:by-name . args)] ...) body ...))])) ; Wrapper that more closely matches `handle` constructs ; diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 2049e23b37..a929ad77c8 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -66,17 +66,17 @@ [cas! (lambda () (unsafe-struct*-cas! promise 2 value (some new-value)))] [awake-readers (lambda () (semaphore-post (promise-semaphore promise)))]) (cond - [(some? value) false] + [(some? value) sum-false] [else - (let ([ok (parameterize-break #f (if (cas!) (awake-readers) false))]) - (if ok true (loop)))])))) + (let ([ok (parameterize-break #f (if (cas!) (awake-readers) sum-false))]) + (if ok sum-true (loop)))])))) (define (ref-cas ref ticket value) - (if (box-cas! ref ticket value) true false)) + (if (box-cas! ref ticket value) sum-true sum-false)) (define (sleep n) (sleep-secs (/ n 1000000)) - (right unit)) + (right sum-unit)) ;; Swallows uncaught breaks/thread kills rather than logging them to ;; match the behaviour of the Haskell runtime @@ -88,5 +88,5 @@ (define (kill threadId) (break-thread threadId) - (right unit)) + (right sum-unit)) ) diff --git a/scheme-libs/racket/unison/core.ss b/scheme-libs/racket/unison/core.ss index a273938150..0c6e85a59e 100644 --- a/scheme-libs/racket/unison/core.ss +++ b/scheme-libs/racket/unison/core.ss @@ -192,7 +192,7 @@ (string-append "{Value " (describe-value v) "}")] [(unison-code v) (string-append "{Code " (describe-value v) "}")] - [(unison-closure code env) + [(unison-closure _ code env) (define dc (termlink->string (lookup-function-link code) #t)) (define (f v) diff --git a/scheme-libs/racket/unison/data.ss b/scheme-libs/racket/unison/data.ss index 7ab75d6d5b..02171a5411 100644 --- a/scheme-libs/racket/unison/data.ss +++ b/scheme-libs/racket/unison/data.ss @@ -45,9 +45,9 @@ left? either-get either-get - unit - false - true + sum-unit + sum-false + sum-true bool char ord @@ -290,13 +290,10 @@ (write-string ")" port)) (struct unison-closure - (code env) + (arity code env) #:transparent #:methods gen:custom-write [(define (write-proc clo port mode) - (define code-tl - (lookup-function-link (unison-closure-code clo))) - (define rec (case mode [(#t) write] @@ -308,12 +305,31 @@ (write-string " " port) (write-sequence (unison-closure-env clo) port mode) (write-string ")" port))] + + ; This has essentially becomes the slow path for unison function + ; application. The definition macro immediately creates a closure + ; for any statically under-saturated call or unapplied occurrence. + ; This means that there is never a bare unison function being passed + ; as a value. So, we can define the slow path here once and for all. #:property prop:procedure - (case-lambda - [(clo) clo] - [(clo . rest) - (apply (unison-closure-code clo) - (append (unison-closure-env clo) rest))])) + (lambda (clo #:pure [pure? #f] #:by-name [by-name? #f] . rest) + (define arity (unison-closure-arity clo)) + (define old-env (unison-closure-env clo)) + (define code (unison-closure-code clo)) + + (define new-env (append old-env rest)) + (define k (length rest)) + (define l (length new-env)) + (cond + [(or by-name? (> arity l)) + (struct-copy unison-closure clo [env new-env])] + [(= arity l) ; saturated + (apply code #:pure pure? new-env)] + [(= k 0) clo] ; special case, 0-applying undersaturated + [(< arity l) + ; TODO: pending arg annotation if no pure? + (define-values (now pending) (split-at new-env arity)) + (apply (apply code #:pure pure? now) #:pure pure? pending)]))) (struct unison-timespec (sec nsec) #:transparent @@ -344,9 +360,11 @@ [dname (datum->syntax stx (string->symbol (string-append - "builtin-" txt ":termlink")))]) - #`(define #,dname - (unison-termlink-builtin #,(datum->syntax stx txt))))])) + "builtin-" txt ":termlink")) + #'name)]) + (quasisyntax/loc stx + (define #,dname + (unison-termlink-builtin #,(datum->syntax stx txt)))))])) (define-syntax (declare-builtin-link stx) (syntax-case stx () @@ -357,7 +375,8 @@ [dname (datum->syntax stx (string->symbol (string-append txt ":termlink")))]) - #`(declare-function-link name #,dname))])) + (quasisyntax/loc stx + (declare-function-link name #,dname)))])) (define (partial-app f . args) (unison-closure f args)) @@ -382,11 +401,11 @@ ; # works as well ; Unit -(define unit (sum 0)) +(define sum-unit (sum 0)) ; Booleans are represented as numbers -(define false 0) -(define true 1) +(define sum-false 0) +(define sum-true 1) (define (bool b) (if b 1 0)) diff --git a/scheme-libs/racket/unison/io-handles.rkt b/scheme-libs/racket/unison/io-handles.rkt index 9f5c1bdc6f..575d247163 100644 --- a/scheme-libs/racket/unison/io-handles.rkt +++ b/scheme-libs/racket/unison/io-handles.rkt @@ -3,7 +3,7 @@ rnrs/io/ports-6 (only-in rnrs standard-error-port standard-input-port standard-output-port vector-map) (only-in racket empty? with-output-to-string system/exit-code system false?) - (only-in unison/boot data-case define-unison) + (only-in unison/boot data-case define-unison-builtin) unison/data unison/chunked-seq unison/data @@ -15,26 +15,39 @@ (provide unison-FOp-IO.stdHandle unison-FOp-IO.openFile.impl.v3 - (prefix-out - builtin-IO. - (combine-out - seekHandle.impl.v3 - getLine.impl.v1 - getSomeBytes.impl.v1 - getBuffering.impl.v3 - setBuffering.impl.v3 - getEcho.impl.v1 - setEcho.impl.v1 - getArgs.impl.v1 - getEnv.impl.v1 - getChar.impl.v1 - isFileOpen.impl.v3 - isSeekable.impl.v3 - handlePosition.impl.v3 - process.call - getCurrentDirectory.impl.v3 - ready.impl.v1 - )) + + builtin-IO.seekHandle.impl.v3 + builtin-IO.seekHandle.impl.v3:termlink + builtin-IO.getLine.impl.v1 + builtin-IO.getLine.impl.v1:termlink + builtin-IO.getSomeBytes.impl.v1 + builtin-IO.getSomeBytes.impl.v1:termlink + builtin-IO.getBuffering.impl.v3 + builtin-IO.getBuffering.impl.v3:termlink + builtin-IO.setBuffering.impl.v3 + builtin-IO.setBuffering.impl.v3:termlink + builtin-IO.getEcho.impl.v1 + builtin-IO.getEcho.impl.v1:termlink + builtin-IO.setEcho.impl.v1 + builtin-IO.setEcho.impl.v1:termlink + builtin-IO.getArgs.impl.v1 + builtin-IO.getArgs.impl.v1:termlink + builtin-IO.getEnv.impl.v1 + builtin-IO.getEnv.impl.v1:termlink + builtin-IO.getChar.impl.v1 + builtin-IO.getChar.impl.v1:termlink + builtin-IO.isFileOpen.impl.v3 + builtin-IO.isFileOpen.impl.v3:termlink + builtin-IO.isSeekable.impl.v3 + builtin-IO.isSeekable.impl.v3:termlink + builtin-IO.handlePosition.impl.v3 + builtin-IO.handlePosition.impl.v3:termlink + builtin-IO.process.call + builtin-IO.process.call:termlink + builtin-IO.getCurrentDirectory.impl.v3 + builtin-IO.getCurrentDirectory.impl.v3:termlink + builtin-IO.ready.impl.v1 + builtin-IO.ready.impl.v1:termlink ; Still to implement: ; handlePosition.impl.v3 @@ -49,28 +62,34 @@ [f (ref-failure-failure typeLink msg a)]) (ref-either-left f))) -(define-unison (isFileOpen.impl.v3 port) +(define-unison-builtin + (builtin-IO.isFileOpen.impl.v3 port) (ref-either-right (not (port-closed? port)))) -(define-unison (ready.impl.v1 port) +(define-unison-builtin + (builtin-IO.ready.impl.v1 port) (if (byte-ready? port) (ref-either-right #t) (if (port-eof? port) (Exception ref-iofailure:typelink "EOF" port) (ref-either-right #f)))) -(define-unison (getCurrentDirectory.impl.v3 unit) +(define-unison-builtin + (builtin-IO.getCurrentDirectory.impl.v3 unit) (ref-either-right (string->chunked-string (path->string (current-directory))))) -(define-unison (isSeekable.impl.v3 handle) +(define-unison-builtin + (builtin-IO.isSeekable.impl.v3 handle) (ref-either-right (port-has-set-port-position!? handle))) -(define-unison (handlePosition.impl.v3 handle) +(define-unison-builtin + (builtin-IO.handlePosition.impl.v3 handle) (ref-either-right (port-position handle))) -(define-unison (seekHandle.impl.v3 handle mode amount) +(define-unison-builtin + (builtin-IO.seekHandle.impl.v3 handle mode amount) (data-case mode (0 () (set-port-position! handle amount) @@ -85,14 +104,16 @@ "SeekFromEnd not supported" 0)))) -(define-unison (getLine.impl.v1 handle) +(define-unison-builtin + (builtin-IO.getLine.impl.v1 handle) (let* ([line (read-line handle)]) (if (eof-object? line) (ref-either-right (string->chunked-string "")) (ref-either-right (string->chunked-string line)) ))) -(define-unison (getChar.impl.v1 handle) +(define-unison-builtin + (builtin-IO.getChar.impl.v1 handle) (let* ([char (read-char handle)]) (if (eof-object? char) (Exception @@ -101,7 +122,8 @@ ref-unit-unit) (ref-either-right char)))) -(define-unison (getSomeBytes.impl.v1 handle nbytes) +(define-unison-builtin + (builtin-IO.getSomeBytes.impl.v1 handle nbytes) (let* ([buffer (make-bytes nbytes)] [line (read-bytes-avail! buffer handle)]) (cond @@ -119,7 +141,8 @@ (subbytes buffer 0 line) buffer)))]))) -(define-unison (getBuffering.impl.v3 handle) +(define-unison-builtin + (builtin-IO.getBuffering.impl.v3 handle) (case (file-stream-buffer-mode handle) [(none) (ref-either-right ref-buffermode-no-buffering)] [(line) (ref-either-right @@ -135,7 +158,8 @@ "Unexpected response from file-stream-buffer-mode" ref-unit-unit)])) -(define-unison (setBuffering.impl.v3 handle mode) +(define-unison-builtin + (builtin-IO.setBuffering.impl.v3 handle mode) (data-case mode (0 () (file-stream-buffer-mode handle 'none) @@ -166,7 +190,8 @@ [(1) stdout] [(2) stderr])) -(define-unison (getEcho.impl.v1 handle) +(define-unison-builtin + (builtin-IO.getEcho.impl.v1 handle) (if (eq? handle stdin) (ref-either-right (get-stdin-echo)) (Exception @@ -174,7 +199,8 @@ "getEcho only supported on stdin" ref-unit-unit))) -(define-unison (setEcho.impl.v1 handle echo) +(define-unison-builtin + (builtin-IO.setEcho.impl.v1 handle echo) (if (eq? handle stdin) (begin (if echo @@ -190,12 +216,14 @@ (let ([current (with-output-to-string (lambda () (system "stty -a")))]) (string-contains? current " echo "))) -(define-unison (getArgs.impl.v1 unit) +(define-unison-builtin + (builtin-IO.getArgs.impl.v1 unit) (ref-either-right (vector->chunked-list (vector-map string->chunked-string (current-command-line-arguments))))) -(define-unison (getEnv.impl.v1 key) +(define-unison-builtin + (builtin-IO.getEnv.impl.v1 key) (let ([value (environment-variables-ref (current-environment-variables) (string->bytes/utf-8 (chunked-string->string key)))]) (if (false? value) (Exception @@ -224,7 +252,8 @@ s) "''")) -(define-unison (process.call command arguments) +(define-unison-builtin + (builtin-IO.process.call command arguments) (system/exit-code (string-join (cons (chunked-string->string command) diff --git a/scheme-libs/racket/unison/io.rkt b/scheme-libs/racket/unison/io.rkt index bc94c53149..ae99bd1978 100644 --- a/scheme-libs/racket/unison/io.rkt +++ b/scheme-libs/racket/unison/io.rkt @@ -9,7 +9,7 @@ date-dst? date-time-zone-offset date*-time-zone-name) - (only-in unison/boot data-case define-unison) + (only-in unison/boot data-case define-unison-builtin) (only-in rnrs/arithmetic/flonums-6 flmod)) @@ -33,20 +33,29 @@ getTempDirectory.impl.v3 removeFile.impl.v3 getFileSize.impl.v3)) - (prefix-out - builtin-IO. - (combine-out - fileExists.impl.v3 - renameFile.impl.v3 - createDirectory.impl.v3 - removeDirectory.impl.v3 - directoryContents.impl.v3 - setCurrentDirectory.impl.v3 - renameDirectory.impl.v3 - isDirectory.impl.v3 - systemTime.impl.v3 - systemTimeMicroseconds.impl.v3 - createTempDirectory.impl.v3))) + + builtin-IO.fileExists.impl.v3 + builtin-IO.fileExists.impl.v3:termlink + builtin-IO.renameFile.impl.v3 + builtin-IO.renameFile.impl.v3:termlink + builtin-IO.createDirectory.impl.v3 + builtin-IO.createDirectory.impl.v3:termlink + builtin-IO.removeDirectory.impl.v3 + builtin-IO.removeDirectory.impl.v3:termlink + builtin-IO.directoryContents.impl.v3 + builtin-IO.directoryContents.impl.v3:termlink + builtin-IO.setCurrentDirectory.impl.v3 + builtin-IO.setCurrentDirectory.impl.v3:termlink + builtin-IO.renameDirectory.impl.v3 + builtin-IO.renameDirectory.impl.v3:termlink + builtin-IO.isDirectory.impl.v3 + builtin-IO.isDirectory.impl.v3:termlink + builtin-IO.systemTime.impl.v3 + builtin-IO.systemTime.impl.v3:termlink + builtin-IO.systemTimeMicroseconds.impl.v3 + builtin-IO.systemTimeMicroseconds.impl.v3:termlink + builtin-IO.createTempDirectory.impl.v3 + builtin-IO.createTempDirectory.impl.v3:termlink) (define (failure-result ty msg vl) (ref-either-left @@ -76,7 +85,8 @@ (right (file-or-directory-modify-seconds (chunked-string->string path))))) ; in haskell, it's not just file but also directory -(define-unison (fileExists.impl.v3 path) +(define-unison-builtin + (builtin-IO.fileExists.impl.v3 path) (let ([path-string (chunked-string->string path)]) (ref-either-right (or @@ -90,11 +100,13 @@ (define (getTempDirectory.impl.v3) (right (string->chunked-string (path->string (find-system-path 'temp-dir))))) -(define-unison (setCurrentDirectory.impl.v3 path) +(define-unison-builtin + (builtin-IO.setCurrentDirectory.impl.v3 path) (current-directory (chunked-string->string path)) (ref-either-right none)) -(define-unison (directoryContents.impl.v3 path) +(define-unison-builtin + (builtin-IO.directoryContents.impl.v3 path) (with-handlers [[exn:fail:filesystem? (lambda (e) @@ -112,7 +124,8 @@ (list* "." ".." dirss)))))))) -(define-unison (createTempDirectory.impl.v3 prefix) +(define-unison-builtin + (builtin-IO.createTempDirectory.impl.v3 prefix) (ref-either-right (string->chunked-string (path->string @@ -120,35 +133,43 @@ (string->bytes/utf-8 (chunked-string->string prefix)) #""))))) -(define-unison (createDirectory.impl.v3 file) +(define-unison-builtin + (builtin-IO.createDirectory.impl.v3 file) (make-directory (chunked-string->string file)) (ref-either-right none)) -(define-unison (removeDirectory.impl.v3 file) +(define-unison-builtin + (builtin-IO.removeDirectory.impl.v3 file) (delete-directory/files (chunked-string->string file)) (ref-either-right none)) -(define-unison (isDirectory.impl.v3 path) +(define-unison-builtin + (builtin-IO.isDirectory.impl.v3 path) (ref-either-right (directory-exists? (chunked-string->string path)))) -(define-unison (renameDirectory.impl.v3 old new) +(define-unison-builtin + (builtin-IO.renameDirectory.impl.v3 old new) (rename-file-or-directory (chunked-string->string old) (chunked-string->string new)) (ref-either-right none)) -(define-unison (renameFile.impl.v3 old new) +(define-unison-builtin + (builtin-IO.renameFile.impl.v3 old new) (rename-file-or-directory (chunked-string->string old) (chunked-string->string new)) (ref-either-right none)) -(define-unison (systemTime.impl.v3 unit) +(define-unison-builtin + (builtin-IO.systemTime.impl.v3 unit) (ref-either-right (current-seconds))) -(define-unison (systemTimeMicroseconds.impl.v3 unit) +(define-unison-builtin + (builtin-IO.systemTimeMicroseconds.impl.v3 unit) (ref-either-right (inexact->exact (* 1000 (current-inexact-milliseconds))))) -(define-unison (builtin-Clock.internals.systemTimeZone.v1 secs) +(define-unison-builtin + (builtin-Clock.internals.systemTimeZone.v1 secs) (let* ([d (seconds->date secs)]) (list->unison-tuple (list diff --git a/scheme-libs/racket/unison/math.rkt b/scheme-libs/racket/unison/math.rkt index 2e34a49987..654ac6944d 100644 --- a/scheme-libs/racket/unison/math.rkt +++ b/scheme-libs/racket/unison/math.rkt @@ -7,24 +7,39 @@ clamp-integer clamp-natural data-case - define-unison + define-unison-builtin nbit63)) (provide - builtin-Float.exp - builtin-Float.log - builtin-Float.max - builtin-Float.min - builtin-Float.tan - builtin-Float.tanh - builtin-Float.logBase - builtin-Int.* - builtin-Int.pow - builtin-Int.trailingZeros - builtin-Nat.trailingZeros - builtin-Int.popCount - builtin-Nat.popCount - builtin-Float.pow + builtin-Float.exp + builtin-Float.exp:termlink + builtin-Float.log + builtin-Float.log:termlink + builtin-Float.max + builtin-Float.max:termlink + builtin-Float.min + builtin-Float.min:termlink + builtin-Float.tan + builtin-Float.tan:termlink + builtin-Float.tanh + builtin-Float.tanh:termlink + builtin-Float.logBase + builtin-Float.logBase:termlink + builtin-Int.* + builtin-Int.*:termlink + builtin-Int.pow + builtin-Int.pow:termlink + builtin-Int.trailingZeros + builtin-Int.trailingZeros:termlink + builtin-Nat.trailingZeros + builtin-Nat.trailingZeros:termlink + builtin-Int.popCount + builtin-Int.popCount:termlink + builtin-Nat.popCount + builtin-Nat.popCount:termlink + builtin-Float.pow + builtin-Float.pow:termlink + (prefix-out unison-POp- (combine-out ABSF @@ -71,21 +86,50 @@ SINF ITOF))) -(define-unison (builtin-Float.logBase base num) (log num base)) +(define-unison-builtin + (builtin-Float.logBase base num) + (log num base)) (define (LOGB base num) (log num base)) -(define-unison (builtin-Float.exp n) (exp n)) -(define-unison (builtin-Float.log n) (log n)) -(define-unison (builtin-Float.max n m) (max n m)) -(define-unison (builtin-Float.min n m) (min n m)) -(define-unison (builtin-Float.tan n) (tan n)) -(define-unison (builtin-Float.tanh n) (tanh n)) -(define-unison (builtin-Int.* n m) (clamp-integer (* n m))) -(define-unison (builtin-Int.pow n m) (clamp-integer (expt n m))) -(define-unison (builtin-Int.trailingZeros n) (TZRO n)) -(define-unison (builtin-Nat.trailingZeros n) (TZRO n)) -(define-unison (builtin-Nat.popCount n) (POPC n)) -(define-unison (builtin-Int.popCount n) (POPC n)) -(define-unison (builtin-Float.pow n m) (expt n m)) + +(define-unison-builtin + (builtin-Float.exp n) (exp n)) + +(define-unison-builtin + (builtin-Float.log n) (log n)) + +(define-unison-builtin + (builtin-Float.max n m) (max n m)) + +(define-unison-builtin + (builtin-Float.min n m) (min n m)) + +(define-unison-builtin + (builtin-Float.tan n) (tan n)) + +(define-unison-builtin + (builtin-Float.tanh n) (tanh n)) + +(define-unison-builtin + (builtin-Int.* n m) (clamp-integer (* n m))) + +(define-unison-builtin + (builtin-Int.pow n m) (clamp-integer (expt n m))) + +(define-unison-builtin + (builtin-Int.trailingZeros n) (TZRO n)) + +(define-unison-builtin + (builtin-Nat.trailingZeros n) (TZRO n)) + +(define-unison-builtin + (builtin-Nat.popCount n) (POPC n)) + +(define-unison-builtin + (builtin-Int.popCount n) (POPC n)) + +(define-unison-builtin + (builtin-Float.pow n m) (expt n m)) + (define (EXPF n) (exp n)) (define ABSF abs) (define ACOS acos) diff --git a/scheme-libs/racket/unison/primops-generated.rkt b/scheme-libs/racket/unison/primops-generated.rkt index 0e9b462ff6..54bd9cd4c4 100644 --- a/scheme-libs/racket/unison/primops-generated.rkt +++ b/scheme-libs/racket/unison/primops-generated.rkt @@ -31,9 +31,11 @@ builtin-sandboxLinks builtin-sandboxLinks:termlink + builtin-Code.dependencies:termlink builtin-Code.deserialize:termlink builtin-Code.serialize:termlink builtin-Code.validateLinks:termlink + builtin-Value.dependencies:termlink builtin-Value.deserialize:termlink builtin-Value.serialize:termlink builtin-crypto.hash:termlink @@ -54,21 +56,15 @@ build-runtime-module termlink->proc) -(define-builtin-link Value.value) -(define-builtin-link Value.reflect) -(define-builtin-link Code.isMissing) -(define-builtin-link Code.lookup) - +(define-builtin-link Code.dependencies) (define-builtin-link Code.deserialize) (define-builtin-link Code.serialize) (define-builtin-link Code.validateLinks) +(define-builtin-link Value.dependencies) (define-builtin-link Value.deserialize) (define-builtin-link Value.serialize) (define-builtin-link crypto.hash) (define-builtin-link crypto.hmac) -(define-builtin-link validateSandboxed) -(define-builtin-link Value.validateSandboxed) -(define-builtin-link sandboxLinks) (define (chunked-list->list cl) (vector->list (chunked-list->vector cl))) @@ -129,14 +125,33 @@ (raise (format "decode-binding: unimplemented case: ~a" bn))])) +(define (decode-hints hs) + (define (hint->sym t) + (cond + [(= t ref-defnhint-internal:tag) 'internal] + [(= t ref-defnhint-genlink:tag) 'gen-link] + [(= t ref-defnhint-nolinkdecl:tag) 'no-link-decl])) + + (for/fold ([def 'define-unison] [out '()]) ([h hs]) + (match h + [(unison-data _ t (list)) + #:when (= t ref-defnhint-builtin:tag) + (values 'define-unison-builtin out)] + [(unison-data _ t (list)) + (values def (cons (hint->sym t) out))]))) + (define (decode-syntax dfn) (match dfn - [(unison-data _ t (list nm vs bd)) + [(unison-data _ t (list nm hs vs bd)) #:when (= t ref-schemedefn-define:tag) - (let ([head (map text->ident - (cons nm (chunked-list->list vs)))] - [body (decode-term bd)]) - (list 'define-unison head body))] + (let-values + ([(head) (map text->ident + (cons nm (chunked-list->list vs)))] + [(def hints) (decode-hints (chunked-list->list hs))] + [(body) (decode-term bd)]) + (if (null? hints) + (list def head body) + (list def '#:hints hints head body)))] [(unison-data _ t (list nm bd)) #:when (= t ref-schemedefn-alias:tag) (list 'define (text->ident nm) (decode-term bd))] @@ -413,7 +428,7 @@ (ref-value-vlit (ref-vlit-typelink (reflect-typelink v)))] [(unison-code sg) (ref-value-vlit (ref-vlit-code sg))] [(unison-quote q) (ref-value-vlit (ref-vlit-quote q))] - [(unison-closure f as) + [(unison-closure arity f as) (ref-value-partial (function->groupref f) (list->chunked-list (map reflect-value as)))] @@ -438,7 +453,7 @@ [(? chunked-list?) (for/fold ([acc '()]) ([e (in-chunked-list v)]) (append (sandbox-value ok e) acc))] - [(unison-closure f as) + [(unison-closure arity f as) (for/fold ([acc (sandbox-proc ok f)]) ([a (in-list as)]) (append (sandbox-scheme-value ok a) acc))] [(? procedure?) (sandbox-proc ok v)] @@ -474,11 +489,11 @@ [(unison-quote v) (sandbox-value ok v)])) ; replacment for Value.unsafeValue : a -> Value -(define-unison +(define-unison-builtin (builtin-Value.reflect v) (reflect-value v)) -(define-unison +(define-unison-builtin (builtin-Value.value v) (let ([rv (reflect-value v)]) (unison-quote rv))) @@ -706,23 +721,23 @@ (define (unison-POp-LKUP tl) (lookup-code tl)) -(define-unison (builtin-Code.lookup tl) +(define-unison-builtin (builtin-Code.lookup tl) (match (lookup-code tl) [(unison-sum 0 (list)) ref-optional-none] [(unison-sum 1 (list co)) (ref-optional-some co)])) -(define-unison (builtin-validateSandboxed ok v) +(define-unison-builtin (builtin-validateSandboxed ok v) (let ([l (sandbox-scheme-value (chunked-list->list ok) v)]) (null? l))) -(define-unison (builtin-sandboxLinks tl) (check-sandbox tl)) +(define-unison-builtin (builtin-sandboxLinks tl) (check-sandbox tl)) -(define-unison (builtin-Code.isMissing tl) +(define-unison-builtin (builtin-Code.isMissing tl) (cond [(unison-termlink-builtin? tl) #f] [(unison-termlink-con? tl) #f] [(have-code? tl) #t] [else #f])) -(define-unison (builtin-Value.validateSandboxed ok v) +(define-unison-builtin (builtin-Value.validateSandboxed ok v) (sandbox-quoted (chunked-list->list ok) v)) diff --git a/scheme-libs/racket/unison/primops.ss b/scheme-libs/racket/unison/primops.ss index 225b68acdb..712727499f 100644 --- a/scheme-libs/racket/unison/primops.ss +++ b/scheme-libs/racket/unison/primops.ss @@ -21,1499 +21,1476 @@ ; Unison.Runtime.Builtin, so the POp/FOp implementation must ; take/return arguments that match what is expected in those wrappers. -#!r6rs -(library (unison primops) - (export - builtin-Float.* - builtin-Float.*:termlink - builtin-Float.>= - builtin-Float.>=:termlink - builtin-Float.<= - builtin-Float.<=:termlink - builtin-Float.> - builtin-Float.>:termlink - builtin-Float.< - builtin-Float.<:termlink - builtin-Float.== - builtin-Float.==:termlink - builtin-Float.fromRepresentation - builtin-Float.fromRepresentation:termlink - builtin-Float.toRepresentation - builtin-Float.toRepresentation:termlink - builtin-Float.ceiling - builtin-Float.ceiling:termlink - builtin-Float.exp - builtin-Float.exp:termlink - builtin-Float.log - builtin-Float.log:termlink - builtin-Float.max - builtin-Float.max:termlink - builtin-Float.min - builtin-Float.min:termlink - builtin-Float.tan - builtin-Float.tan:termlink - builtin-Float.tanh - builtin-Float.tanh:termlink - builtin-Float.logBase - builtin-Float.logBase:termlink - builtin-Float.pow - builtin-Float.pow:termlink - builtin-Int.pow - builtin-Int.pow:termlink - builtin-Int.* - builtin-Int.*:termlink - builtin-Int.+ - builtin-Int.+:termlink - builtin-Int.- - builtin-Int.-:termlink - builtin-Int./ - builtin-Int./:termlink - builtin-Int.increment - builtin-Int.increment:termlink - builtin-Int.negate - builtin-Int.negate:termlink - builtin-Int.fromRepresentation - builtin-Int.fromRepresentation:termlink - builtin-Int.toRepresentation - builtin-Int.toRepresentation:termlink - builtin-Int.signum - builtin-Int.signum:termlink - builtin-Int.trailingZeros - builtin-Int.trailingZeros:termlink - builtin-Int.popCount - builtin-Int.popCount:termlink - builtin-Int.isEven - builtin-Int.isEven:termlink - builtin-Int.isOdd - builtin-Int.isOdd:termlink - builtin-Int.== - builtin-Int.==:termlink - builtin-Int.< - builtin-Int.<:termlink - builtin-Int.<= - builtin-Int.<=:termlink - builtin-Int.> - builtin-Int.>:termlink - builtin-Int.>= - builtin-Int.>=:termlink - builtin-Nat.+ - builtin-Nat.+:termlink - builtin-Nat.drop - builtin-Nat.drop:termlink - builtin-Nat.== - builtin-Nat.==:termlink - builtin-Nat.< - builtin-Nat.<:termlink - builtin-Nat.<= - builtin-Nat.<=:termlink - builtin-Nat.> - builtin-Nat.>:termlink - builtin-Nat.>= - builtin-Nat.>=:termlink - builtin-Nat.isEven - builtin-Nat.isEven:termlink - builtin-Nat.isOdd - builtin-Nat.isOdd:termlink - builtin-Nat.increment - builtin-Nat.increment:termlink - builtin-Nat.popCount - builtin-Nat.popCount:termlink - builtin-Nat.toFloat - builtin-Nat.toFloat:termlink - builtin-Nat.trailingZeros - builtin-Nat.trailingZeros:termlink - builtin-Text.indexOf - builtin-Text.indexOf:termlink - builtin-Text.== - builtin-Text.==:termlink - builtin-Text.!= - builtin-Text.!=:termlink - builtin-Text.<= - builtin-Text.<=:termlink - builtin-Text.>= - builtin-Text.>=:termlink - builtin-Text.< - builtin-Text.<:termlink - builtin-Text.> - builtin-Text.>:termlink - builtin-Bytes.indexOf - builtin-Bytes.indexOf:termlink - builtin-IO.randomBytes - builtin-IO.randomBytes:termlink - builtin-IO.tryEval - builtin-IO.tryEval:termlink - - builtin-Scope.bytearrayOf - builtin-Scope.bytearrayOf:termlink - - builtin-Universal.== - builtin-Universal.==:termlink - builtin-Universal.> - builtin-Universal.>:termlink - builtin-Universal.>= - builtin-Universal.>=:termlink - builtin-Universal.< - builtin-Universal.<:termlink - builtin-Universal.<= - builtin-Universal.<=:termlink - builtin-Universal.compare - builtin-Universal.compare:termlink - builtin-Universal.murmurHash:termlink - - builtin-unsafe.coerceAbilities - builtin-unsafe.coerceAbilities:termlink - - builtin-List.splitLeft - builtin-List.splitLeft:termlink - builtin-List.splitRight - builtin-List.splitRight:termlink - - builtin-Link.Term.toText - builtin-Link.Term.toText:termlink - - builtin-Value.toBuiltin - builtin-Value.toBuiltin:termlink - builtin-Value.fromBuiltin - builtin-Value.fromBuiltin:termlink - builtin-Code.fromGroup - builtin-Code.fromGroup:termlink - builtin-Code.toGroup - builtin-Code.toGroup:termlink - builtin-TermLink.fromReferent - builtin-TermLink.fromReferent:termlink - builtin-TermLink.toReferent - builtin-TermLink.toReferent:termlink - builtin-TypeLink.toReference - builtin-TypeLink.toReference:termlink - - builtin-IO.UDP.clientSocket.impl.v1 - builtin-IO.UDP.clientSocket.impl.v1:termlink - builtin-IO.UDP.UDPSocket.recv.impl.v1 - builtin-IO.UDP.UDPSocket.recv.impl.v1:termlink - builtin-IO.UDP.UDPSocket.send.impl.v1 - builtin-IO.UDP.UDPSocket.send.impl.v1:termlink - builtin-IO.UDP.UDPSocket.close.impl.v1 - builtin-IO.UDP.UDPSocket.close.impl.v1:termlink - builtin-IO.UDP.ListenSocket.close.impl.v1 - builtin-IO.UDP.ListenSocket.close.impl.v1:termlink - builtin-IO.UDP.UDPSocket.toText.impl.v1 - builtin-IO.UDP.UDPSocket.toText.impl.v1:termlink - builtin-IO.UDP.serverSocket.impl.v1 - builtin-IO.UDP.serverSocket.impl.v1:termlink - builtin-IO.UDP.ListenSocket.toText.impl.v1 - builtin-IO.UDP.ListenSocket.toText.impl.v1:termlink - builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 - builtin-IO.UDP.ListenSocket.recvFrom.impl.v1:termlink - builtin-IO.UDP.ClientSockAddr.toText.v1 - builtin-IO.UDP.ClientSockAddr.toText.v1:termlink - builtin-IO.UDP.ListenSocket.sendTo.impl.v1 - builtin-IO.UDP.ListenSocket.sendTo.impl.v1:termlink - - unison-FOp-internal.dataTag - unison-FOp-Char.toText - ; unison-FOp-Code.dependencies - ; unison-FOp-Code.serialize - unison-FOp-IO.closeFile.impl.v3 - unison-FOp-IO.openFile.impl.v3 - ; unison-FOp-IO.isFileEOF.impl.v3 - unison-FOp-IO.putBytes.impl.v3 - unison-FOp-IO.getBytes.impl.v3 - builtin-IO.seekHandle.impl.v3 - builtin-IO.seekHandle.impl.v3:termlink - builtin-IO.getLine.impl.v1 - builtin-IO.getLine.impl.v1:termlink - builtin-IO.getSomeBytes.impl.v1 - builtin-IO.getSomeBytes.impl.v1:termlink - builtin-IO.setBuffering.impl.v3 - builtin-IO.setBuffering.impl.v3:termlink - builtin-IO.getBuffering.impl.v3 - builtin-IO.getBuffering.impl.v3:termlink - builtin-IO.setEcho.impl.v1 - builtin-IO.setEcho.impl.v1:termlink - builtin-IO.isFileOpen.impl.v3 - builtin-IO.isFileOpen.impl.v3:termlink - builtin-IO.ready.impl.v1 - builtin-IO.ready.impl.v1:termlink - builtin-IO.process.call - builtin-IO.process.call:termlink - builtin-IO.getEcho.impl.v1 - builtin-IO.getEcho.impl.v1:termlink - builtin-IO.getArgs.impl.v1 - builtin-IO.getArgs.impl.v1:termlink - builtin-IO.getEnv.impl.v1 - builtin-IO.getEnv.impl.v1:termlink - builtin-IO.getChar.impl.v1 - builtin-IO.getChar.impl.v1:termlink - builtin-IO.getCurrentDirectory.impl.v3 - builtin-IO.getCurrentDirectory.impl.v3:termlink - builtin-IO.removeDirectory.impl.v3 - builtin-IO.removeDirectory.impl.v3:termlink - builtin-IO.renameFile.impl.v3 - builtin-IO.renameFile.impl.v3:termlink - builtin-IO.createTempDirectory.impl.v3 - builtin-IO.createTempDirectory.impl.v3:termlink - builtin-IO.createDirectory.impl.v3 - builtin-IO.createDirectory.impl.v3:termlink - builtin-IO.setCurrentDirectory.impl.v3 - builtin-IO.setCurrentDirectory.impl.v3:termlink - builtin-IO.renameDirectory.impl.v3 - builtin-IO.renameDirectory.impl.v3:termlink - builtin-IO.isDirectory.impl.v3 - builtin-IO.isDirectory.impl.v3:termlink - builtin-IO.isSeekable.impl.v3 - builtin-IO.isSeekable.impl.v3:termlink - builtin-IO.handlePosition.impl.v3 - builtin-IO.handlePosition.impl.v3:termlink - builtin-IO.systemTime.impl.v3 - builtin-IO.systemTime.impl.v3:termlink - builtin-IO.systemTimeMicroseconds.impl.v3 - builtin-IO.systemTimeMicroseconds.impl.v3:termlink - - builtin-Char.Class.is - builtin-Char.Class.is:termlink - builtin-Pattern.captureAs - builtin-Pattern.captureAs:termlink - builtin-Pattern.many.corrected - builtin-Pattern.many.corrected:termlink - builtin-Pattern.isMatch - builtin-Pattern.isMatch:termlink - builtin-IO.fileExists.impl.v3 - builtin-IO.fileExists.impl.v3:termlink - builtin-IO.isFileEOF.impl.v3 - builtin-IO.isFileEOF.impl.v3:termlink - - unison-FOp-IO.getFileSize.impl.v3 - unison-FOp-IO.getFileTimestamp.impl.v3 - ; unison-FOp-IO.fileExists.impl.v3 - unison-FOp-IO.removeFile.impl.v3 - unison-FOp-IO.getTempDirectory.impl.v3 - unison-FOp-Text.fromUtf8.impl.v3 - unison-FOp-Text.repeat - unison-FOp-Text.reverse - unison-FOp-Text.toUtf8 - unison-FOp-Text.toLowercase - unison-FOp-Text.toUppercase - unison-FOp-Pattern.run - unison-FOp-Pattern.isMatch - unison-FOp-Pattern.many - unison-FOp-Pattern.capture - unison-FOp-Pattern.join - unison-FOp-Pattern.or - unison-FOp-Pattern.replicate - unison-FOp-Text.patterns.digit - unison-FOp-Text.patterns.letter - unison-FOp-Text.patterns.punctuation - unison-FOp-Text.patterns.charIn - unison-FOp-Text.patterns.notCharIn - unison-FOp-Text.patterns.anyChar - unison-FOp-Text.patterns.space - unison-FOp-Text.patterns.charRange - unison-FOp-Text.patterns.notCharRange - unison-FOp-Text.patterns.literal - unison-FOp-Text.patterns.eof - unison-FOp-Text.patterns.char - unison-FOp-Char.Class.is - unison-FOp-Char.Class.any - unison-FOp-Char.Class.alphanumeric - unison-FOp-Char.Class.upper - unison-FOp-Char.Class.lower - unison-FOp-Char.Class.number - unison-FOp-Char.Class.punctuation - unison-FOp-Char.Class.symbol - unison-FOp-Char.Class.letter - unison-FOp-Char.Class.whitespace - unison-FOp-Char.Class.control - unison-FOp-Char.Class.printable - unison-FOp-Char.Class.mark - unison-FOp-Char.Class.separator - unison-FOp-Char.Class.or - unison-FOp-Char.Class.range - unison-FOp-Char.Class.anyOf - unison-FOp-Char.Class.and - unison-FOp-Char.Class.not - unison-FOp-Clock.internals.nsec.v1 - unison-FOp-Clock.internals.sec.v1 - unison-FOp-Clock.internals.threadCPUTime.v1 - unison-FOp-Clock.internals.processCPUTime.v1 - unison-FOp-Clock.internals.realtime.v1 - unison-FOp-Clock.internals.monotonic.v1 - builtin-Clock.internals.systemTimeZone.v1 - builtin-Clock.internals.systemTimeZone.v1:termlink - - - ; unison-FOp-Value.serialize - unison-FOp-IO.stdHandle - unison-FOp-IO.getArgs.impl.v1 - - builtin-IO.directoryContents.impl.v3 - builtin-IO.directoryContents.impl.v3:termlink - unison-FOp-IO.systemTimeMicroseconds.v1 - - unison-FOp-ImmutableArray.copyTo! - unison-FOp-ImmutableArray.read - - unison-FOp-MutableArray.copyTo! - unison-FOp-MutableArray.freeze! - unison-FOp-MutableArray.freeze - unison-FOp-MutableArray.read - unison-FOp-MutableArray.write - - unison-FOp-MutableArray.size - unison-FOp-ImmutableArray.size - - unison-FOp-MutableByteArray.size - unison-FOp-ImmutableByteArray.size - - unison-FOp-MutableByteArray.length - unison-FOp-ImmutableByteArray.length - - unison-FOp-ImmutableByteArray.copyTo! - unison-FOp-ImmutableByteArray.read8 - unison-FOp-ImmutableByteArray.read16be - unison-FOp-ImmutableByteArray.read24be - unison-FOp-ImmutableByteArray.read32be - unison-FOp-ImmutableByteArray.read40be - unison-FOp-ImmutableByteArray.read48be - unison-FOp-ImmutableByteArray.read56be - unison-FOp-ImmutableByteArray.read64be - - unison-FOp-MutableByteArray.copyTo! - unison-FOp-MutableByteArray.freeze! - unison-FOp-MutableByteArray.write8 - unison-FOp-MutableByteArray.write16be - unison-FOp-MutableByteArray.write32be - unison-FOp-MutableByteArray.write64be - unison-FOp-MutableByteArray.read8 - unison-FOp-MutableByteArray.read16be - unison-FOp-MutableByteArray.read24be - unison-FOp-MutableByteArray.read32be - unison-FOp-MutableByteArray.read40be - unison-FOp-MutableByteArray.read64be - - unison-FOp-Scope.bytearray - unison-FOp-Scope.bytearrayOf - unison-FOp-Scope.array - unison-FOp-Scope.arrayOf - unison-FOp-Scope.ref - - unison-FOp-IO.bytearray - unison-FOp-IO.bytearrayOf - unison-FOp-IO.array - unison-FOp-IO.arrayOf - - unison-FOp-IO.ref - unison-FOp-Ref.read - unison-FOp-Ref.write - unison-FOp-Ref.readForCas - unison-FOp-Ref.Ticket.read - unison-FOp-Ref.cas - - unison-FOp-Promise.new - unison-FOp-Promise.read - unison-FOp-Promise.tryRead - unison-FOp-Promise.write - - unison-FOp-IO.delay.impl.v3 - unison-POp-FORK - unison-FOp-IO.kill.impl.v3 - - unison-FOp-Handle.toText - unison-FOp-Socket.toText - unison-FOp-ThreadId.toText - - unison-POp-ABSF - unison-POp-ACOS - unison-POp-ACSH - unison-POp-ADDF - unison-POp-ASIN - unison-POp-ASNH - unison-POp-ATAN - unison-POp-ATN2 - unison-POp-ATNH - unison-POp-CEIL - unison-POp-FLOR - unison-POp-COSF - unison-POp-COSH - unison-POp-DIVF - unison-POp-DIVI - unison-POp-EQLF - unison-POp-EQLI - unison-POp-SUBF - unison-POp-SUBI - unison-POp-SGNI - unison-POp-LEQF - unison-POp-SINF - unison-POp-SINH - unison-POp-TRNF - unison-POp-RNDF - unison-POp-SQRT - unison-POp-TANH - unison-POp-TANF - unison-POp-TZRO - unison-POp-POPC - unison-POp-ITOF - - unison-POp-ADDN - unison-POp-ANDN - unison-POp-BLDS - unison-POp-CATS - unison-POp-CATT - unison-POp-CATB - unison-POp-CMPU - unison-POp-COMN - unison-POp-CONS - unison-POp-DBTX - unison-POp-DECI - unison-POp-INCI - unison-POp-DECN - unison-POp-INCN - unison-POp-DIVN - unison-POp-DRPB - unison-POp-DRPS - unison-POp-DRPT - unison-POp-EQLN - unison-POp-EQLT - unison-POp-EXPF - unison-POp-LEQT - unison-POp-EQLU - unison-POp-EROR - unison-POp-FTOT - unison-POp-IDXB - unison-POp-IDXS - unison-POp-IORN - unison-POp-ITOT - unison-POp-LEQN - ; unison-POp-LKUP - unison-POp-LZRO - unison-POp-MULN - unison-POp-MODN - unison-POp-NTOT - unison-POp-PAKT - unison-POp-SHLI - unison-POp-SHLN - unison-POp-SHRI - unison-POp-SHRN - unison-POp-SIZS - unison-POp-SIZT - unison-POp-SIZB - unison-POp-SNOC - unison-POp-SUBN - unison-POp-SUBI - unison-POp-TAKS - unison-POp-TAKT - unison-POp-TAKB - unison-POp-TRCE - unison-POp-PRNT - unison-POp-TTON - unison-POp-TTOI - unison-POp-TTOF - unison-POp-UPKT - unison-POp-XORN - unison-POp-VALU - unison-POp-VWLS - unison-POp-UCNS - unison-POp-USNC - unison-POp-FLTB - unison-POp-MAXF - unison-POp-MINF - unison-POp-MULF - unison-POp-MULI - unison-POp-NEGI - unison-POp-NTOF - unison-POp-POWF - unison-POp-POWI - unison-POp-POWN - - unison-POp-UPKB - unison-POp-PAKB - unison-POp-ADDI - unison-POp-MULI - unison-POp-MODI - unison-POp-LEQI - unison-POp-LOGB - unison-POp-LOGF - unison-POp-POWN - unison-POp-VWRS - unison-POp-SPLL - unison-POp-SPLR - - unison-FOp-Bytes.gzip.compress - unison-FOp-Bytes.gzip.decompress - unison-FOp-Bytes.zlib.compress - unison-FOp-Bytes.zlib.decompress - unison-FOp-Bytes.toBase16 - unison-FOp-Bytes.toBase32 - unison-FOp-Bytes.toBase64 - unison-FOp-Bytes.toBase64UrlUnpadded - unison-FOp-Bytes.fromBase16 - unison-FOp-Bytes.fromBase32 - unison-FOp-Bytes.fromBase64 - unison-FOp-Bytes.fromBase64UrlUnpadded - unison-FOp-Bytes.encodeNat16be - unison-FOp-Bytes.encodeNat16le - unison-FOp-Bytes.encodeNat32be - unison-FOp-Bytes.encodeNat32le - unison-FOp-Bytes.encodeNat64be - unison-FOp-Bytes.encodeNat64le - unison-FOp-Bytes.decodeNat16be - unison-FOp-Bytes.decodeNat16le - unison-FOp-Bytes.decodeNat32be - unison-FOp-Bytes.decodeNat32le - unison-FOp-Bytes.decodeNat64be - unison-FOp-Bytes.decodeNat64le - - unison-FOp-crypto.hashBytes - unison-FOp-crypto.hmacBytes - unison-FOp-crypto.HashAlgorithm.Md5 - unison-FOp-crypto.HashAlgorithm.Sha1 - unison-FOp-crypto.HashAlgorithm.Sha2_256 - unison-FOp-crypto.HashAlgorithm.Sha2_512 - unison-FOp-crypto.HashAlgorithm.Sha3_256 - unison-FOp-crypto.HashAlgorithm.Sha3_512 - unison-FOp-crypto.HashAlgorithm.Blake2s_256 - unison-FOp-crypto.HashAlgorithm.Blake2b_256 - unison-FOp-crypto.HashAlgorithm.Blake2b_512 - - unison-FOp-IO.clientSocket.impl.v3 - unison-FOp-IO.closeSocket.impl.v3 - unison-FOp-IO.socketReceive.impl.v3 - unison-FOp-IO.socketSend.impl.v3 - unison-FOp-IO.socketPort.impl.v3 - unison-FOp-IO.serverSocket.impl.v3 - unison-FOp-IO.socketAccept.impl.v3 - unison-FOp-IO.listen.impl.v3 - unison-FOp-Tls.ClientConfig.default - unison-FOp-Tls.ClientConfig.certificates.set - unison-FOp-Tls.decodeCert.impl.v3 - unison-FOp-Tls.encodeCert - unison-FOp-Tls.newServer.impl.v3 - unison-FOp-Tls.decodePrivateKey - unison-FOp-Tls.encodePrivateKey - unison-FOp-Tls.ServerConfig.default - unison-FOp-Tls.handshake.impl.v3 - unison-FOp-Tls.newClient.impl.v3 - unison-FOp-Tls.receive.impl.v3 - unison-FOp-Tls.send.impl.v3 - unison-FOp-Tls.terminate.impl.v3 - - ; fake builtins - builtin-murmurHashBytes) - - (import (rnrs) - (only (srfi :13) string-reverse) - (racket performance-hint) - (only (racket flonum) - fl< - fl> - fl<= - fl>= - fl=) - (rename - (only (racket) - car - cdr - exact-integer? - exact-nonnegative-integer? - foldl - integer-length - bytes->string/utf-8 - string->bytes/utf-8 - exn:fail:contract? - file-stream-buffer-mode - with-handlers - match - modulo - quotient - regexp-match-positions - sequence-ref - vector-copy! - bytes-copy! - sub1 - add1 - exn:break? - exn:fail? - exn:fail:read? - exn:fail:filesystem? - exn:fail:network? - exn:fail:contract:divide-by-zero? - exn:fail:contract:non-fixnum-result?) - (car icar) (cdr icdr)) - (only (racket string) - string-contains? - string-replace) - (unison arithmetic) - (unison bytevector) - (unison core) - (only (unison boot) - define-unison - referent->termlink - termlink->referent - typelink->reference - clamp-integer - clamp-natural - wrap-natural - exn:bug->exception - raise-unison-exception - bit64 - bit63 - nbit63) - (unison data) - (unison data-info) - (unison math) - (unison chunked-seq) - (unison chunked-bytes) - (unison string-search) - (unison bytes-nat) - (unison pattern) - (unison crypto) - (unison io) - (unison io-handles) - (unison murmurhash) - (unison tls) - (unison tcp) - (unison udp) - (unison gzip) - (unison zlib) - (unison concurrent) - (racket random)) - - (define-builtin-link Float.*) - (define-builtin-link Float.fromRepresentation) - (define-builtin-link Float.toRepresentation) - (define-builtin-link Float.ceiling) - (define-builtin-link Float.exp) - (define-builtin-link Float.log) - (define-builtin-link Float.max) - (define-builtin-link Float.min) - (define-builtin-link Float.tan) - (define-builtin-link Float.tanh) - (define-builtin-link Float.logBase) - (define-builtin-link Float.pow) - (define-builtin-link Float.>) - (define-builtin-link Float.<) - (define-builtin-link Float.>=) - (define-builtin-link Float.<=) - (define-builtin-link Float.==) - (define-builtin-link Int.pow) - (define-builtin-link Int.*) - (define-builtin-link Int.+) - (define-builtin-link Int.-) - (define-builtin-link Int./) - (define-builtin-link Int.>) - (define-builtin-link Int.<) - (define-builtin-link Int.>=) - (define-builtin-link Int.<=) - (define-builtin-link Int.==) - (define-builtin-link Int.isEven) - (define-builtin-link Int.isOdd) - (define-builtin-link Int.increment) - (define-builtin-link Int.negate) - (define-builtin-link Int.fromRepresentation) - (define-builtin-link Int.toRepresentation) - (define-builtin-link Int.signum) - (define-builtin-link Int.trailingZeros) - (define-builtin-link Int.popCount) - (define-builtin-link Nat.increment) - (define-builtin-link Nat.popCount) - (define-builtin-link Nat.toFloat) - (define-builtin-link Nat.trailingZeros) - (define-builtin-link Nat.+) - (define-builtin-link Nat.>) - (define-builtin-link Nat.<) - (define-builtin-link Nat.>=) - (define-builtin-link Nat.<=) - (define-builtin-link Nat.==) - (define-builtin-link Nat.drop) - (define-builtin-link Nat.isEven) - (define-builtin-link Nat.isOdd) - (define-builtin-link Text.indexOf) - (define-builtin-link Text.>) - (define-builtin-link Text.<) - (define-builtin-link Text.>=) - (define-builtin-link Text.<=) - (define-builtin-link Text.==) - (define-builtin-link Text.!=) - (define-builtin-link Bytes.indexOf) - (define-builtin-link IO.randomBytes) - (define-builtin-link IO.tryEval) - (define-builtin-link List.splitLeft) - (define-builtin-link List.splitRight) - (define-builtin-link Value.toBuiltin) - (define-builtin-link Value.fromBuiltin) - (define-builtin-link Code.fromGroup) - (define-builtin-link Code.toGroup) - (define-builtin-link TermLink.fromReferent) - (define-builtin-link TermLink.toReferent) - (define-builtin-link TypeLink.toReference) - (define-builtin-link IO.seekHandle.impl.v3) - (define-builtin-link IO.getLine.impl.v1) - (define-builtin-link IO.getSomeBytes.impl.v1) - (define-builtin-link IO.setBuffering.impl.v3) - (define-builtin-link IO.getBuffering.impl.v3) - (define-builtin-link IO.setEcho.impl.v1) - (define-builtin-link IO.isFileOpen.impl.v3) - (define-builtin-link IO.ready.impl.v1) - (define-builtin-link IO.process.call) - (define-builtin-link IO.getEcho.impl.v1) - (define-builtin-link IO.getArgs.impl.v1) - (define-builtin-link IO.getEnv.impl.v1) - (define-builtin-link IO.getChar.impl.v1) - (define-builtin-link IO.getCurrentDirectory.impl.v3) - (define-builtin-link IO.directoryContents.impl.v3) - (define-builtin-link IO.removeDirectory.impl.v3) - (define-builtin-link IO.renameFile.impl.v3) - (define-builtin-link IO.createTempDirectory.impl.v3) - (define-builtin-link IO.createDirectory.impl.v3) - (define-builtin-link IO.setCurrentDirectory.impl.v3) - (define-builtin-link IO.renameDirectory.impl.v3) - (define-builtin-link IO.fileExists.impl.v3) - (define-builtin-link IO.isDirectory.impl.v3) - (define-builtin-link IO.isFileEOF.impl.v3) - (define-builtin-link IO.isSeekable.impl.v3) - (define-builtin-link IO.handlePosition.impl.v3) - (define-builtin-link IO.systemTime.impl.v3) - (define-builtin-link IO.systemTimeMicroseconds.impl.v3) - (define-builtin-link Universal.==) - (define-builtin-link Universal.>) - (define-builtin-link Universal.<) - (define-builtin-link Universal.>=) - (define-builtin-link Universal.<=) - (define-builtin-link Universal.compare) - (define-builtin-link Universal.murmurHash) - (define-builtin-link Pattern.captureAs) - (define-builtin-link Pattern.many.corrected) - (define-builtin-link Pattern.isMatch) - (define-builtin-link Char.Class.is) - (define-builtin-link Scope.bytearrayOf) - (define-builtin-link unsafe.coerceAbilities) - (define-builtin-link Clock.internals.systemTimeZone.v1) - +#lang racket/base +(provide + builtin-Float.* + builtin-Float.*:termlink + builtin-Float.>= + builtin-Float.>=:termlink + builtin-Float.<= + builtin-Float.<=:termlink + builtin-Float.> + builtin-Float.>:termlink + builtin-Float.< + builtin-Float.<:termlink + builtin-Float.== + builtin-Float.==:termlink + builtin-Float.fromRepresentation + builtin-Float.fromRepresentation:termlink + builtin-Float.toRepresentation + builtin-Float.toRepresentation:termlink + builtin-Float.ceiling + builtin-Float.ceiling:termlink + builtin-Float.exp + builtin-Float.exp:termlink + builtin-Float.log + builtin-Float.log:termlink + builtin-Float.max + builtin-Float.max:termlink + builtin-Float.min + builtin-Float.min:termlink + builtin-Float.tan + builtin-Float.tan:termlink + builtin-Float.tanh + builtin-Float.tanh:termlink + builtin-Float.logBase + builtin-Float.logBase:termlink + builtin-Float.pow + builtin-Float.pow:termlink + builtin-Int.pow + builtin-Int.pow:termlink + builtin-Int.* + builtin-Int.*:termlink + builtin-Int.+ + builtin-Int.+:termlink + builtin-Int.- + builtin-Int.-:termlink + builtin-Int./ + builtin-Int./:termlink + builtin-Int.increment + builtin-Int.increment:termlink + builtin-Int.negate + builtin-Int.negate:termlink + builtin-Int.fromRepresentation + builtin-Int.fromRepresentation:termlink + builtin-Int.toRepresentation + builtin-Int.toRepresentation:termlink + builtin-Int.signum + builtin-Int.signum:termlink + builtin-Int.trailingZeros + builtin-Int.trailingZeros:termlink + builtin-Int.popCount + builtin-Int.popCount:termlink + builtin-Int.isEven + builtin-Int.isEven:termlink + builtin-Int.isOdd + builtin-Int.isOdd:termlink + builtin-Int.== + builtin-Int.==:termlink + builtin-Int.< + builtin-Int.<:termlink + builtin-Int.<= + builtin-Int.<=:termlink + builtin-Int.> + builtin-Int.>:termlink + builtin-Int.>= + builtin-Int.>=:termlink + builtin-Nat.+ + builtin-Nat.+:termlink + builtin-Nat.drop + builtin-Nat.drop:termlink + builtin-Nat.== + builtin-Nat.==:termlink + builtin-Nat.< + builtin-Nat.<:termlink + builtin-Nat.<= + builtin-Nat.<=:termlink + builtin-Nat.> + builtin-Nat.>:termlink + builtin-Nat.>= + builtin-Nat.>=:termlink + builtin-Nat.isEven + builtin-Nat.isEven:termlink + builtin-Nat.isOdd + builtin-Nat.isOdd:termlink + builtin-Nat.increment + builtin-Nat.increment:termlink + builtin-Nat.popCount + builtin-Nat.popCount:termlink + builtin-Nat.toFloat + builtin-Nat.toFloat:termlink + builtin-Nat.trailingZeros + builtin-Nat.trailingZeros:termlink + builtin-Text.indexOf + builtin-Text.indexOf:termlink + builtin-Text.== + builtin-Text.==:termlink + builtin-Text.!= + builtin-Text.!=:termlink + builtin-Text.<= + builtin-Text.<=:termlink + builtin-Text.>= + builtin-Text.>=:termlink + builtin-Text.< + builtin-Text.<:termlink + builtin-Text.> + builtin-Text.>:termlink + builtin-Bytes.indexOf + builtin-Bytes.indexOf:termlink + builtin-IO.randomBytes + builtin-IO.randomBytes:termlink + builtin-IO.tryEval + builtin-IO.tryEval:termlink + + builtin-Scope.bytearrayOf + builtin-Scope.bytearrayOf:termlink + + builtin-Universal.== + builtin-Universal.==:termlink + builtin-Universal.> + builtin-Universal.>:termlink + builtin-Universal.>= + builtin-Universal.>=:termlink + builtin-Universal.< + builtin-Universal.<:termlink + builtin-Universal.<= + builtin-Universal.<=:termlink + builtin-Universal.compare + builtin-Universal.compare:termlink + builtin-Universal.murmurHash:termlink + + builtin-unsafe.coerceAbilities + builtin-unsafe.coerceAbilities:termlink + + builtin-List.splitLeft + builtin-List.splitLeft:termlink + builtin-List.splitRight + builtin-List.splitRight:termlink + + builtin-Link.Term.toText + builtin-Link.Term.toText:termlink + + builtin-Value.toBuiltin + builtin-Value.toBuiltin:termlink + builtin-Value.fromBuiltin + builtin-Value.fromBuiltin:termlink + builtin-Code.fromGroup + builtin-Code.fromGroup:termlink + builtin-Code.toGroup + builtin-Code.toGroup:termlink + builtin-TermLink.fromReferent + builtin-TermLink.fromReferent:termlink + builtin-TermLink.toReferent + builtin-TermLink.toReferent:termlink + builtin-TypeLink.toReference + builtin-TypeLink.toReference:termlink + + builtin-IO.UDP.clientSocket.impl.v1 + builtin-IO.UDP.clientSocket.impl.v1:termlink + builtin-IO.UDP.UDPSocket.recv.impl.v1 + builtin-IO.UDP.UDPSocket.recv.impl.v1:termlink + builtin-IO.UDP.UDPSocket.send.impl.v1 + builtin-IO.UDP.UDPSocket.send.impl.v1:termlink + builtin-IO.UDP.UDPSocket.close.impl.v1 + builtin-IO.UDP.UDPSocket.close.impl.v1:termlink + builtin-IO.UDP.ListenSocket.close.impl.v1 + builtin-IO.UDP.ListenSocket.close.impl.v1:termlink + builtin-IO.UDP.UDPSocket.toText.impl.v1 + builtin-IO.UDP.UDPSocket.toText.impl.v1:termlink + builtin-IO.UDP.serverSocket.impl.v1 + builtin-IO.UDP.serverSocket.impl.v1:termlink + builtin-IO.UDP.ListenSocket.toText.impl.v1 + builtin-IO.UDP.ListenSocket.toText.impl.v1:termlink + builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 + builtin-IO.UDP.ListenSocket.recvFrom.impl.v1:termlink + builtin-IO.UDP.ClientSockAddr.toText.v1 + builtin-IO.UDP.ClientSockAddr.toText.v1:termlink + builtin-IO.UDP.ListenSocket.sendTo.impl.v1 + builtin-IO.UDP.ListenSocket.sendTo.impl.v1:termlink + + unison-FOp-internal.dataTag + unison-FOp-Char.toText + ; unison-FOp-Code.dependencies + ; unison-FOp-Code.serialize + unison-FOp-IO.closeFile.impl.v3 + unison-FOp-IO.openFile.impl.v3 + ; unison-FOp-IO.isFileEOF.impl.v3 + unison-FOp-IO.putBytes.impl.v3 + unison-FOp-IO.getBytes.impl.v3 + builtin-IO.seekHandle.impl.v3 + builtin-IO.seekHandle.impl.v3:termlink + builtin-IO.getLine.impl.v1 + builtin-IO.getLine.impl.v1:termlink + builtin-IO.getSomeBytes.impl.v1 + builtin-IO.getSomeBytes.impl.v1:termlink + builtin-IO.setBuffering.impl.v3 + builtin-IO.setBuffering.impl.v3:termlink + builtin-IO.getBuffering.impl.v3 + builtin-IO.getBuffering.impl.v3:termlink + builtin-IO.setEcho.impl.v1 + builtin-IO.setEcho.impl.v1:termlink + builtin-IO.isFileOpen.impl.v3 + builtin-IO.isFileOpen.impl.v3:termlink + builtin-IO.ready.impl.v1 + builtin-IO.ready.impl.v1:termlink + builtin-IO.process.call + builtin-IO.process.call:termlink + builtin-IO.getEcho.impl.v1 + builtin-IO.getEcho.impl.v1:termlink + builtin-IO.getArgs.impl.v1 + builtin-IO.getArgs.impl.v1:termlink + builtin-IO.getEnv.impl.v1 + builtin-IO.getEnv.impl.v1:termlink + builtin-IO.getChar.impl.v1 + builtin-IO.getChar.impl.v1:termlink + builtin-IO.getCurrentDirectory.impl.v3 + builtin-IO.getCurrentDirectory.impl.v3:termlink + builtin-IO.removeDirectory.impl.v3 + builtin-IO.removeDirectory.impl.v3:termlink + builtin-IO.renameFile.impl.v3 + builtin-IO.renameFile.impl.v3:termlink + builtin-IO.createTempDirectory.impl.v3 + builtin-IO.createTempDirectory.impl.v3:termlink + builtin-IO.createDirectory.impl.v3 + builtin-IO.createDirectory.impl.v3:termlink + builtin-IO.setCurrentDirectory.impl.v3 + builtin-IO.setCurrentDirectory.impl.v3:termlink + builtin-IO.renameDirectory.impl.v3 + builtin-IO.renameDirectory.impl.v3:termlink + builtin-IO.isDirectory.impl.v3 + builtin-IO.isDirectory.impl.v3:termlink + builtin-IO.isSeekable.impl.v3 + builtin-IO.isSeekable.impl.v3:termlink + builtin-IO.handlePosition.impl.v3 + builtin-IO.handlePosition.impl.v3:termlink + builtin-IO.systemTime.impl.v3 + builtin-IO.systemTime.impl.v3:termlink + builtin-IO.systemTimeMicroseconds.impl.v3 + builtin-IO.systemTimeMicroseconds.impl.v3:termlink + + builtin-Char.Class.is + builtin-Char.Class.is:termlink + builtin-Pattern.captureAs + builtin-Pattern.captureAs:termlink + builtin-Pattern.many.corrected + builtin-Pattern.many.corrected:termlink + builtin-Pattern.isMatch + builtin-Pattern.isMatch:termlink + builtin-IO.fileExists.impl.v3 + builtin-IO.fileExists.impl.v3:termlink + builtin-IO.isFileEOF.impl.v3 + builtin-IO.isFileEOF.impl.v3:termlink + + unison-FOp-IO.getFileSize.impl.v3 + unison-FOp-IO.getFileTimestamp.impl.v3 + ; unison-FOp-IO.fileExists.impl.v3 + unison-FOp-IO.removeFile.impl.v3 + unison-FOp-IO.getTempDirectory.impl.v3 + unison-FOp-Text.fromUtf8.impl.v3 + unison-FOp-Text.repeat + unison-FOp-Text.reverse + unison-FOp-Text.toUtf8 + unison-FOp-Text.toLowercase + unison-FOp-Text.toUppercase + unison-FOp-Pattern.run + unison-FOp-Pattern.isMatch + unison-FOp-Pattern.many + unison-FOp-Pattern.capture + unison-FOp-Pattern.join + unison-FOp-Pattern.or + unison-FOp-Pattern.replicate + unison-FOp-Text.patterns.digit + unison-FOp-Text.patterns.letter + unison-FOp-Text.patterns.punctuation + unison-FOp-Text.patterns.charIn + unison-FOp-Text.patterns.notCharIn + unison-FOp-Text.patterns.anyChar + unison-FOp-Text.patterns.space + unison-FOp-Text.patterns.charRange + unison-FOp-Text.patterns.notCharRange + unison-FOp-Text.patterns.literal + unison-FOp-Text.patterns.eof + unison-FOp-Text.patterns.char + unison-FOp-Char.Class.is + unison-FOp-Char.Class.any + unison-FOp-Char.Class.alphanumeric + unison-FOp-Char.Class.upper + unison-FOp-Char.Class.lower + unison-FOp-Char.Class.number + unison-FOp-Char.Class.punctuation + unison-FOp-Char.Class.symbol + unison-FOp-Char.Class.letter + unison-FOp-Char.Class.whitespace + unison-FOp-Char.Class.control + unison-FOp-Char.Class.printable + unison-FOp-Char.Class.mark + unison-FOp-Char.Class.separator + unison-FOp-Char.Class.or + unison-FOp-Char.Class.range + unison-FOp-Char.Class.anyOf + unison-FOp-Char.Class.and + unison-FOp-Char.Class.not + unison-FOp-Clock.internals.nsec.v1 + unison-FOp-Clock.internals.sec.v1 + unison-FOp-Clock.internals.threadCPUTime.v1 + unison-FOp-Clock.internals.processCPUTime.v1 + unison-FOp-Clock.internals.realtime.v1 + unison-FOp-Clock.internals.monotonic.v1 + builtin-Clock.internals.systemTimeZone.v1 + builtin-Clock.internals.systemTimeZone.v1:termlink + + + ; unison-FOp-Value.serialize + unison-FOp-IO.stdHandle + unison-FOp-IO.getArgs.impl.v1 + + builtin-IO.directoryContents.impl.v3 + builtin-IO.directoryContents.impl.v3:termlink + unison-FOp-IO.systemTimeMicroseconds.v1 + + unison-FOp-ImmutableArray.copyTo! + unison-FOp-ImmutableArray.read + + unison-FOp-MutableArray.copyTo! + unison-FOp-MutableArray.freeze! + unison-FOp-MutableArray.freeze + unison-FOp-MutableArray.read + unison-FOp-MutableArray.write + + unison-FOp-MutableArray.size + unison-FOp-ImmutableArray.size + + unison-FOp-MutableByteArray.size + unison-FOp-ImmutableByteArray.size + + unison-FOp-MutableByteArray.length + unison-FOp-ImmutableByteArray.length + + unison-FOp-ImmutableByteArray.copyTo! + unison-FOp-ImmutableByteArray.read8 + unison-FOp-ImmutableByteArray.read16be + unison-FOp-ImmutableByteArray.read24be + unison-FOp-ImmutableByteArray.read32be + unison-FOp-ImmutableByteArray.read40be + unison-FOp-ImmutableByteArray.read48be + unison-FOp-ImmutableByteArray.read56be + unison-FOp-ImmutableByteArray.read64be + + unison-FOp-MutableByteArray.copyTo! + unison-FOp-MutableByteArray.freeze! + unison-FOp-MutableByteArray.write8 + unison-FOp-MutableByteArray.write16be + unison-FOp-MutableByteArray.write32be + unison-FOp-MutableByteArray.write64be + unison-FOp-MutableByteArray.read8 + unison-FOp-MutableByteArray.read16be + unison-FOp-MutableByteArray.read24be + unison-FOp-MutableByteArray.read32be + unison-FOp-MutableByteArray.read40be + unison-FOp-MutableByteArray.read64be + + unison-FOp-Scope.bytearray + unison-FOp-Scope.bytearrayOf + unison-FOp-Scope.array + unison-FOp-Scope.arrayOf + unison-FOp-Scope.ref + + unison-FOp-IO.bytearray + unison-FOp-IO.bytearrayOf + unison-FOp-IO.array + unison-FOp-IO.arrayOf + + unison-FOp-IO.ref + unison-FOp-Ref.read + unison-FOp-Ref.write + unison-FOp-Ref.readForCas + unison-FOp-Ref.Ticket.read + unison-FOp-Ref.cas + + unison-FOp-Promise.new + unison-FOp-Promise.read + unison-FOp-Promise.tryRead + unison-FOp-Promise.write + + unison-FOp-IO.delay.impl.v3 + unison-POp-FORK + unison-FOp-IO.kill.impl.v3 + + unison-FOp-Handle.toText + unison-FOp-Socket.toText + unison-FOp-ThreadId.toText + + unison-POp-ABSF + unison-POp-ACOS + unison-POp-ACSH + unison-POp-ADDF + unison-POp-ASIN + unison-POp-ASNH + unison-POp-ATAN + unison-POp-ATN2 + unison-POp-ATNH + unison-POp-CEIL + unison-POp-FLOR + unison-POp-COSF + unison-POp-COSH + unison-POp-DIVF + unison-POp-DIVI + unison-POp-EQLF + unison-POp-EQLI + unison-POp-SUBF + unison-POp-SUBI + unison-POp-SGNI + unison-POp-LEQF + unison-POp-SINF + unison-POp-SINH + unison-POp-TRNF + unison-POp-RNDF + unison-POp-SQRT + unison-POp-TANH + unison-POp-TANF + unison-POp-TZRO + unison-POp-POPC + unison-POp-ITOF + + unison-POp-ADDN + unison-POp-ANDN + unison-POp-BLDS + unison-POp-CATS + unison-POp-CATT + unison-POp-CATB + unison-POp-CMPU + unison-POp-COMN + unison-POp-CONS + unison-POp-DBTX + unison-POp-DECI + unison-POp-INCI + unison-POp-DECN + unison-POp-INCN + unison-POp-DIVN + unison-POp-DRPB + unison-POp-DRPS + unison-POp-DRPT + unison-POp-EQLN + unison-POp-EQLT + unison-POp-EXPF + unison-POp-LEQT + unison-POp-EQLU + unison-POp-EROR + unison-POp-FTOT + unison-POp-IDXB + unison-POp-IDXS + unison-POp-IORN + unison-POp-ITOT + unison-POp-LEQN + ; unison-POp-LKUP + unison-POp-LZRO + unison-POp-MULN + unison-POp-MODN + unison-POp-NTOT + unison-POp-PAKT + unison-POp-SHLI + unison-POp-SHLN + unison-POp-SHRI + unison-POp-SHRN + unison-POp-SIZS + unison-POp-SIZT + unison-POp-SIZB + unison-POp-SNOC + unison-POp-SUBN + unison-POp-SUBI + unison-POp-TAKS + unison-POp-TAKT + unison-POp-TAKB + unison-POp-TRCE + unison-POp-PRNT + unison-POp-TTON + unison-POp-TTOI + unison-POp-TTOF + unison-POp-UPKT + unison-POp-XORN + unison-POp-VALU + unison-POp-VWLS + unison-POp-UCNS + unison-POp-USNC + unison-POp-FLTB + unison-POp-MAXF + unison-POp-MINF + unison-POp-MULF + unison-POp-MULI + unison-POp-NEGI + unison-POp-NTOF + unison-POp-POWF + unison-POp-POWI + unison-POp-POWN + + unison-POp-UPKB + unison-POp-PAKB + unison-POp-ADDI + unison-POp-MULI + unison-POp-MODI + unison-POp-LEQI + unison-POp-LOGB + unison-POp-LOGF + unison-POp-POWN + unison-POp-VWRS + unison-POp-SPLL + unison-POp-SPLR + + unison-FOp-Bytes.gzip.compress + unison-FOp-Bytes.gzip.decompress + unison-FOp-Bytes.zlib.compress + unison-FOp-Bytes.zlib.decompress + unison-FOp-Bytes.toBase16 + unison-FOp-Bytes.toBase32 + unison-FOp-Bytes.toBase64 + unison-FOp-Bytes.toBase64UrlUnpadded + unison-FOp-Bytes.fromBase16 + unison-FOp-Bytes.fromBase32 + unison-FOp-Bytes.fromBase64 + unison-FOp-Bytes.fromBase64UrlUnpadded + unison-FOp-Bytes.encodeNat16be + unison-FOp-Bytes.encodeNat16le + unison-FOp-Bytes.encodeNat32be + unison-FOp-Bytes.encodeNat32le + unison-FOp-Bytes.encodeNat64be + unison-FOp-Bytes.encodeNat64le + unison-FOp-Bytes.decodeNat16be + unison-FOp-Bytes.decodeNat16le + unison-FOp-Bytes.decodeNat32be + unison-FOp-Bytes.decodeNat32le + unison-FOp-Bytes.decodeNat64be + unison-FOp-Bytes.decodeNat64le + + unison-FOp-crypto.hashBytes + unison-FOp-crypto.hmacBytes + unison-FOp-crypto.HashAlgorithm.Md5 + unison-FOp-crypto.HashAlgorithm.Sha1 + unison-FOp-crypto.HashAlgorithm.Sha2_256 + unison-FOp-crypto.HashAlgorithm.Sha2_512 + unison-FOp-crypto.HashAlgorithm.Sha3_256 + unison-FOp-crypto.HashAlgorithm.Sha3_512 + unison-FOp-crypto.HashAlgorithm.Blake2s_256 + unison-FOp-crypto.HashAlgorithm.Blake2b_256 + unison-FOp-crypto.HashAlgorithm.Blake2b_512 + + unison-FOp-IO.clientSocket.impl.v3 + unison-FOp-IO.closeSocket.impl.v3 + unison-FOp-IO.socketReceive.impl.v3 + unison-FOp-IO.socketSend.impl.v3 + unison-FOp-IO.socketPort.impl.v3 + unison-FOp-IO.serverSocket.impl.v3 + unison-FOp-IO.socketAccept.impl.v3 + unison-FOp-IO.listen.impl.v3 + unison-FOp-Tls.ClientConfig.default + unison-FOp-Tls.ClientConfig.certificates.set + unison-FOp-Tls.decodeCert.impl.v3 + unison-FOp-Tls.encodeCert + unison-FOp-Tls.newServer.impl.v3 + unison-FOp-Tls.decodePrivateKey + unison-FOp-Tls.encodePrivateKey + unison-FOp-Tls.ServerConfig.default + unison-FOp-Tls.handshake.impl.v3 + unison-FOp-Tls.newClient.impl.v3 + unison-FOp-Tls.receive.impl.v3 + unison-FOp-Tls.send.impl.v3 + unison-FOp-Tls.terminate.impl.v3 + + ; fake builtins + builtin-murmurHashBytes) + +(require + (except-in racket + eof + sleep) + + (only-in srfi/13 string-reverse) + rnrs/bytevectors-6 + + racket/performance-hint + + (only-in racket/flonum + fl< + fl> + fl<= + fl>= + fl=) + + (only-in racket/string + string-contains? + string-replace) + + unison/arithmetic + unison/bytevector + unison/core + + (only-in unison/boot + define-unison-builtin + referent->termlink + termlink->referent + typelink->reference + clamp-integer + clamp-natural + wrap-natural + exn:bug->exception + raise-unison-exception + bit64 + bit63 + nbit63) + + unison/data + unison/data-info + unison/math + unison/chunked-seq + unison/chunked-bytes + unison/string-search + unison/bytes-nat + unison/pattern + unison/crypto + unison/io + unison/io-handles + unison/murmurhash + unison/tls + unison/tcp + unison/udp + unison/gzip + unison/zlib + unison/concurrent + racket/random) + +; (define-builtin-link Float.*) +; (define-builtin-link Float.fromRepresentation) +; (define-builtin-link Float.toRepresentation) +; (define-builtin-link Float.ceiling) +; (define-builtin-link Float.exp) +; (define-builtin-link Float.log) +; (define-builtin-link Float.max) +; (define-builtin-link Float.min) +; (define-builtin-link Float.tan) +; (define-builtin-link Float.tanh) +; (define-builtin-link Float.logBase) +; (define-builtin-link Float.pow) +; (define-builtin-link Float.>) +; (define-builtin-link Float.<) +; (define-builtin-link Float.>=) +; (define-builtin-link Float.<=) +; (define-builtin-link Float.==) +; (define-builtin-link Int.pow) +; (define-builtin-link Int.*) +; (define-builtin-link Int.+) +; (define-builtin-link Int.-) +; (define-builtin-link Int./) +; (define-builtin-link Int.>) +; (define-builtin-link Int.<) +; (define-builtin-link Int.>=) +; (define-builtin-link Int.<=) +; (define-builtin-link Int.==) +; (define-builtin-link Int.isEven) +; (define-builtin-link Int.isOdd) +; (define-builtin-link Int.increment) +; (define-builtin-link Int.negate) +; (define-builtin-link Int.fromRepresentation) +; (define-builtin-link Int.toRepresentation) +; (define-builtin-link Int.signum) +; (define-builtin-link Int.trailingZeros) +; (define-builtin-link Int.popCount) +; (define-builtin-link Nat.increment) +; (define-builtin-link Nat.popCount) +; (define-builtin-link Nat.toFloat) +; (define-builtin-link Nat.trailingZeros) +; (define-builtin-link Nat.+) +; (define-builtin-link Nat.>) +; (define-builtin-link Nat.<) +; (define-builtin-link Nat.>=) +; (define-builtin-link Nat.<=) +; (define-builtin-link Nat.==) +; (define-builtin-link Nat.drop) +; (define-builtin-link Nat.isEven) +; (define-builtin-link Nat.isOdd) +; (define-builtin-link Text.indexOf) +; (define-builtin-link Text.>) +; (define-builtin-link Text.<) +; (define-builtin-link Text.>=) +; (define-builtin-link Text.<=) +; (define-builtin-link Text.==) +; (define-builtin-link Text.!=) +; (define-builtin-link Bytes.indexOf) +; (define-builtin-link IO.randomBytes) +; (define-builtin-link IO.tryEval) +; (define-builtin-link List.splitLeft) +; (define-builtin-link List.splitRight) +; (define-builtin-link Value.toBuiltin) +; (define-builtin-link Value.fromBuiltin) +; (define-builtin-link Code.fromGroup) +; (define-builtin-link Code.toGroup) +; (define-builtin-link TermLink.fromReferent) +; (define-builtin-link TermLink.toReferent) +; (define-builtin-link TypeLink.toReference) +; (define-builtin-link IO.seekHandle.impl.v3) +; (define-builtin-link IO.getLine.impl.v1) +; (define-builtin-link IO.getSomeBytes.impl.v1) +; (define-builtin-link IO.setBuffering.impl.v3) +; (define-builtin-link IO.getBuffering.impl.v3) +; (define-builtin-link IO.setEcho.impl.v1) +; (define-builtin-link IO.isFileOpen.impl.v3) +; (define-builtin-link IO.ready.impl.v1) +; (define-builtin-link IO.process.call) +; (define-builtin-link IO.getEcho.impl.v1) +; (define-builtin-link IO.getArgs.impl.v1) +; (define-builtin-link IO.getEnv.impl.v1) +; (define-builtin-link IO.getChar.impl.v1) +; (define-builtin-link IO.getCurrentDirectory.impl.v3) +; (define-builtin-link IO.directoryContents.impl.v3) +; (define-builtin-link IO.removeDirectory.impl.v3) +; (define-builtin-link IO.renameFile.impl.v3) +; (define-builtin-link IO.createTempDirectory.impl.v3) +; (define-builtin-link IO.createDirectory.impl.v3) +; (define-builtin-link IO.setCurrentDirectory.impl.v3) +; (define-builtin-link IO.renameDirectory.impl.v3) +; (define-builtin-link IO.fileExists.impl.v3) +; (define-builtin-link IO.isDirectory.impl.v3) +; (define-builtin-link IO.isFileEOF.impl.v3) +; (define-builtin-link IO.isSeekable.impl.v3) +; (define-builtin-link IO.handlePosition.impl.v3) +; (define-builtin-link IO.systemTime.impl.v3) +; (define-builtin-link IO.systemTimeMicroseconds.impl.v3) +; (define-builtin-link Universal.==) +; (define-builtin-link Universal.>) +; (define-builtin-link Universal.<) +; (define-builtin-link Universal.>=) +; (define-builtin-link Universal.<=) +; (define-builtin-link Universal.compare) +(define-builtin-link Universal.murmurHash) +; (define-builtin-link Pattern.captureAs) +; (define-builtin-link Pattern.many.corrected) +; (define-builtin-link Pattern.isMatch) +; (define-builtin-link Char.Class.is) +; (define-builtin-link Scope.bytearrayOf) +; (define-builtin-link unsafe.coerceAbilities) +(define-builtin-link Clock.internals.systemTimeZone.v1) + +(begin-encourage-inline + (define-unison-builtin (builtin-Value.toBuiltin v) (unison-quote v)) + (define-unison-builtin (builtin-Value.fromBuiltin v) + (unison-quote-val v)) + (define-unison-builtin (builtin-Code.fromGroup sg) (unison-code sg)) + (define-unison-builtin (builtin-Code.toGroup co) + (unison-code-rep co)) + (define-unison-builtin (builtin-TermLink.fromReferent rf) + (referent->termlink rf)) + (define-unison-builtin (builtin-TermLink.toReferent tl) + (termlink->referent tl)) + (define-unison-builtin (builtin-TypeLink.toReference tl) + (typelink->reference tl)) + (define-unison-builtin (builtin-murmurHashBytes bs) + (murmurhash-bytes (chunked-bytes->bytes bs))) + + (define-unison-builtin (builtin-IO.randomBytes n) + (bytes->chunked-bytes (crypto-random-bytes n))) + + (define-unison-builtin (builtin-List.splitLeft n s) + (match (unison-POp-SPLL n s) + [(unison-sum 0 fs) ref-seqview-empty] + [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) + + (define-unison-builtin (builtin-List.splitRight n s) + (match (unison-POp-SPLR n s) + [(unison-sum 0 fs) ref-seqview-empty] + [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) + + (define-unison-builtin (builtin-Float.> x y) (fl> x y)) + (define-unison-builtin (builtin-Float.< x y) (fl< x y)) + (define-unison-builtin (builtin-Float.>= x y) (fl>= x y)) + (define-unison-builtin (builtin-Float.<= x y) (fl<= x y)) + (define-unison-builtin (builtin-Float.== x y) (fl= x y)) + + (define-unison-builtin (builtin-Int.> x y) (> x y)) + (define-unison-builtin (builtin-Int.< x y) (< x y)) + (define-unison-builtin (builtin-Int.>= x y) (>= x y)) + (define-unison-builtin (builtin-Int.<= x y) (<= x y)) + (define-unison-builtin (builtin-Int.== x y) (= x y)) + (define-unison-builtin (builtin-Int.isEven x) (even? x)) + (define-unison-builtin (builtin-Int.isOdd x) (odd? x)) + + (define-unison-builtin (builtin-Nat.> x y) (> x y)) + (define-unison-builtin (builtin-Nat.< x y) (< x y)) + (define-unison-builtin (builtin-Nat.>= x y) (>= x y)) + (define-unison-builtin (builtin-Nat.<= x y) (<= x y)) (begin-encourage-inline - (define-unison (builtin-Value.toBuiltin v) (unison-quote v)) - (define-unison (builtin-Value.fromBuiltin v) - (unison-quote-val v)) - (define-unison (builtin-Code.fromGroup sg) (unison-code sg)) - (define-unison (builtin-Code.toGroup co) - (unison-code-rep co)) - (define-unison (builtin-TermLink.fromReferent rf) - (referent->termlink rf)) - (define-unison (builtin-TermLink.toReferent tl) - (termlink->referent tl)) - (define-unison (builtin-TypeLink.toReference tl) - (typelink->reference tl)) - (define-unison (builtin-murmurHashBytes bs) - (murmurhash-bytes (chunked-bytes->bytes bs))) - - (define-unison (builtin-IO.randomBytes n) - (bytes->chunked-bytes (crypto-random-bytes n))) - - (define-unison (builtin-List.splitLeft n s) - (match (unison-POp-SPLL n s) - [(unison-sum 0 fs) ref-seqview-empty] - [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) - - (define-unison (builtin-List.splitRight n s) - (match (unison-POp-SPLR n s) - [(unison-sum 0 fs) ref-seqview-empty] - [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) - - (define-unison (builtin-Float.> x y) (fl> x y)) - (define-unison (builtin-Float.< x y) (fl< x y)) - (define-unison (builtin-Float.>= x y) (fl>= x y)) - (define-unison (builtin-Float.<= x y) (fl<= x y)) - (define-unison (builtin-Float.== x y) (fl= x y)) - - (define-unison (builtin-Int.> x y) (> x y)) - (define-unison (builtin-Int.< x y) (< x y)) - (define-unison (builtin-Int.>= x y) (>= x y)) - (define-unison (builtin-Int.<= x y) (<= x y)) - (define-unison (builtin-Int.== x y) (= x y)) - (define-unison (builtin-Int.isEven x) (even? x)) - (define-unison (builtin-Int.isOdd x) (odd? x)) - - (define-unison (builtin-Nat.> x y) (> x y)) - (define-unison (builtin-Nat.< x y) (< x y)) - (define-unison (builtin-Nat.>= x y) (>= x y)) - (define-unison (builtin-Nat.<= x y) (<= x y)) - (begin-encourage-inline - (define-unison (builtin-Nat.== x y) (= x y))) - - (define-unison (builtin-Nat.isEven x) (even? x)) - (define-unison (builtin-Nat.isOdd x) (odd? x)) - - ; Note: chunked-string x y) - (not (chunked-string= x y) (chunked-string x y) - (case (universal-compare x y) [(>) #t] [else #f])) - (define-unison (builtin-Universal.< x y) - (case (universal-compare x y) [(<) #t] [else #f])) - (define-unison (builtin-Universal.<= x y) - (case (universal-compare x y) [(>) #f] [else #t])) - (define-unison (builtin-Universal.>= x y) - (case (universal-compare x y) [(<) #f] [else #t])) - (define-unison (builtin-Universal.compare x y) - (case (universal-compare x y) - [(>) 1] [(<) -1] [else 0])) - - (define-unison (builtin-Scope.bytearrayOf i n) - (make-bytevector n i)) - - (define-builtin-link Link.Type.toText) - (define-unison (builtin-Link.Type.toText ln) - (string->chunked-string (typelink->string ln))) - - (define-builtin-link Link.Term.toText) - (define-unison (builtin-Link.Term.toText ln) - (string->chunked-string (termlink->string ln))) - - (define-unison (builtin-Char.Class.is cc c) - (pattern-match? cc (string->chunked-string (string c)))) - - (define-unison (builtin-Pattern.captureAs c p) - (capture-as c p)) - - (define-unison (builtin-Pattern.many.corrected p) (many p)) - - (define-unison (builtin-Pattern.isMatch p s) - (pattern-match? p s)) - - (define-unison (builtin-unsafe.coerceAbilities f) f) - - (define (unison-POp-UPKB bs) - (build-chunked-list - (chunked-bytes-length bs) - (lambda (i) (chunked-bytes-ref bs i)))) - - (define (unison-POp-ADDI i j) (clamp-integer (+ i j))) - (define (unison-POp-MULI i j) (clamp-integer (* i j))) - (define (unison-POp-MODI i j) (clamp-integer (modulo i j))) - (define (unison-POp-LEQI a b) (bool (<= a b))) - (define (unison-POp-POWN m n) (clamp-natural (expt m n))) - (define unison-POp-LOGF log) - - (define (reify-exn thunk) - (guard - (e [else - (sum 0 '() (exception->string e) ref-unit-unit)]) - (thunk))) - - ; Core implemented primops, upon which primops-in-unison can be built. - (define (unison-POp-ADDN m n) (clamp-natural (+ m n))) - (define (unison-POp-ANDN m n) (bitwise-and m n)) - (define unison-POp-BLDS - (lambda args-list - (fold-right (lambda (e l) (chunked-list-add-first l e)) empty-chunked-list args-list))) - (define (unison-POp-CATS l r) (chunked-list-append l r)) - (define (unison-POp-CATT l r) (chunked-string-append l r)) - (define (unison-POp-CATB l r) (chunked-bytes-append l r)) - (define (unison-POp-CMPU l r) (ord (universal-compare l r))) - (define (unison-POp-COMN n) (wrap-natural (bitwise-not n))) - (define (unison-POp-CONS x xs) (chunked-list-add-first xs x)) - (define (unison-POp-DECI n) (clamp-integer (sub1 n))) - (define (unison-POp-INCI n) (clamp-integer (add1 n))) - (define (unison-POp-DECN n) (wrap-natural (sub1 n))) - (define (unison-POp-INCN n) (clamp-natural (add1 n))) - (define (unison-POp-DIVN m n) (quotient m n)) - (define (unison-POp-DRPB n bs) (chunked-bytes-drop bs n)) - (define (unison-POp-DRPS n l) (chunked-list-drop l n)) - (define (unison-POp-DRPT n t) (chunked-string-drop t n)) - (define (unison-POp-EQLN m n) (bool (= m n))) - (define (unison-POp-EQLT s t) (bool (equal? s t))) - (define (unison-POp-LEQT s t) (bool (chunked-stringstring fnm)]) - (put-string p snm) - (put-string p ": ") - (display (describe-value x) p) - (raise (make-exn:bug snm x)))) - (define (unison-POp-FTOT f) - (define base (number->string f)) - (define dotted - (if (string-contains? base ".") - base - (string-replace base "e" ".0e"))) - (string->chunked-string - (string-replace dotted "+" ""))) - (define (unison-POp-IDXB n bs) - (guard (x [else none]) - (some (chunked-bytes-ref bs n)))) - (define (unison-POp-IDXS n l) - (guard (x [else none]) - (some (chunked-list-ref l n)))) - (define (unison-POp-IORN m n) (bitwise-ior m n)) - (define (unison-POp-ITOT n) - (string->chunked-string (number->string n))) - (define (unison-POp-LEQN m n) (bool (fx<=? m n))) - (define (unison-POp-LZRO m) (- 64 (integer-length m))) - (define (unison-POp-MULN m n) (clamp-natural (* m n))) - (define (unison-POp-MODN m n) (modulo m n)) - (define (unison-POp-NTOT n) (string->chunked-string (number->string n))) - (define (unison-POp-PAKB l) - (build-chunked-bytes - (chunked-list-length l) - (lambda (i) (chunked-list-ref l i)))) - (define (unison-POp-PAKT l) - (build-chunked-string - (chunked-list-length l) - (lambda (i) (chunked-list-ref l i)))) - (define (unison-POp-SHLI i k) - (clamp-integer (bitwise-arithmetic-shift-left i k))) - (define (unison-POp-SHLN n k) - (clamp-natural (bitwise-arithmetic-shift-left n k))) - (define (unison-POp-SHRI i k) (bitwise-arithmetic-shift-right i k)) - (define (unison-POp-SHRN n k) (bitwise-arithmetic-shift-right n k)) - (define (unison-POp-SIZS l) (chunked-list-length l)) - (define (unison-POp-SIZT t) (chunked-string-length t)) - (define (unison-POp-SIZB b) (chunked-bytes-length b)) - (define (unison-POp-SNOC xs x) (chunked-list-add-last xs x)) - (define (unison-POp-SUBN m n) (clamp-integer (- m n))) - (define (unison-POp-SUBI m n) (clamp-integer (- m n))) - (define (unison-POp-TAKS n s) (chunked-list-take s n)) - (define (unison-POp-TAKT n t) (chunked-string-take t n)) - (define (unison-POp-TAKB n t) (chunked-bytes-take t n)) - - (define (->optional v) - (if v - (ref-optional-some v) - ref-optional-none)) - - (define-unison (builtin-Text.indexOf n h) - (->optional (chunked-string-index-of h n))) - (define-unison (builtin-Bytes.indexOf n h) - (->optional (chunked-bytes-index-of h n))) - - ;; TODO currently only runs in low-level tracing support - (define (unison-POp-DBTX x) - (sum 1 (string->chunked-string (describe-value x)))) - - (define (unison-FOp-Handle.toText h) - (string->chunked-string (describe-value h))) - (define (unison-FOp-Socket.toText s) - (string->chunked-string (describe-value s))) - (define (unison-FOp-ThreadId.toText tid) - (string->chunked-string (describe-value tid))) - - (define (unison-POp-TRCE s x) - (display "trace: ") - (display (chunked-string->string s)) - (newline) - (display (describe-value x)) - (newline)) - (define (unison-POp-PRNT s) - (display (chunked-string->string s)) - (newline)) - (define (unison-POp-TTON s) - (let ([mn (string->number (chunked-string->string s))]) - (if (and (exact-nonnegative-integer? mn) (< mn bit64)) - (some mn) - none))) - (define (unison-POp-TTOI s) - (let ([mn (string->number (chunked-string->string s))]) - (if (and (exact-integer? mn) (>= mn nbit63) (< mn bit63)) - (some mn) - none))) - (define (unison-POp-TTOF s) - (let ([mn (string->number (chunked-string->string s))]) - (if mn (some mn) none))) - (define (unison-POp-UPKT s) - (build-chunked-list - (chunked-string-length s) - (lambda (i) (chunked-string-ref s i)))) - (define (unison-POp-VWLS l) - (if (chunked-list-empty? l) - (sum 0) - (let-values ([(t h) (chunked-list-pop-first l)]) - (sum 1 h t)))) - (define (unison-POp-VWRS l) - (if (chunked-list-empty? l) - (sum 0) - (let-values ([(t h) (chunked-list-pop-last l)]) - (sum 1 t h)))) - (define (unison-POp-SPLL i s) - (if (< (chunked-list-length s) i) - (sum 0) - (let-values ([(l r) (chunked-list-split-at s i)]) - (sum 1 l r)))) - (define (unison-POp-SPLR i s) ; TODO write test that stresses this - (let ([len (chunked-list-length s) ]) - (if (< len i) - (sum 0) - (let-values ([(l r) (chunked-list-split-at s (- len i))]) - (sum 1 l r))))) - - (define (unison-POp-UCNS s) - (if (chunked-string-empty? s) - (sum 0) - (let-values ([(t h) (chunked-string-pop-first s)]) - (sum 1 (char h) t)))) - - (define (unison-POp-USNC s) - (if (chunked-string-empty? s) - (sum 0) - (let-values ([(t h) (chunked-string-pop-last s)]) - (sum 1 t (char h))))) - - ;; TODO flatten operation on Bytes is a no-op for now (and possibly ever) - (define (unison-POp-FLTB b) b) - - (define (unison-POp-XORN m n) (bitwise-xor m n)) - (define (unison-POp-VALU c) (decode-value c)) - - (define (unison-FOp-ImmutableByteArray.read16be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u16-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read24be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u24-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read32be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u32-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read40be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u40-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read48be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u48-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read56be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u56-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read64be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u64-ref bs n 'big))))) - - (define unison-FOp-internal.dataTag unison-data-tag) - - (define (unison-FOp-IO.getBytes.impl.v3 p n) - (reify-exn - (lambda () - (right - (bytes->chunked-bytes - (get-bytevector-n p n)))))) - - (define (unison-FOp-IO.putBytes.impl.v3 p bs) - (begin - (put-bytevector p (chunked-bytes->bytes bs)) - (flush-output-port p) - (sum 1 #f))) - - (define (unison-FOp-Char.toText c) (string->chunked-string (string (integer->char c)))) - - (define (unison-FOp-IO.getArgs.impl.v1) - (sum 1 (cdr (command-line)))) - - (define unison-FOp-IO.systemTimeMicroseconds.v1 current-microseconds) - - ;; TODO should we convert Bytes -> Text directly without the intermediate conversions? - (define (unison-FOp-Text.fromUtf8.impl.v3 b) - (with-handlers - ([exn:fail:contract? - (lambda (e) - (exception - ref-iofailure:typelink - (string->chunked-string - (string-append - "Invalid UTF-8 stream: " - (describe-value b))) - (exception->string e)))]) - (right (string->chunked-string (bytes->string/utf-8 (chunked-bytes->bytes b)))))) - - ;; TODO should we convert Text -> Bytes directly without the intermediate conversions? - (define (unison-FOp-Text.toUtf8 s) - (bytes->chunked-bytes (string->bytes/utf-8 (chunked-string->string s)))) - - (define-unison (builtin-IO.isFileEOF.impl.v3 p) - (ref-either-right (port-eof? p))) - - (define (unison-FOp-IO.closeFile.impl.v3 h) - (if (input-port? h) - (close-input-port h) - (close-output-port h)) - (right none)) - - (define (unison-FOp-Text.repeat n t) - (let loop ([cnt 0] - [acc empty-chunked-string]) - (if (= cnt n) - acc - (loop (+ cnt 1) (chunked-string-append acc t))))) - - (define (unison-FOp-Text.reverse s) - (chunked-string-foldMap-chunks - s - string-reverse - (lambda (acc c) (chunked-string-append c acc)))) - - (define (unison-FOp-Text.toLowercase s) - (chunked-string-foldMap-chunks s string-downcase chunked-string-append)) - - (define (unison-FOp-Text.toUppercase s) - (chunked-string-foldMap-chunks s string-upcase chunked-string-append)) - - (define (unison-FOp-Pattern.run p s) - (let* ([r (pattern-match p s)]) - (if r (sum 1 (icdr r) (icar r)) (sum 0)))) - - (define (unison-FOp-Pattern.isMatch p s) (bool (pattern-match? p s))) - (define (unison-FOp-Pattern.many p) (many p)) - (define (unison-FOp-Pattern.capture p) (capture p)) - (define (unison-FOp-Pattern.join ps) - (join* ps)) - (define (unison-FOp-Pattern.or p1 p2) (choice p1 p2)) - (define (unison-FOp-Pattern.replicate n m p) (replicate p n m)) - - (define (unison-FOp-Text.patterns.digit) digit) - (define (unison-FOp-Text.patterns.letter) letter) - (define (unison-FOp-Text.patterns.punctuation) punctuation) - (define (unison-FOp-Text.patterns.charIn cs) (chars cs)) - (define (unison-FOp-Text.patterns.notCharIn cs) (not-chars cs)) - (define (unison-FOp-Text.patterns.anyChar) any-char) - (define (unison-FOp-Text.patterns.space) space) - (define (unison-FOp-Text.patterns.charRange a z) (char-range (integer->char a) (integer->char z))) - (define (unison-FOp-Text.patterns.notCharRange a z) (not-char-range (integer->char a) (integer->char z))) - (define (unison-FOp-Text.patterns.literal s) (literal s)) - (define (unison-FOp-Text.patterns.eof) eof) - (define (unison-FOp-Text.patterns.char cc) cc) - (define (unison-FOp-Char.Class.is cc c) - (unison-FOp-Pattern.isMatch cc (unison-FOp-Char.toText c))) - (define (unison-FOp-Char.Class.any) (unison-FOp-Text.patterns.anyChar)) - (define (unison-FOp-Char.Class.punctuation) - (unison-FOp-Text.patterns.punctuation)) - (define (unison-FOp-Char.Class.letter) (unison-FOp-Text.patterns.letter)) - (define (unison-FOp-Char.Class.alphanumeric) alphanumeric) - (define (unison-FOp-Char.Class.upper) upper) - (define (unison-FOp-Char.Class.lower) lower) - (define (unison-FOp-Char.Class.number) number) - (define (unison-FOp-Char.Class.symbol) symbol) - (define (unison-FOp-Char.Class.whitespace) space) - (define (unison-FOp-Char.Class.control) control) - (define (unison-FOp-Char.Class.printable) printable) - (define (unison-FOp-Char.Class.mark) mark) - (define (unison-FOp-Char.Class.separator) separator) - (define (unison-FOp-Char.Class.or p1 p2) (char-class-or p1 p2)) - (define (unison-FOp-Char.Class.range a z) - (unison-FOp-Text.patterns.charRange a z)) - (define (unison-FOp-Char.Class.anyOf cs) (unison-FOp-Text.patterns.charIn cs)) - (define (unison-FOp-Char.Class.and cc1 cc2) (char-class-and cc1 cc2)) - (define (unison-FOp-Char.Class.not cc) (char-class-not cc)) - - (define (catch-array thunk) - (reify-exn thunk)) - - (define (unison-FOp-ImmutableArray.read vec i) - (catch-array - (lambda () - (sum 1 (vector-ref vec i))))) - - (define (unison-FOp-ImmutableArray.copyTo! dst doff src soff n) - (catch-array - (lambda () - (vector-copy! dst doff src soff n) - (sum 1)))) - - (define (unison-FOp-MutableArray.copyTo! dst doff src soff l) - (catch-array - (lambda () - (vector-copy! dst doff src soff l) - (sum 1)))) - - (define unison-FOp-MutableArray.freeze! freeze-vector!) - - (define unison-FOp-MutableArray.freeze freeze-subvector) - - (define (unison-FOp-MutableArray.read src i) - (catch-array - (lambda () - (sum 1 (vector-ref src i))))) - - (define (unison-FOp-MutableArray.write dst i x) - (catch-array - (lambda () - (vector-set! dst i x) - (sum 1)))) - - (define (unison-FOp-ImmutableByteArray.copyTo! dst doff src soff n) - (catch-array - (lambda () - (bytes-copy! dst doff src soff n) - (sum 1)))) - - (define (unison-FOp-ImmutableByteArray.read8 arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u8-ref arr i))))) - - (define (unison-FOp-MutableByteArray.copyTo! dst doff src soff l) - (catch-array - (lambda () - (bytes-copy! dst doff src soff l) - (sum 1)))) - - (define unison-FOp-MutableByteArray.freeze! freeze-bytevector!) - - (define (unison-FOp-MutableByteArray.write8 arr i b) - (catch-array - (lambda () - (bytevector-u8-set! arr i b) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.write16be arr i b) - (catch-array - (lambda () - (bytevector-u16-set! arr i b 'big) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.write32be arr i b) - (catch-array - (lambda () - (bytevector-u32-set! arr i b 'big) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.write64be arr i b) - (catch-array - (lambda () - (bytevector-u64-set! arr i b 'big) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.read8 arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u8-ref arr i))))) - - (define (unison-FOp-MutableByteArray.read16be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u16-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read24be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u24-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read32be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u32-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read40be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u40-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read64be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u64-ref arr i 'big))))) - - (define (unison-FOp-Scope.bytearray n) (make-bytevector n)) - (define (unison-FOp-IO.bytearray n) (make-bytevector n)) - - (define (unison-FOp-Scope.array n) (make-vector n)) - (define (unison-FOp-IO.array n) (make-vector n)) - - (define (unison-FOp-Scope.bytearrayOf b n) (make-bytevector n b)) - (define (unison-FOp-IO.bytearrayOf b n) (make-bytevector n b)) - - (define (unison-FOp-Scope.arrayOf v n) (make-vector n v)) - (define (unison-FOp-IO.arrayOf v n) (make-vector n v)) - - (define unison-FOp-MutableByteArray.length bytevector-length) - (define unison-FOp-ImmutableByteArray.length bytevector-length) - (define unison-FOp-MutableByteArray.size bytevector-length) - (define unison-FOp-ImmutableByteArray.size bytevector-length) - (define unison-FOp-MutableArray.size vector-length) - (define unison-FOp-ImmutableArray.size vector-length) - - (define (unison-POp-FORK thunk) (fork thunk)) - (define (unison-FOp-IO.delay.impl.v3 micros) (sleep micros)) - (define (unison-FOp-IO.kill.impl.v3 threadId) (kill threadId)) - (define (unison-FOp-Scope.ref a) (ref-new a)) - (define (unison-FOp-IO.ref a) (ref-new a)) - (define (unison-FOp-Ref.read ref) (ref-read ref)) - (define (unison-FOp-Ref.write ref a) (ref-write ref a)) - (define (unison-FOp-Ref.readForCas ref) (ref-read ref)) - (define (unison-FOp-Ref.Ticket.read ticket) ticket) - (define (unison-FOp-Ref.cas ref ticket value) (ref-cas ref ticket value)) - (define (unison-FOp-Promise.new) (promise-new)) - (define (unison-FOp-Promise.read promise) (promise-read promise)) - (define (unison-FOp-Promise.tryRead promise) (promise-try-read promise)) - (define (unison-FOp-Promise.write promise a) (promise-write promise a))) - - - (define (exn:io? e) - (or (exn:fail:read? e) - (exn:fail:filesystem? e) - (exn:fail:network? e))) - - (define (exn:arith? e) - (or (exn:fail:contract:divide-by-zero? e) - (exn:fail:contract:non-fixnum-result? e))) - - (define-unison (builtin-IO.tryEval thunk) + (define-unison-builtin (builtin-Nat.== x y) (= x y))) + + (define-unison-builtin (builtin-Nat.isEven x) (even? x)) + (define-unison-builtin (builtin-Nat.isOdd x) (odd? x)) + + ; Note: chunked-string x y) + (not (chunked-string= x y) (chunked-string x y) + (case (universal-compare x y) [(>) #t] [else #f])) + (define-unison-builtin (builtin-Universal.< x y) + (case (universal-compare x y) [(<) #t] [else #f])) + (define-unison-builtin (builtin-Universal.<= x y) + (case (universal-compare x y) [(>) #f] [else #t])) + (define-unison-builtin (builtin-Universal.>= x y) + (case (universal-compare x y) [(<) #f] [else #t])) + (define-unison-builtin (builtin-Universal.compare x y) + (case (universal-compare x y) + [(>) 1] [(<) -1] [else 0])) + + (define-unison-builtin (builtin-Scope.bytearrayOf i n) + (make-bytes n i)) + + ; (define-builtin-link Link.Type.toText) + (define-unison-builtin (builtin-Link.Type.toText ln) + (string->chunked-string (typelink->string ln))) + + ; (define-builtin-link Link.Term.toText) + (define-unison-builtin (builtin-Link.Term.toText ln) + (string->chunked-string (termlink->string ln))) + + (define-unison-builtin (builtin-Char.Class.is cc c) + (pattern-match? cc (string->chunked-string (string c)))) + + (define-unison-builtin (builtin-Pattern.captureAs c p) + (capture-as c p)) + + (define-unison-builtin (builtin-Pattern.many.corrected p) (many p)) + + (define-unison-builtin (builtin-Pattern.isMatch p s) + (pattern-match? p s)) + + (define-unison-builtin (builtin-unsafe.coerceAbilities f) f) + + (define (unison-POp-UPKB bs) + (build-chunked-list + (chunked-bytes-length bs) + (lambda (i) (chunked-bytes-ref bs i)))) + + (define (unison-POp-ADDI i j) (clamp-integer (+ i j))) + (define (unison-POp-MULI i j) (clamp-integer (* i j))) + (define (unison-POp-MODI i j) (clamp-integer (modulo i j))) + (define (unison-POp-LEQI a b) (bool (<= a b))) + (define (unison-POp-POWN m n) (clamp-natural (expt m n))) + (define unison-POp-LOGF log) + + (define (reify-exn thunk) (with-handlers - ([exn:break? - (lambda (e) - (raise-unison-exception - ref-threadkilledfailure:typelink - (string->chunked-string "thread killed") - ref-unit-unit))] - [exn:io? - (lambda (e) - (raise-unison-exception - ref-iofailure:typelink - (exception->string e) - ref-unit-unit))] - [exn:arith? + ([exn:fail:contract? (lambda (e) - (raise-unison-exception - ref-arithfailure:typelink - (exception->string e) - ref-unit-unit))] - [exn:bug? (lambda (e) (exn:bug->exception e))] - [exn:fail? - (lambda (e) - (raise-unison-exception - ref-runtimefailure:typelink - (exception->string e) - ref-unit-unit))] - [(lambda (x) #t) + (sum 0 '() (exception->string e) ref-unit-unit))]) + (thunk))) + + ; Core implemented primops, upon which primops-in-unison can be built. + (define (unison-POp-ADDN m n) (clamp-natural (+ m n))) + (define (unison-POp-ANDN m n) (bitwise-and m n)) + (define unison-POp-BLDS + (lambda args-list + (foldr (lambda (e l) (chunked-list-add-first l e)) empty-chunked-list args-list))) + (define (unison-POp-CATS l r) (chunked-list-append l r)) + (define (unison-POp-CATT l r) (chunked-string-append l r)) + (define (unison-POp-CATB l r) (chunked-bytes-append l r)) + (define (unison-POp-CMPU l r) (ord (universal-compare l r))) + (define (unison-POp-COMN n) (wrap-natural (bitwise-not n))) + (define (unison-POp-CONS x xs) (chunked-list-add-first xs x)) + (define (unison-POp-DECI n) (clamp-integer (sub1 n))) + (define (unison-POp-INCI n) (clamp-integer (add1 n))) + (define (unison-POp-DECN n) (wrap-natural (sub1 n))) + (define (unison-POp-INCN n) (clamp-natural (add1 n))) + (define (unison-POp-DIVN m n) (quotient m n)) + (define (unison-POp-DRPB n bs) (chunked-bytes-drop bs n)) + (define (unison-POp-DRPS n l) (chunked-list-drop l n)) + (define (unison-POp-DRPT n t) (chunked-string-drop t n)) + (define (unison-POp-EQLN m n) (bool (= m n))) + (define (unison-POp-EQLT s t) (bool (equal? s t))) + (define (unison-POp-LEQT s t) (bool (chunked-stringstring fnm)]) + (raise (make-exn:bug snm x)))) + (define (unison-POp-FTOT f) + (define base (number->string f)) + (define dotted + (if (string-contains? base ".") + base + (string-replace base "e" ".0e"))) + (string->chunked-string + (string-replace dotted "+" ""))) + (define (unison-POp-IDXB n bs) + (with-handlers + ([exn:fail:contract? (lambda (e) none)]) + (some (chunked-bytes-ref bs n)))) + (define (unison-POp-IDXS n l) + (with-handlers + ([exn:fail:contract? (lambda (x) none)]) + (some (chunked-list-ref l n)))) + (define (unison-POp-IORN m n) (bitwise-ior m n)) + (define (unison-POp-ITOT n) + (string->chunked-string (number->string n))) + (define (unison-POp-LEQN m n) (bool (<= m n))) + (define (unison-POp-LZRO m) (- 64 (integer-length m))) + (define (unison-POp-MULN m n) (clamp-natural (* m n))) + (define (unison-POp-MODN m n) (modulo m n)) + (define (unison-POp-NTOT n) (string->chunked-string (number->string n))) + (define (unison-POp-PAKB l) + (build-chunked-bytes + (chunked-list-length l) + (lambda (i) (chunked-list-ref l i)))) + (define (unison-POp-PAKT l) + (build-chunked-string + (chunked-list-length l) + (lambda (i) (chunked-list-ref l i)))) + (define (unison-POp-SHLI i k) + (clamp-integer (arithmetic-shift i k))) + (define (unison-POp-SHLN n k) + (clamp-natural (arithmetic-shift n k))) + (define (unison-POp-SHRI i k) (arithmetic-shift i (- k))) + (define (unison-POp-SHRN n k) (arithmetic-shift n (- k))) + (define (unison-POp-SIZS l) (chunked-list-length l)) + (define (unison-POp-SIZT t) (chunked-string-length t)) + (define (unison-POp-SIZB b) (chunked-bytes-length b)) + (define (unison-POp-SNOC xs x) (chunked-list-add-last xs x)) + (define (unison-POp-SUBN m n) (clamp-integer (- m n))) + (define (unison-POp-SUBI m n) (clamp-integer (- m n))) + (define (unison-POp-TAKS n s) (chunked-list-take s n)) + (define (unison-POp-TAKT n t) (chunked-string-take t n)) + (define (unison-POp-TAKB n t) (chunked-bytes-take t n)) + + (define (->optional v) + (if v + (ref-optional-some v) + ref-optional-none)) + + (define-unison-builtin (builtin-Text.indexOf n h) + (->optional (chunked-string-index-of h n))) + (define-unison-builtin (builtin-Bytes.indexOf n h) + (->optional (chunked-bytes-index-of h n))) + + ;; TODO currently only runs in low-level tracing support + (define (unison-POp-DBTX x) + (sum 1 (string->chunked-string (describe-value x)))) + + (define (unison-FOp-Handle.toText h) + (string->chunked-string (describe-value h))) + (define (unison-FOp-Socket.toText s) + (string->chunked-string (describe-value s))) + (define (unison-FOp-ThreadId.toText tid) + (string->chunked-string (describe-value tid))) + + (define (unison-POp-TRCE s x) + (display "trace: ") + (display (chunked-string->string s)) + (newline) + (display (describe-value x)) + (newline)) + (define (unison-POp-PRNT s) + (display (chunked-string->string s)) + (newline)) + (define (unison-POp-TTON s) + (let ([mn (string->number (chunked-string->string s))]) + (if (and (exact-nonnegative-integer? mn) (< mn bit64)) + (some mn) + none))) + (define (unison-POp-TTOI s) + (let ([mn (string->number (chunked-string->string s))]) + (if (and (exact-integer? mn) (>= mn nbit63) (< mn bit63)) + (some mn) + none))) + (define (unison-POp-TTOF s) + (let ([mn (string->number (chunked-string->string s))]) + (if mn (some mn) none))) + (define (unison-POp-UPKT s) + (build-chunked-list + (chunked-string-length s) + (lambda (i) (chunked-string-ref s i)))) + (define (unison-POp-VWLS l) + (if (chunked-list-empty? l) + (sum 0) + (let-values ([(t h) (chunked-list-pop-first l)]) + (sum 1 h t)))) + (define (unison-POp-VWRS l) + (if (chunked-list-empty? l) + (sum 0) + (let-values ([(t h) (chunked-list-pop-last l)]) + (sum 1 t h)))) + (define (unison-POp-SPLL i s) + (if (< (chunked-list-length s) i) + (sum 0) + (let-values ([(l r) (chunked-list-split-at s i)]) + (sum 1 l r)))) + (define (unison-POp-SPLR i s) ; TODO write test that stresses this + (let ([len (chunked-list-length s) ]) + (if (< len i) + (sum 0) + (let-values ([(l r) (chunked-list-split-at s (- len i))]) + (sum 1 l r))))) + + (define (unison-POp-UCNS s) + (if (chunked-string-empty? s) + (sum 0) + (let-values ([(t h) (chunked-string-pop-first s)]) + (sum 1 (char h) t)))) + + (define (unison-POp-USNC s) + (if (chunked-string-empty? s) + (sum 0) + (let-values ([(t h) (chunked-string-pop-last s)]) + (sum 1 t (char h))))) + + ;; TODO flatten operation on Bytes is a no-op for now (and possibly ever) + (define (unison-POp-FLTB b) b) + + (define (unison-POp-XORN m n) (bitwise-xor m n)) + (define (unison-POp-VALU c) (decode-value c)) + + (define (unison-FOp-ImmutableByteArray.read16be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u16-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read24be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u24-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read32be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u32-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read40be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u40-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read48be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u48-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read56be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u56-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read64be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u64-ref bs n 'big))))) + + (define unison-FOp-internal.dataTag unison-data-tag) + + (define (unison-FOp-IO.getBytes.impl.v3 p n) + (reify-exn + (lambda () + (right + (bytes->chunked-bytes + (read-bytes n p)))))) + + (define (unison-FOp-IO.putBytes.impl.v3 p bs) + (begin + (write-bytes (chunked-bytes->bytes bs) p) + (flush-output p) + (sum 1 #f))) + + (define (unison-FOp-Char.toText c) (string->chunked-string (string (integer->char c)))) + + (define (unison-FOp-IO.getArgs.impl.v1) + (sum 1 (cdr (command-line)))) + + (define unison-FOp-IO.systemTimeMicroseconds.v1 current-microseconds) + + ;; TODO should we convert Bytes -> Text directly without the intermediate conversions? + (define (unison-FOp-Text.fromUtf8.impl.v3 b) + (with-handlers + ([exn:fail:contract? (lambda (e) - (raise-unison-exception - ref-miscfailure:typelink - (exception->string e) - ref-unit-unit))]) - (thunk ref-unit-unit))) - - (declare-builtin-link builtin-Float.*) - (declare-builtin-link builtin-Float.fromRepresentation) - (declare-builtin-link builtin-Float.toRepresentation) - (declare-builtin-link builtin-Float.ceiling) - (declare-builtin-link builtin-Float.exp) - (declare-builtin-link builtin-Float.log) - (declare-builtin-link builtin-Float.max) - (declare-builtin-link builtin-Float.min) - (declare-builtin-link builtin-Float.tan) - (declare-builtin-link builtin-Float.tanh) - (declare-builtin-link builtin-Float.logBase) - (declare-builtin-link builtin-Float.pow) - (declare-builtin-link builtin-Float.>) - (declare-builtin-link builtin-Float.<) - (declare-builtin-link builtin-Float.>=) - (declare-builtin-link builtin-Float.<=) - (declare-builtin-link builtin-Float.==) - (declare-builtin-link builtin-Int.pow) - (declare-builtin-link builtin-Int.*) - (declare-builtin-link builtin-Int.+) - (declare-builtin-link builtin-Int.-) - (declare-builtin-link builtin-Int./) - (declare-builtin-link builtin-Int.>) - (declare-builtin-link builtin-Int.<) - (declare-builtin-link builtin-Int.>=) - (declare-builtin-link builtin-Int.<=) - (declare-builtin-link builtin-Int.==) - (declare-builtin-link builtin-Int.isEven) - (declare-builtin-link builtin-Int.isOdd) - (declare-builtin-link builtin-Int.increment) - (declare-builtin-link builtin-Int.negate) - (declare-builtin-link builtin-Int.fromRepresentation) - (declare-builtin-link builtin-Int.toRepresentation) - (declare-builtin-link builtin-Int.signum) - (declare-builtin-link builtin-Int.trailingZeros) - (declare-builtin-link builtin-Int.popCount) - (declare-builtin-link builtin-Nat.increment) - (declare-builtin-link builtin-Nat.popCount) - (declare-builtin-link builtin-Nat.toFloat) - (declare-builtin-link builtin-Nat.trailingZeros) - (declare-builtin-link builtin-Nat.+) - (declare-builtin-link builtin-Nat.>) - (declare-builtin-link builtin-Nat.<) - (declare-builtin-link builtin-Nat.>=) - (declare-builtin-link builtin-Nat.<=) - (declare-builtin-link builtin-Nat.==) - (declare-builtin-link builtin-Nat.drop) - (declare-builtin-link builtin-Nat.isEven) - (declare-builtin-link builtin-Nat.isOdd) - (declare-builtin-link builtin-Text.indexOf) - (declare-builtin-link builtin-Text.>) - (declare-builtin-link builtin-Text.<) - (declare-builtin-link builtin-Text.>=) - (declare-builtin-link builtin-Text.<=) - (declare-builtin-link builtin-Text.==) - (declare-builtin-link builtin-Text.!=) - (declare-builtin-link builtin-Bytes.indexOf) - (declare-builtin-link builtin-IO.randomBytes) - (declare-builtin-link builtin-IO.tryEval) - (declare-builtin-link builtin-List.splitLeft) - (declare-builtin-link builtin-List.splitRight) - (declare-builtin-link builtin-Value.toBuiltin) - (declare-builtin-link builtin-Value.fromBuiltin) - (declare-builtin-link builtin-Code.fromGroup) - (declare-builtin-link builtin-Code.toGroup) - (declare-builtin-link builtin-TermLink.fromReferent) - (declare-builtin-link builtin-TermLink.toReferent) - (declare-builtin-link builtin-TypeLink.toReference) - (declare-builtin-link builtin-IO.seekHandle.impl.v3) - (declare-builtin-link builtin-IO.getLine.impl.v1) - (declare-builtin-link builtin-IO.getSomeBytes.impl.v1) - (declare-builtin-link builtin-IO.setBuffering.impl.v3) - (declare-builtin-link builtin-IO.getBuffering.impl.v3) - (declare-builtin-link builtin-IO.setEcho.impl.v1) - (declare-builtin-link builtin-IO.isFileOpen.impl.v3) - (declare-builtin-link builtin-IO.ready.impl.v1) - (declare-builtin-link builtin-IO.process.call) - (declare-builtin-link builtin-IO.getEcho.impl.v1) - (declare-builtin-link builtin-IO.getArgs.impl.v1) - (declare-builtin-link builtin-IO.getEnv.impl.v1) - (declare-builtin-link builtin-IO.getChar.impl.v1) - (declare-builtin-link builtin-IO.directoryContents.impl.v3) - (declare-builtin-link builtin-IO.getCurrentDirectory.impl.v3) - (declare-builtin-link builtin-IO.removeDirectory.impl.v3) - (declare-builtin-link builtin-IO.renameFile.impl.v3) - (declare-builtin-link builtin-IO.createTempDirectory.impl.v3) - (declare-builtin-link builtin-IO.createDirectory.impl.v3) - (declare-builtin-link builtin-IO.setCurrentDirectory.impl.v3) - (declare-builtin-link builtin-IO.renameDirectory.impl.v3) - (declare-builtin-link builtin-IO.fileExists.impl.v3) - (declare-builtin-link builtin-IO.isDirectory.impl.v3) - (declare-builtin-link builtin-IO.isFileEOF.impl.v3) - (declare-builtin-link builtin-IO.isSeekable.impl.v3) - (declare-builtin-link builtin-IO.handlePosition.impl.v3) - (declare-builtin-link builtin-IO.systemTime.impl.v3) - (declare-builtin-link builtin-IO.systemTimeMicroseconds.impl.v3) - (declare-builtin-link builtin-Universal.==) - (declare-builtin-link builtin-Universal.>) - (declare-builtin-link builtin-Universal.<) - (declare-builtin-link builtin-Universal.>=) - (declare-builtin-link builtin-Universal.<=) - (declare-builtin-link builtin-Universal.compare) - (declare-builtin-link builtin-Pattern.isMatch) - (declare-builtin-link builtin-Scope.bytearrayOf) - (declare-builtin-link builtin-Char.Class.is) - (declare-builtin-link builtin-Pattern.many.corrected) - (declare-builtin-link builtin-unsafe.coerceAbilities) - (declare-builtin-link builtin-Clock.internals.systemTimeZone.v1) - ) + (exception + ref-iofailure:typelink + (string->chunked-string + (string-append + "Invalid UTF-8 stream: " + (describe-value b))) + (exception->string e)))]) + (right (string->chunked-string (bytes->string/utf-8 (chunked-bytes->bytes b)))))) + + ;; TODO should we convert Text -> Bytes directly without the intermediate conversions? + (define (unison-FOp-Text.toUtf8 s) + (bytes->chunked-bytes (string->bytes/utf-8 (chunked-string->string s)))) + + (define-unison-builtin (builtin-IO.isFileEOF.impl.v3 p) + (ref-either-right (eof-object? (peek-byte p)))) + + (define (unison-FOp-IO.closeFile.impl.v3 h) + (if (input-port? h) + (close-input-port h) + (close-output-port h)) + (right none)) + + (define (unison-FOp-Text.repeat n t) + (let loop ([cnt 0] + [acc empty-chunked-string]) + (if (= cnt n) + acc + (loop (+ cnt 1) (chunked-string-append acc t))))) + + (define (unison-FOp-Text.reverse s) + (chunked-string-foldMap-chunks + s + string-reverse + (lambda (acc c) (chunked-string-append c acc)))) + + (define (unison-FOp-Text.toLowercase s) + (chunked-string-foldMap-chunks s string-downcase chunked-string-append)) + + (define (unison-FOp-Text.toUppercase s) + (chunked-string-foldMap-chunks s string-upcase chunked-string-append)) + + (define (unison-FOp-Pattern.run p s) + (let* ([r (pattern-match p s)]) + (if r (sum 1 (cdr r) (car r)) (sum 0)))) + + (define (unison-FOp-Pattern.isMatch p s) (bool (pattern-match? p s))) + (define (unison-FOp-Pattern.many p) (many p)) + (define (unison-FOp-Pattern.capture p) (capture p)) + (define (unison-FOp-Pattern.join ps) + (join* ps)) + (define (unison-FOp-Pattern.or p1 p2) (choice p1 p2)) + (define (unison-FOp-Pattern.replicate n m p) (replicate p n m)) + + (define (unison-FOp-Text.patterns.digit) digit) + (define (unison-FOp-Text.patterns.letter) letter) + (define (unison-FOp-Text.patterns.punctuation) punctuation) + (define (unison-FOp-Text.patterns.charIn cs) (chars cs)) + (define (unison-FOp-Text.patterns.notCharIn cs) (not-chars cs)) + (define (unison-FOp-Text.patterns.anyChar) any-char) + (define (unison-FOp-Text.patterns.space) space) + (define (unison-FOp-Text.patterns.charRange a z) (char-range (integer->char a) (integer->char z))) + (define (unison-FOp-Text.patterns.notCharRange a z) (not-char-range (integer->char a) (integer->char z))) + (define (unison-FOp-Text.patterns.literal s) (literal s)) + (define (unison-FOp-Text.patterns.eof) eof) + (define (unison-FOp-Text.patterns.char cc) cc) + (define (unison-FOp-Char.Class.is cc c) + (unison-FOp-Pattern.isMatch cc (unison-FOp-Char.toText c))) + (define (unison-FOp-Char.Class.any) (unison-FOp-Text.patterns.anyChar)) + (define (unison-FOp-Char.Class.punctuation) + (unison-FOp-Text.patterns.punctuation)) + (define (unison-FOp-Char.Class.letter) (unison-FOp-Text.patterns.letter)) + (define (unison-FOp-Char.Class.alphanumeric) alphanumeric) + (define (unison-FOp-Char.Class.upper) upper) + (define (unison-FOp-Char.Class.lower) lower) + (define (unison-FOp-Char.Class.number) number) + (define (unison-FOp-Char.Class.symbol) symbol) + (define (unison-FOp-Char.Class.whitespace) space) + (define (unison-FOp-Char.Class.control) control) + (define (unison-FOp-Char.Class.printable) printable) + (define (unison-FOp-Char.Class.mark) mark) + (define (unison-FOp-Char.Class.separator) separator) + (define (unison-FOp-Char.Class.or p1 p2) (char-class-or p1 p2)) + (define (unison-FOp-Char.Class.range a z) + (unison-FOp-Text.patterns.charRange a z)) + (define (unison-FOp-Char.Class.anyOf cs) (unison-FOp-Text.patterns.charIn cs)) + (define (unison-FOp-Char.Class.and cc1 cc2) (char-class-and cc1 cc2)) + (define (unison-FOp-Char.Class.not cc) (char-class-not cc)) + + (define (catch-array thunk) + (reify-exn thunk)) + + (define (unison-FOp-ImmutableArray.read vec i) + (catch-array + (lambda () + (sum 1 (vector-ref vec i))))) + + (define (unison-FOp-ImmutableArray.copyTo! dst doff src soff n) + (catch-array + (lambda () + (vector-copy! dst doff src soff n) + (sum 1)))) + + (define (unison-FOp-MutableArray.copyTo! dst doff src soff l) + (catch-array + (lambda () + (vector-copy! dst doff src soff l) + (sum 1)))) + + (define unison-FOp-MutableArray.freeze! freeze-vector!) + + (define unison-FOp-MutableArray.freeze freeze-subvector) + + (define (unison-FOp-MutableArray.read src i) + (catch-array + (lambda () + (sum 1 (vector-ref src i))))) + + (define (unison-FOp-MutableArray.write dst i x) + (catch-array + (lambda () + (vector-set! dst i x) + (sum 1)))) + + (define (unison-FOp-ImmutableByteArray.copyTo! dst doff src soff n) + (catch-array + (lambda () + (bytes-copy! dst doff src soff n) + (sum 1)))) + + (define (unison-FOp-ImmutableByteArray.read8 arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u8-ref arr i))))) + + (define (unison-FOp-MutableByteArray.copyTo! dst doff src soff l) + (catch-array + (lambda () + (bytes-copy! dst doff src soff l) + (sum 1)))) + + (define unison-FOp-MutableByteArray.freeze! freeze-bytevector!) + + (define (unison-FOp-MutableByteArray.write8 arr i b) + (catch-array + (lambda () + (bytevector-u8-set! arr i b) + (sum 1)))) + + (define (unison-FOp-MutableByteArray.write16be arr i b) + (catch-array + (lambda () + (bytevector-u16-set! arr i b 'big) + (sum 1)))) + + (define (unison-FOp-MutableByteArray.write32be arr i b) + (catch-array + (lambda () + (bytevector-u32-set! arr i b 'big) + (sum 1)))) + + (define (unison-FOp-MutableByteArray.write64be arr i b) + (catch-array + (lambda () + (bytevector-u64-set! arr i b 'big) + (sum 1)))) + + (define (unison-FOp-MutableByteArray.read8 arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u8-ref arr i))))) + + (define (unison-FOp-MutableByteArray.read16be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u16-ref arr i 'big))))) + + (define (unison-FOp-MutableByteArray.read24be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u24-ref arr i 'big))))) + + (define (unison-FOp-MutableByteArray.read32be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u32-ref arr i 'big))))) + + (define (unison-FOp-MutableByteArray.read40be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u40-ref arr i 'big))))) + + (define (unison-FOp-MutableByteArray.read64be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u64-ref arr i 'big))))) + + (define (unison-FOp-Scope.bytearray n) (make-bytes n)) + (define (unison-FOp-IO.bytearray n) (make-bytes n)) + + (define (unison-FOp-Scope.array n) (make-vector n)) + (define (unison-FOp-IO.array n) (make-vector n)) + + (define (unison-FOp-Scope.bytearrayOf b n) (make-bytes n b)) + (define (unison-FOp-IO.bytearrayOf b n) (make-bytes n b)) + + (define (unison-FOp-Scope.arrayOf v n) (make-vector n v)) + (define (unison-FOp-IO.arrayOf v n) (make-vector n v)) + + (define unison-FOp-MutableByteArray.length bytevector-length) + (define unison-FOp-ImmutableByteArray.length bytevector-length) + (define unison-FOp-MutableByteArray.size bytevector-length) + (define unison-FOp-ImmutableByteArray.size bytevector-length) + (define unison-FOp-MutableArray.size vector-length) + (define unison-FOp-ImmutableArray.size vector-length) + + (define (unison-POp-FORK thunk) (fork thunk)) + (define (unison-FOp-IO.delay.impl.v3 micros) (sleep micros)) + (define (unison-FOp-IO.kill.impl.v3 threadId) (kill threadId)) + (define (unison-FOp-Scope.ref a) (ref-new a)) + (define (unison-FOp-IO.ref a) (ref-new a)) + (define (unison-FOp-Ref.read ref) (ref-read ref)) + (define (unison-FOp-Ref.write ref a) (ref-write ref a)) + (define (unison-FOp-Ref.readForCas ref) (ref-read ref)) + (define (unison-FOp-Ref.Ticket.read ticket) ticket) + (define (unison-FOp-Ref.cas ref ticket value) (ref-cas ref ticket value)) + (define (unison-FOp-Promise.new) (promise-new)) + (define (unison-FOp-Promise.read promise) (promise-read promise)) + (define (unison-FOp-Promise.tryRead promise) (promise-try-read promise)) + (define (unison-FOp-Promise.write promise a) (promise-write promise a))) + + +(define (exn:io? e) + (or (exn:fail:read? e) + (exn:fail:filesystem? e) + (exn:fail:network? e))) + +(define (exn:arith? e) + (or (exn:fail:contract:divide-by-zero? e) + (exn:fail:contract:non-fixnum-result? e))) + +(define-unison-builtin (builtin-IO.tryEval thunk) + (with-handlers + ([exn:break? + (lambda (e) + (raise-unison-exception + ref-threadkilledfailure:typelink + (string->chunked-string "thread killed") + ref-unit-unit))] + [exn:io? + (lambda (e) + (raise-unison-exception + ref-iofailure:typelink + (exception->string e) + ref-unit-unit))] + [exn:arith? + (lambda (e) + (raise-unison-exception + ref-arithfailure:typelink + (exception->string e) + ref-unit-unit))] + [exn:bug? (lambda (e) (exn:bug->exception e))] + [exn:fail? + (lambda (e) + (raise-unison-exception + ref-runtimefailure:typelink + (exception->string e) + ref-unit-unit))] + [(lambda (x) #t) + (lambda (e) + (raise-unison-exception + ref-miscfailure:typelink + (exception->string e) + ref-unit-unit))]) + (thunk ref-unit-unit))) + +; (declare-builtin-link builtin-Float.*) +; (declare-builtin-link builtin-Float.fromRepresentation) +; (declare-builtin-link builtin-Float.toRepresentation) +; (declare-builtin-link builtin-Float.ceiling) +; (declare-builtin-link builtin-Float.exp) +; (declare-builtin-link builtin-Float.log) +; (declare-builtin-link builtin-Float.max) +; (declare-builtin-link builtin-Float.min) +; (declare-builtin-link builtin-Float.tan) +; (declare-builtin-link builtin-Float.tanh) +; (declare-builtin-link builtin-Float.logBase) +; (declare-builtin-link builtin-Float.pow) +; (declare-builtin-link builtin-Float.>) +; (declare-builtin-link builtin-Float.<) +; (declare-builtin-link builtin-Float.>=) +; (declare-builtin-link builtin-Float.<=) +; (declare-builtin-link builtin-Float.==) +; (declare-builtin-link builtin-Int.pow) +; (declare-builtin-link builtin-Int.*) +; (declare-builtin-link builtin-Int.+) +; (declare-builtin-link builtin-Int.-) +; (declare-builtin-link builtin-Int./) +; (declare-builtin-link builtin-Int.>) +; (declare-builtin-link builtin-Int.<) +; (declare-builtin-link builtin-Int.>=) +; (declare-builtin-link builtin-Int.<=) +; (declare-builtin-link builtin-Int.==) +; (declare-builtin-link builtin-Int.isEven) +; (declare-builtin-link builtin-Int.isOdd) +; (declare-builtin-link builtin-Int.increment) +; (declare-builtin-link builtin-Int.negate) +; (declare-builtin-link builtin-Int.fromRepresentation) +; (declare-builtin-link builtin-Int.toRepresentation) +; (declare-builtin-link builtin-Int.signum) +; (declare-builtin-link builtin-Int.trailingZeros) +; (declare-builtin-link builtin-Int.popCount) +; (declare-builtin-link builtin-Nat.increment) +; (declare-builtin-link builtin-Nat.popCount) +; (declare-builtin-link builtin-Nat.toFloat) +; (declare-builtin-link builtin-Nat.trailingZeros) +; (declare-builtin-link builtin-Nat.+) +; (declare-builtin-link builtin-Nat.>) +; (declare-builtin-link builtin-Nat.<) +; (declare-builtin-link builtin-Nat.>=) +; (declare-builtin-link builtin-Nat.<=) +; (declare-builtin-link builtin-Nat.==) +; (declare-builtin-link builtin-Nat.drop) +; (declare-builtin-link builtin-Nat.isEven) +; (declare-builtin-link builtin-Nat.isOdd) +; (declare-builtin-link builtin-Text.indexOf) +; (declare-builtin-link builtin-Text.>) +; (declare-builtin-link builtin-Text.<) +; (declare-builtin-link builtin-Text.>=) +; (declare-builtin-link builtin-Text.<=) +; (declare-builtin-link builtin-Text.==) +; (declare-builtin-link builtin-Text.!=) +; (declare-builtin-link builtin-Bytes.indexOf) +; (declare-builtin-link builtin-IO.randomBytes) +; (declare-builtin-link builtin-IO.tryEval) +; (declare-builtin-link builtin-List.splitLeft) +; (declare-builtin-link builtin-List.splitRight) +; (declare-builtin-link builtin-Value.toBuiltin) +; (declare-builtin-link builtin-Value.fromBuiltin) +; (declare-builtin-link builtin-Code.fromGroup) +; (declare-builtin-link builtin-Code.toGroup) +; (declare-builtin-link builtin-TermLink.fromReferent) +; (declare-builtin-link builtin-TermLink.toReferent) +; (declare-builtin-link builtin-TypeLink.toReference) +; (declare-builtin-link builtin-IO.seekHandle.impl.v3) +; (declare-builtin-link builtin-IO.getLine.impl.v1) +; (declare-builtin-link builtin-IO.getSomeBytes.impl.v1) +; (declare-builtin-link builtin-IO.setBuffering.impl.v3) +; (declare-builtin-link builtin-IO.getBuffering.impl.v3) +; (declare-builtin-link builtin-IO.setEcho.impl.v1) +; (declare-builtin-link builtin-IO.isFileOpen.impl.v3) +; (declare-builtin-link builtin-IO.ready.impl.v1) +; (declare-builtin-link builtin-IO.process.call) +; (declare-builtin-link builtin-IO.getEcho.impl.v1) +; (declare-builtin-link builtin-IO.getArgs.impl.v1) +; (declare-builtin-link builtin-IO.getEnv.impl.v1) +; (declare-builtin-link builtin-IO.getChar.impl.v1) +; (declare-builtin-link builtin-IO.directoryContents.impl.v3) +; (declare-builtin-link builtin-IO.getCurrentDirectory.impl.v3) +; (declare-builtin-link builtin-IO.removeDirectory.impl.v3) +; (declare-builtin-link builtin-IO.renameFile.impl.v3) +; (declare-builtin-link builtin-IO.createTempDirectory.impl.v3) +; (declare-builtin-link builtin-IO.createDirectory.impl.v3) +; (declare-builtin-link builtin-IO.setCurrentDirectory.impl.v3) +; (declare-builtin-link builtin-IO.renameDirectory.impl.v3) +; (declare-builtin-link builtin-IO.fileExists.impl.v3) +; (declare-builtin-link builtin-IO.isDirectory.impl.v3) +; (declare-builtin-link builtin-IO.isFileEOF.impl.v3) +; (declare-builtin-link builtin-IO.isSeekable.impl.v3) +; (declare-builtin-link builtin-IO.handlePosition.impl.v3) +; (declare-builtin-link builtin-IO.systemTime.impl.v3) +; (declare-builtin-link builtin-IO.systemTimeMicroseconds.impl.v3) +; (declare-builtin-link builtin-Universal.==) +; (declare-builtin-link builtin-Universal.>) +; (declare-builtin-link builtin-Universal.<) +; (declare-builtin-link builtin-Universal.>=) +; (declare-builtin-link builtin-Universal.<=) +; (declare-builtin-link builtin-Universal.compare) +; (declare-builtin-link builtin-Pattern.isMatch) +; (declare-builtin-link builtin-Scope.bytearrayOf) +; (declare-builtin-link builtin-Char.Class.is) +; (declare-builtin-link builtin-Pattern.many.corrected) +; (declare-builtin-link builtin-unsafe.coerceAbilities) +; (declare-builtin-link builtin-Clock.internals.systemTimeZone.v1) diff --git a/scheme-libs/racket/unison/sandbox.rkt b/scheme-libs/racket/unison/sandbox.rkt index a24c70f2f9..248d0b06e8 100644 --- a/scheme-libs/racket/unison/sandbox.rkt +++ b/scheme-libs/racket/unison/sandbox.rkt @@ -4,7 +4,7 @@ (provide expand-sandbox check-sandbox set-sandbox) (require racket racket/hash) -(require (except-in unison/data true false unit)) +(require unison/data) ; sandboxing information (define sandbox-links (make-hash)) diff --git a/scheme-libs/racket/unison/udp.rkt b/scheme-libs/racket/unison/udp.rkt index 3607673264..2f1170e01b 100644 --- a/scheme-libs/racket/unison/udp.rkt +++ b/scheme-libs/racket/unison/udp.rkt @@ -2,7 +2,7 @@ #lang racket/base (require racket/udp racket/format - (only-in unison/boot define-unison) + (only-in unison/boot define-unison-builtin) unison/data unison/data-info unison/chunked-seq @@ -11,32 +11,29 @@ unison/core) (provide - (prefix-out - builtin-IO.UDP. - (combine-out - clientSocket.impl.v1 - clientSocket.impl.v1:termlink - UDPSocket.recv.impl.v1 - UDPSocket.recv.impl.v1:termlink - UDPSocket.send.impl.v1 - UDPSocket.send.impl.v1:termlink - UDPSocket.close.impl.v1 - UDPSocket.close.impl.v1:termlink - ListenSocket.close.impl.v1 - ListenSocket.close.impl.v1:termlink - UDPSocket.toText.impl.v1 - UDPSocket.toText.impl.v1:termlink - serverSocket.impl.v1 - serverSocket.impl.v1:termlink - ListenSocket.toText.impl.v1 - ListenSocket.toText.impl.v1:termlink - ListenSocket.recvFrom.impl.v1 - ListenSocket.recvFrom.impl.v1:termlink - ClientSockAddr.toText.v1 - ClientSockAddr.toText.v1:termlink - ListenSocket.sendTo.impl.v1 - ListenSocket.sendTo.impl.v1:termlink))) - + builtin-IO.UDP.clientSocket.impl.v1 + builtin-IO.UDP.clientSocket.impl.v1:termlink + builtin-IO.UDP.UDPSocket.recv.impl.v1 + builtin-IO.UDP.UDPSocket.recv.impl.v1:termlink + builtin-IO.UDP.UDPSocket.send.impl.v1 + builtin-IO.UDP.UDPSocket.send.impl.v1:termlink + builtin-IO.UDP.UDPSocket.close.impl.v1 + builtin-IO.UDP.UDPSocket.close.impl.v1:termlink + builtin-IO.UDP.ListenSocket.close.impl.v1 + builtin-IO.UDP.ListenSocket.close.impl.v1:termlink + builtin-IO.UDP.UDPSocket.toText.impl.v1 + builtin-IO.UDP.UDPSocket.toText.impl.v1:termlink + builtin-IO.UDP.serverSocket.impl.v1 + builtin-IO.UDP.serverSocket.impl.v1:termlink + builtin-IO.UDP.ListenSocket.toText.impl.v1 + builtin-IO.UDP.ListenSocket.toText.impl.v1:termlink + builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 + builtin-IO.UDP.ListenSocket.recvFrom.impl.v1:termlink + builtin-IO.UDP.ClientSockAddr.toText.v1 + builtin-IO.UDP.ClientSockAddr.toText.v1:termlink + builtin-IO.UDP.ListenSocket.sendTo.impl.v1 + builtin-IO.UDP.ListenSocket.sendTo.impl.v1:termlink) + (struct client-sock-addr (host port)) @@ -48,10 +45,10 @@ (sum-case a (0 (type msg meta) (ref-either-left (ref-failure-failure type msg (unison-any-any meta)))) - (1 (data) + (1 (data) (ref-either-right data)))) -(define +(define (format-socket socket) (let*-values ([(local-hn local-port remote-hn remote-port) (udp-addresses socket #t)] [(rv) (~a "")]) @@ -64,7 +61,7 @@ (wrap-in-either rv))) ;; define termlink builtins -(define clientSocket.impl.v1:termlink +(define clientSocket.impl.v1:termlink (unison-termlink-builtin "IO.UDP.clientSocket.impl.v1")) (define UDPSocket.recv.impl.v1:termlink (unison-termlink-builtin "IO.UDP.UDPSocket.recv.impl.v1")) @@ -72,7 +69,7 @@ (unison-termlink-builtin "IO.UDP.UDPSocket.send.impl.v1")) (define UDPSocket.close.impl.v1:termlink (unison-termlink-builtin "IO.UDP.UDPSocket.close.impl.v1")) -(define ListenSocket.close.impl.v1:termlink +(define ListenSocket.close.impl.v1:termlink (unison-termlink-builtin "IO.UDP.ListenSocket.close.impl.v1")) (define UDPSocket.toText.impl.v1:termlink (unison-termlink-builtin "IO.UDP.UDPSocket.toText.impl.v1")) @@ -89,22 +86,25 @@ ;; define builtins -(define-unison - (UDPSocket.recv.impl.v1 socket) ; socket -> Either Failure Bytes - (let - ([rv (handle-errors (lambda() +(define-unison-builtin + (builtin-IO.UDP.UDPSocket.recv.impl.v1 socket) + ; socket -> Either Failure Bytes + (let + ([rv (handle-errors (lambda() (let*-values ([(buffer) (make-bytes buffer-size)] [(len a b) (udp-receive! socket buffer)]) (right (bytes->chunked-bytes (subbytes buffer 0 len))))))]) (wrap-in-either rv))) -(define-unison - (ListenSocket.close.impl.v1 socket) ; socket -> Either Failure () +(define-unison-builtin + (builtin-IO.UDP.ListenSocket.close.impl.v1 socket) + ; socket -> Either Failure () (close-socket socket)) -(define-unison - (serverSocket.impl.v1 ip port) ; string string -> Either Failure socket +(define-unison-builtin + (builtin-IO.UDP.serverSocket.impl.v1 ip port) + ; string string -> Either Failure socket (let ([result (handle-errors (lambda() (let* ([iip (chunked-string->string ip)] @@ -115,12 +115,13 @@ (right sock)))))]) (wrap-in-either result))) -(define-unison - (ListenSocket.recvFrom.impl.v1 socket) ; socket -> Either Failure (Bytes, ClientSockAddr) - (let ([result (handle-errors (lambda() +(define-unison-builtin + (builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 socket) + ; socket -> Either Failure (Bytes, ClientSockAddr) + (let ([result (handle-errors (lambda() (if (not (udp? socket)) (raise-argument-error 'socket "a UDP socket" socket) - (let*-values + (let*-values ([(buffer) (make-bytes buffer-size)] [(len host port) (udp-receive! socket buffer)] [(csa) (client-sock-addr host port)] @@ -129,18 +130,20 @@ (right (ref-tuple-pair chunked (ref-tuple-pair csa ref-unit-unit)))))))]) (wrap-in-either result))) -(define-unison - (UDPSocket.send.impl.v1 socket data) ; socket -> Bytes -> Either Failure () +(define-unison-builtin + (builtin-IO.UDP.UDPSocket.send.impl.v1 socket data) + ; socket -> Bytes -> Either Failure () (let ([result (handle-errors (lambda () (begin - (udp-send socket (chunked-bytes->bytes data)) + (udp-send socket (chunked-bytes->bytes data)) (right ref-unit-unit))))]) (wrap-in-either result))) -(define-unison - (ListenSocket.sendTo.impl.v1 sock bytes addr) ; socket -> Bytes -> ClientSockAddr -> Either Failure () +(define-unison-builtin + (builtin-IO.UDP.ListenSocket.sendTo.impl.v1 sock bytes addr) + ; socket -> Bytes -> ClientSockAddr -> Either Failure () (let - ([result (handle-errors (lambda() + ([result (handle-errors (lambda() (let* ([host (client-sock-addr-host addr)] [port (client-sock-addr-port addr)] [bytes (chunked-bytes->bytes bytes)]) @@ -149,28 +152,32 @@ (right ref-unit-unit)))))]) (wrap-in-either result))) -(define-unison - (UDPSocket.toText.impl.v1 socket) ; socket -> string +(define-unison-builtin + (builtin-IO.UDP.UDPSocket.toText.impl.v1 socket) ; socket -> string (format-socket socket)) -(define-unison - (ClientSockAddr.toText.v1 addr) ; ClientSocketAddr -> string +(define-unison-builtin + (builtin-IO.UDP.ClientSockAddr.toText.v1 addr) + ; ClientSocketAddr -> string (string->chunked-string (format "" (client-sock-addr-host addr) (client-sock-addr-port addr)))) -(define-unison - (ListenSocket.toText.impl.v1 socket) ; socket -> string +(define-unison-builtin + (builtin-IO.UDP.ListenSocket.toText.impl.v1 socket) + ; socket -> string (format-socket socket)) -(define-unison - (UDPSocket.close.impl.v1 socket) ; socket -> Either Failure () +(define-unison-builtin + (builtin-IO.UDP.UDPSocket.close.impl.v1 socket) + ; socket -> Either Failure () (let ([rv (handle-errors (lambda() (begin (udp-close socket) (right ref-unit-unit))))]) (wrap-in-either rv))) -(define-unison - (clientSocket.impl.v1 host port) ; string string -> Either Failure socket +(define-unison-builtin + (builtin-IO.UDP.clientSocket.impl.v1 host port) + ; string string -> Either Failure socket (let ([rv (handle-errors (lambda() (let* ([pport (string->number (chunked-string->string port))] [hhost (chunked-string->string host)] [sock (udp-open-socket hhost pport)] From b820365690505afa6c8ae0f6bb098fe93df2bb46 Mon Sep 17 00:00:00 2001 From: Eduard Date: Thu, 13 Jun 2024 20:39:34 +0100 Subject: [PATCH 164/631] add neduard to CONTRIBUTORS --- CONTRIBUTORS.markdown | 1 + 1 file changed, 1 insertion(+) diff --git a/CONTRIBUTORS.markdown b/CONTRIBUTORS.markdown index 408c1bc08c..5649b15dd0 100644 --- a/CONTRIBUTORS.markdown +++ b/CONTRIBUTORS.markdown @@ -86,3 +86,4 @@ The format for this list: name, GitHub handle * Upendra Upadhyay (@upendra1997) * Dan Doel (@dolio) * Eric Torreborre (@etorreborre) +* Eduard Nicodei (@neduard) From 574dd6e838ca0529e324242fef2ff9ff8a7cf109 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Thu, 13 Jun 2024 16:53:30 -0400 Subject: [PATCH 165/631] Update .mergify.yml try renaming contributor check --- .mergify.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.mergify.yml b/.mergify.yml index eff5a6fcc3..e20da83972 100644 --- a/.mergify.yml +++ b/.mergify.yml @@ -1,7 +1,7 @@ pull_request_rules: - name: automatic merge on CI success and review conditions: - - check-success=Contributor signed CONTRIBUTORS.markdown + - check-success=check-contributor - check-success=build ucm (ubuntu-20.04) - check-success=build ucm (macOS-12) - check-success=build ucm (windows-2019) From cdf10c96213717f95622537fc48e0424f2623f5f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Jun 2024 15:16:07 -0700 Subject: [PATCH 166/631] Migration to port project branches to have causal ids. --- .../U/Codebase/Sqlite/Queries.hs | 5 + .../014-add-project-branch-causal-hash-id.sql | 2 + .../unison-codebase-sqlite.cabal | 1 + .../Codebase/SqliteCodebase/Migrations.hs | 29 +++-- .../Migrations/MigrateSchema16To17.hs | 115 +++++++++++++++++- .../Codebase/SqliteCodebase/Operations.hs | 2 + 6 files changed, 138 insertions(+), 16 deletions(-) create mode 100644 codebase2/codebase-sqlite/sql/014-add-project-branch-causal-hash-id.sql diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index bf79576875..f12053d7d4 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -258,6 +258,7 @@ module U.Codebase.Sqlite.Queries cdToProjectRoot, addCurrentProjectPathTable, addProjectBranchReflogTable, + addProjectBranchCausalHashIdColumn, -- ** schema version currentSchemaVersion, @@ -483,6 +484,10 @@ addProjectBranchReflogTable :: Transaction () addProjectBranchReflogTable = executeStatements $(embedProjectStringFile "sql/013-add-project-branch-reflog-table.sql") +addProjectBranchCausalHashIdColumn :: Transaction () +addProjectBranchCausalHashIdColumn = + executeStatements $(embedProjectStringFile "sql/014-add-project-branch-causal-hash-id.sql") + schemaVersion :: Transaction SchemaVersion schemaVersion = queryOneCol diff --git a/codebase2/codebase-sqlite/sql/014-add-project-branch-causal-hash-id.sql b/codebase2/codebase-sqlite/sql/014-add-project-branch-causal-hash-id.sql new file mode 100644 index 0000000000..588c6228eb --- /dev/null +++ b/codebase2/codebase-sqlite/sql/014-add-project-branch-causal-hash-id.sql @@ -0,0 +1,2 @@ +-- Add a new column to the project_branch table to store the causal_hash_id +ALTER TABLE project_branch ADD COLUMN causal_hash_id INTEGER NOT NULL; diff --git a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal index 090bc0d204..c5f8133271 100644 --- a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal +++ b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal @@ -23,6 +23,7 @@ extra-source-files: sql/011-cd-to-project-root.sql sql/012-add-current-project-path-table.sql sql/013-add-project-branch-reflog-table.sql + sql/014-add-project-branch-causal-hash-id.sql sql/create.sql source-repository head diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index eec913cb61..39026c7f36 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -48,10 +48,10 @@ migrations :: TVar (Map Hash Ops2.TermBufferEntry) -> TVar (Map Hash Ops2.DeclBufferEntry) -> CodebasePath -> - Map SchemaVersion (Sqlite.Transaction ()) + Map SchemaVersion (Sqlite.Connection -> IO ()) migrations getDeclType termBuffer declBuffer rootCodebasePath = Map.fromList - [ (2, migrateSchema1To2 getDeclType termBuffer declBuffer), + [ (2, runT $ migrateSchema1To2 getDeclType termBuffer declBuffer), -- The 1 to 2 migration kept around hash objects of hash version 1, unfortunately this -- caused an issue: -- @@ -68,31 +68,34 @@ migrations getDeclType termBuffer declBuffer rootCodebasePath = -- This migration drops all the v1 hash objects to avoid this issue, since these hash objects -- weren't being used for anything anyways. sqlMigration 3 (Q.removeHashObjectsByHashingVersion (HashVersion 1)), - (4, migrateSchema3To4), + (4, runT migrateSchema3To4), -- The 4 to 5 migration adds initial support for out-of-order sync i.e. Unison Share sqlMigration 5 Q.addTempEntityTables, - (6, migrateSchema5To6 rootCodebasePath), - (7, migrateSchema6To7), - (8, migrateSchema7To8), + (6, runT $ migrateSchema5To6 rootCodebasePath), + (7, runT migrateSchema6To7), + (8, runT migrateSchema7To8), -- Recreates the name lookup tables because the primary key was missing the root hash id. sqlMigration 9 Q.fixScopedNameLookupTables, sqlMigration 10 Q.addProjectTables, sqlMigration 11 Q.addMostRecentBranchTable, - (12, migrateSchema11To12), + (12, runT migrateSchema11To12), sqlMigration 13 Q.addMostRecentNamespaceTable, sqlMigration 14 Q.addSquashResultTable, sqlMigration 15 Q.addSquashResultTableIfNotExists, sqlMigration 16 Q.cdToProjectRoot, - sqlMigration 17 migrateSchema16To17 + (17 {- This migration takes a raw sqlite connection -}, \conn -> migrateSchema16To17 conn) ] where - sqlMigration :: SchemaVersion -> Sqlite.Transaction () -> (SchemaVersion, Sqlite.Transaction ()) + runT :: Sqlite.Transaction () -> Sqlite.Connection -> IO () + runT t conn = Sqlite.runWriteTransaction conn (\run -> run t) + sqlMigration :: SchemaVersion -> Sqlite.Transaction () -> (SchemaVersion, Sqlite.Connection -> IO ()) sqlMigration ver migration = ( ver, - do - Q.expectSchemaVersion (ver - 1) - migration - Q.setSchemaVersion ver + \conn -> Sqlite.runWriteTransaction conn \run -> run + do + Q.expectSchemaVersion (ver - 1) + migration + Q.setSchemaVersion ver ) data CodebaseVersionStatus diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs index 1a462706fc..31a7e63661 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs @@ -3,16 +3,38 @@ module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 (migrateSchema16To17) where +import Control.Lens +import Data.Text qualified as Text +import Data.UUID (UUID) +import Data.UUID qualified as UUID +import U.Codebase.Branch.Type qualified as V2Branch +import U.Codebase.Causal qualified as V2Causal +import U.Codebase.Sqlite.DbId (ProjectBranchId (..), ProjectId (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q import Unison.Codebase qualified as Codebase +import Unison.Codebase.Path qualified as Path import Unison.Codebase.SqliteCodebase.Operations qualified as Ops import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName), ProjectName (UnsafeProjectName)) +import Unison.NameSegment (NameSegment) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) +import Unison.NameSegment.Internal qualified as NameSegment +import Unison.Prelude import Unison.Sqlite qualified as Sqlite +import Unison.Syntax.NameSegment qualified as NameSegment +import UnliftIO qualified +import UnliftIO qualified as UnsafeIO --- | This migration adds a new table to the schema, `currentProjectPath`, and sets it to contain the path to the scratch project. -migrateSchema16To17 :: Sqlite.Transaction () -migrateSchema16To17 = do +-- | This migration converts the codebase from having all projects in a single codebase root to having separate causal +-- roots for each project branch. +-- It: +-- * adds a new table to the schema, `currentProjectPath`, and sets it to contain the path to the scratch project. +-- * Adds the causal_hash_id column to the project_branch table. +-- +-- It requires a Connection argument rather than working inside a Transaction because it needs to temporarily disable +-- foreign key checking, and the foreign_key pragma cannot be set within a transaction. +migrateSchema16To17 :: Sqlite.Connection -> IO () +migrateSchema16To17 conn = withDisabledForeignKeys $ do Q.expectSchemaVersion 16 scratchMain <- Q.loadProjectBranchByNames scratchProjectName scratchBranchName >>= \case @@ -23,7 +45,94 @@ migrateSchema16To17 = do pure pb Q.addCurrentProjectPathTable Q.setCurrentProjectPath scratchMain.projectId scratchMain.branchId [] + addCausalHashesToProjectBranches + -- TODO: Add causal hash id to project branch table and migrate existing project branches somehow Q.setSchemaVersion 17 where scratchProjectName = UnsafeProjectName "scratch" scratchBranchName = UnsafeProjectBranchName "main" + withDisabledForeignKeys :: Sqlite.Transaction r -> IO r + withDisabledForeignKeys m = do + let disable = Sqlite.runWriteTransaction conn \run -> run $ Sqlite.execute [Sqlite.sql| PRAGMA foreign_keys=OFF |] + let enable = Sqlite.runWriteTransaction conn \run -> run $ Sqlite.execute [Sqlite.sql| PRAGMA foreign_keys=ON |] + let action = Sqlite.runWriteTransaction conn \run -> run $ m + UnsafeIO.bracket disable (const enable) (const action) + +newtype ForeignKeyFailureException + = ForeignKeyFailureException + -- We leave the data as raw as possible to ensure we can display it properly rather than get decoding errors while + -- trying to display some other error. + [[Sqlite.SQLData]] + deriving stock (Show) + deriving anyclass (Exception) + +addCausalHashesToProjectBranches :: Sqlite.Transaction () +addCausalHashesToProjectBranches = do + -- Create the new version of the project_branch table with the causal_hash_id column. + Sqlite.execute + [Sqlite.sql| +CREATE TABLE new_project_branch ( + project_id uuid NOT NULL REFERENCES project (id), + branch_id uuid NOT NULL, + name text NOT NULL, + causal_hash_id integer NOT NULL REFERENCES causal(self_hash_id), + + primary key (project_id, branch_id), + + unique (project_id, name) +) +without rowid; +|] + rootCausalHashId <- Q.expectNamespaceRoot + rootCh <- Q.expectCausalHash rootCausalHashId + projectsRoot <- Codebase.getShallowCausalAtPathFromRootHash rootCh (Path.singleton $ NameSegment.unsafeParseText "__projects") >>= V2Causal.value + ifor_ (V2Branch.children projectsRoot) \projectIdNS projectsCausal -> do + projectId <- case projectIdNS of + UUIDNameSegment projectIdUUID -> pure $ ProjectId projectIdUUID + _ -> error $ "Invalid Project Id NameSegment:" <> show projectIdNS + projectsBranch <- V2Causal.value projectsCausal + ifor_ (V2Branch.children projectsBranch) \branchIdNS projectBranchCausal -> void . runMaybeT $ do + projectBranchId <- case branchIdNS of + UUIDNameSegment branchIdUUID -> pure $ ProjectBranchId branchIdUUID + _ -> error $ "Invalid Branch Id NameSegment:" <> show branchIdNS + let branchCausalHash = V2Causal.causalHash projectBranchCausal + causalHashId <- lift $ Q.expectCausalHashIdByCausalHash branchCausalHash + ProjectBranch {name = branchName} <- MaybeT $ Q.loadProjectBranch projectId projectBranchId + -- Insert the full project branch with HEAD into the new table + lift $ + Sqlite.execute + [Sqlite.sql| + INSERT INTO new_project_branch (project_id, branch_id, name, causal_hash_id) + VALUES (:projectId, :projectBranchId, :branchName, :causalHashId) + |] + + -- Delete any project branch data that don't have a matching branch in the current root. + -- This is to make sure any old or invalid project branches get cleared out and won't cause problems when we rewrite + -- foreign key references. + -- We have to do this manually since we had to disable foreign key checks to add the new column. + Sqlite.execute + [Sqlite.sql| DELETE FROM project_branch_parent pbp + WHERE NOT EXISTS(SELECT 1 FROM new_project_branch npb WHERE npb.project_id = pbp.project_id AND npb.branch_id = pbp.branch_id) + |] + Sqlite.execute + [Sqlite.sql| DELETE FROM project_branch_remote_mapping pbrp + WHERE NOT EXISTS(SELECT 1 FROM new_project_branch npb WHERE npb.project_id = pbrp.local_project_id AND npb.branch_id = pbrp.local_branch_id) + |] + + -- Drop the old project_branch table and rename the new one to take its place. + Sqlite.execute [Sqlite.sql| DROP TABLE project_branch |] + Sqlite.execute [Sqlite.sql| ALTER TABLE new_project_branch RENAME TO project_branch |] + foreignKeyErrs <- Sqlite.queryListRow [Sqlite.sql| PRAGMA foreign_key_check |] + when (not . null $ foreignKeyErrs) . Sqlite.unsafeIO . UnliftIO.throwIO $ ForeignKeyFailureException foreignKeyErrs + +-- migrateLooseCodeIntoLegacyProject :: Sqlite.Transaction () +-- migrateLooseCodeIntoLegacyProject = do () + +pattern UUIDNameSegment :: UUID -> NameSegment +pattern UUIDNameSegment uuid <- + ( NameSegment.toUnescapedText -> + (Text.uncons -> Just ('_', UUID.fromText . Text.map (\c -> if c == '_' then '-' else c) -> Just uuid)) + ) + where + UUIDNameSegment uuid = + NameSegment (Text.cons '_' (Text.map (\c -> if c == '-' then '_' else c) (UUID.toText uuid))) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index c82e467145..6c2850d6f9 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -95,7 +95,9 @@ createSchema = do Q.addSquashResultTable (_, emptyCausalHashId) <- emptyCausalHash void $ insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId + Q.addProjectBranchCausalHashIdColumn Q.addProjectBranchReflogTable + Q.addProjectBranchCausalHashIdColumn where scratchProjectName = UnsafeProjectName "scratch" scratchBranchName = UnsafeProjectBranchName "main" From c772ebd046f2b506ce32eb205ebf54900abb9798 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 13 Jun 2024 20:44:02 -0400 Subject: [PATCH 167/631] Fix some problems with new macros - #:by-name annotations were inconsistent and eating arguments - Auto-generated builtin links were including "builtin-" in the termlink text --- scheme-libs/racket/unison/boot.ss | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/scheme-libs/racket/unison/boot.ss b/scheme-libs/racket/unison/boot.ss index 64b1342344..e938e68ef8 100644 --- a/scheme-libs/racket/unison/boot.ss +++ b/scheme-libs/racket/unison/boot.ss @@ -118,6 +118,7 @@ (for-syntax racket/set (only-in racket partition flatten split-at) + (only-in racket/string string-prefix?) (only-in racket/syntax format-id)) (rename-in (except-in racket false true unit any) @@ -282,7 +283,7 @@ (syntax/loc loc (define-syntax (name stx) (syntax-case stx () - [(_ #:by-name . bs) + [(_ #:by-name _ . bs) (syntax/loc stx (unison-closure arity name:fast (list . bs)))] [(_ . bs) @@ -306,7 +307,7 @@ (syntax/loc loc (define-syntax (name stx) (syntax-case stx () - [(_ #:by-name . bs) + [(_ #:by-name _ . bs) (syntax/loc stx (unison-closure arity name:fast (list . bs)))] [(_ . bs) @@ -364,7 +365,15 @@ (define-for-syntax (make-link-def gen-link? loc name:stx name:link:stx) - (define name:txt (symbol->string (syntax->datum name:stx))) + (define (chop s) + (if (string-prefix? s "builtin-") + (substring s 8) + s)) + + (define name:txt + (chop + (symbol->string + (syntax->datum name:stx)))) (cond [gen-link? @@ -433,7 +442,7 @@ (syntax-case stx () [(name ([v (f . args)] ...) body ...) (syntax/loc stx - (let ([v (f #:by-name . args)] ...) body ...))])) + (let ([v (f #:by-name #t . args)] ...) body ...))])) ; Wrapper that more closely matches `handle` constructs ; From 119e9c8e78437a8b78adb175b2e6195451380116 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 14 Jun 2024 09:58:53 -0400 Subject: [PATCH 168/631] add query to get direct dependencies of a set of dependents --- .../U/Codebase/Sqlite/Operations.hs | 17 ++ .../U/Codebase/Sqlite/Queries.hs | 195 +++++++++++------- .../U/Codebase/Sqlite/Reference.hs | 8 + codebase2/codebase-sqlite/package.yaml | 2 + .../unison-codebase-sqlite.cabal | 2 + 5 files changed, 150 insertions(+), 74 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index b402620333..d0b9935014 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -63,6 +63,7 @@ module U.Codebase.Sqlite.Operations causalHashesByPrefix, -- ** dependents index + directDependenciesOfScope, dependents, dependentsOfComponent, dependentsWithinScope, @@ -205,6 +206,7 @@ import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.ShortHash (ShortCausalHash (..), ShortNamespaceHash (..)) import Unison.Sqlite +import Unison.Util.Defns (DefnsF) import Unison.Util.List qualified as List import Unison.Util.Map qualified as Map import Unison.Util.Monoid (foldMapM) @@ -1121,6 +1123,21 @@ causalHashesByPrefix (ShortCausalHash b32prefix) = do hashes <- traverse (Q.expectHash . Db.unCausalHashId) hashIds pure $ Set.fromList . map CausalHash $ hashes +directDependenciesOfScope :: + DefnsF Set C.TermReferenceId C.TypeReferenceId -> + Transaction (DefnsF Set C.TermReference C.TypeReference) +directDependenciesOfScope scope0 = do + -- Convert C -> S + scope1 <- bitraverse (Set.traverse c2sReferenceId) (Set.traverse c2sReferenceId) scope0 + + -- Do the query + dependencies0 <- Q.getDirectDependenciesOfScope scope1 + + -- Convert S -> C + dependencies1 <- bitraverse (Set.traverse s2cReference) (Set.traverse s2cReference) dependencies0 + + pure dependencies1 + -- | returns a list of known definitions referencing `r` dependents :: Q.DependentsSelector -> C.Reference -> Transaction (Set C.Reference.Id) dependents selector r = do diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 880d3cdf04..66af3c846a 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -165,6 +165,7 @@ module U.Codebase.Sqlite.Queries getDependenciesForDependent, getDependencyIdsForDependent, getDependenciesBetweenTerms, + getDirectDependenciesOfScope, getDependentsWithinScope, -- ** type index @@ -321,7 +322,7 @@ import U.Codebase.Decl qualified as C import U.Codebase.Decl qualified as C.Decl import U.Codebase.HashTags (BranchHash (..), CausalHash (..), PatchHash (..)) import U.Codebase.Reference (Reference' (..)) -import U.Codebase.Reference qualified as C +import U.Codebase.Reference qualified as C (Reference) import U.Codebase.Reference qualified as C.Reference import U.Codebase.Referent qualified as C.Referent import U.Codebase.Reflog qualified as Reflog @@ -365,10 +366,9 @@ import U.Codebase.Sqlite.Orphans () import U.Codebase.Sqlite.Patch.Format qualified as PatchFormat import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) -import U.Codebase.Sqlite.Reference qualified as Reference -import U.Codebase.Sqlite.Reference qualified as S +import U.Codebase.Sqlite.Reference qualified as S (Reference, ReferenceH, TermReference, TermReferenceId, TextReference, TypeReference, TypeReferenceId) import U.Codebase.Sqlite.Reference qualified as S.Reference -import U.Codebase.Sqlite.Referent qualified as Referent +import U.Codebase.Sqlite.Referent qualified as S (TextReferent) import U.Codebase.Sqlite.Referent qualified as S.Referent import U.Codebase.Sqlite.RemoteProject (RemoteProject (..)) import U.Codebase.Sqlite.RemoteProjectBranch (RemoteProjectBranch) @@ -399,6 +399,7 @@ import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.Sqlite import Unison.Util.Alternative qualified as Alternative +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.FileEmbed (embedProjectStringFile) import Unison.Util.Lens qualified as Lens import Unison.Util.Map qualified as Map @@ -1361,7 +1362,7 @@ setNamespaceRoot id = False -> execute [sql| INSERT INTO namespace_root VALUES (:id) |] True -> execute [sql| UPDATE namespace_root SET causal_id = :id |] -saveWatch :: WatchKind -> Reference.IdH -> ByteString -> Transaction () +saveWatch :: WatchKind -> S.Reference.IdH -> ByteString -> Transaction () saveWatch k r blob = do execute [sql| @@ -1379,7 +1380,7 @@ saveWatch k r blob = do loadWatch :: SqliteExceptionReason e => WatchKind -> - Reference.IdH -> + S.Reference.IdH -> (ByteString -> Either e a) -> Transaction (Maybe a) loadWatch k r check = @@ -1395,7 +1396,7 @@ loadWatch k r check = |] check -loadWatchKindsByReference :: Reference.IdH -> Transaction [WatchKind] +loadWatchKindsByReference :: S.Reference.IdH -> Transaction [WatchKind] loadWatchKindsByReference r = queryListCol [sql| @@ -1407,7 +1408,7 @@ loadWatchKindsByReference r = AND watch.component_index = @ |] -loadWatchesByWatchKind :: WatchKind -> Transaction [Reference.IdH] +loadWatchesByWatchKind :: WatchKind -> Transaction [S.Reference.IdH] loadWatchesByWatchKind k = queryListRow [sql| @@ -1423,7 +1424,7 @@ clearWatches = do execute [sql| DELETE FROM watch |] -- * Index-building -addToTypeIndex :: Reference' TextId HashId -> Referent.Id -> Transaction () +addToTypeIndex :: S.ReferenceH -> S.Referent.Id -> Transaction () addToTypeIndex tp tm = execute [sql| @@ -1438,7 +1439,7 @@ addToTypeIndex tp tm = ON CONFLICT DO NOTHING |] -getReferentsByType :: Reference' TextId HashId -> Transaction [Referent.Id] +getReferentsByType :: S.ReferenceH -> Transaction [S.Referent.Id] getReferentsByType r = queryListRow [sql| @@ -1452,7 +1453,7 @@ getReferentsByType r = AND type_reference_component_index IS @ |] -getTypeReferenceForReferent :: Referent.Id -> Transaction (Reference' TextId HashId) +getTypeReferenceForReferent :: S.Referent.Id -> Transaction S.ReferenceH getTypeReferenceForReferent r = queryOneRow [sql| @@ -1467,7 +1468,7 @@ getTypeReferenceForReferent r = |] -- todo: error if no results -getTypeReferencesForComponent :: ObjectId -> Transaction [(Reference' TextId HashId, Referent.Id)] +getTypeReferencesForComponent :: ObjectId -> Transaction [(S.ReferenceH, S.Referent.Id)] getTypeReferencesForComponent oId = fmap (map fixupTypeIndexRow) $ queryListRow @@ -1553,7 +1554,7 @@ filterTermsByReferenceHavingType typ terms = create *> for_ terms insert *> sele drop = execute [sql|DROP TABLE filter_query|] -addToTypeMentionsIndex :: Reference' TextId HashId -> Referent.Id -> Transaction () +addToTypeMentionsIndex :: S.ReferenceH -> S.Referent.Id -> Transaction () addToTypeMentionsIndex tp tm = execute [sql| @@ -1568,7 +1569,7 @@ addToTypeMentionsIndex tp tm = ON CONFLICT DO NOTHING |] -getReferentsByTypeMention :: Reference' TextId HashId -> Transaction [Referent.Id] +getReferentsByTypeMention :: S.ReferenceH -> Transaction [S.Referent.Id] getReferentsByTypeMention r = queryListRow [sql| @@ -1583,7 +1584,7 @@ getReferentsByTypeMention r = |] -- todo: error if no results -getTypeMentionsReferencesForComponent :: ObjectId -> Transaction [(Reference' TextId HashId, Referent.Id)] +getTypeMentionsReferencesForComponent :: ObjectId -> Transaction [(S.ReferenceH, S.Referent.Id)] getTypeMentionsReferencesForComponent r = fmap (map fixupTypeIndexRow) $ queryListRow @@ -1599,7 +1600,7 @@ getTypeMentionsReferencesForComponent r = WHERE term_referent_object_id IS :r |] -fixupTypeIndexRow :: Reference' TextId HashId :. Referent.Id -> (Reference' TextId HashId, Referent.Id) +fixupTypeIndexRow :: S.ReferenceH :. S.Referent.Id -> (S.ReferenceH, S.Referent.Id) fixupTypeIndexRow (rh :. ri) = (rh, ri) -- | Delete objects without hashes. An object typically *would* have a hash, but (for example) during a migration in which an object's hash @@ -1653,7 +1654,7 @@ garbageCollectWatchesWithoutObjects = do (SELECT hash_object.hash_id FROM hash_object) |] -addToDependentsIndex :: [Reference.Reference] -> Reference.Id -> Transaction () +addToDependentsIndex :: [S.Reference] -> S.Reference.Id -> Transaction () addToDependentsIndex dependencies dependent = for_ dependencies \dependency -> execute @@ -1682,7 +1683,7 @@ data DependentsSelector | ExcludeOwnComponent -- | Get dependents of a dependency. -getDependentsForDependency :: DependentsSelector -> Reference.Reference -> Transaction (Set Reference.Id) +getDependentsForDependency :: DependentsSelector -> S.Reference -> Transaction (Set S.Reference.Id) getDependentsForDependency selector dependency = do dependents <- queryListRow @@ -1699,19 +1700,19 @@ getDependentsForDependency selector dependency = do ExcludeSelf -> filter isNotSelfReference dependents ExcludeOwnComponent -> filter isNotReferenceFromOwnComponent dependents where - isNotReferenceFromOwnComponent :: Reference.Id -> Bool + isNotReferenceFromOwnComponent :: S.Reference.Id -> Bool isNotReferenceFromOwnComponent = case dependency of ReferenceBuiltin _ -> const True ReferenceDerived (C.Reference.Id oid0 _pos0) -> \(C.Reference.Id oid1 _pos1) -> oid0 /= oid1 - isNotSelfReference :: Reference.Id -> Bool + isNotSelfReference :: S.Reference.Id -> Bool isNotSelfReference = case dependency of ReferenceBuiltin _ -> const True ReferenceDerived ref -> (ref /=) -getDependentsForDependencyComponent :: ObjectId -> Transaction [Reference.Id] +getDependentsForDependencyComponent :: ObjectId -> Transaction [S.Reference.Id] getDependentsForDependencyComponent dependency = filter isNotSelfReference <$> queryListRow @@ -1722,12 +1723,12 @@ getDependentsForDependencyComponent dependency = AND dependency_object_id IS :dependency |] where - isNotSelfReference :: Reference.Id -> Bool + isNotSelfReference :: S.Reference.Id -> Bool isNotSelfReference = \case (C.Reference.Id oid1 _pos1) -> dependency /= oid1 -- | Get non-self dependencies of a user-defined dependent. -getDependenciesForDependent :: Reference.Id -> Transaction [Reference.Reference] +getDependenciesForDependent :: S.Reference.Id -> Transaction [S.Reference] getDependenciesForDependent dependent@(C.Reference.Id oid0 _) = fmap (filter isNotSelfReference) $ queryListRow @@ -1738,13 +1739,13 @@ getDependenciesForDependent dependent@(C.Reference.Id oid0 _) = AND dependent_component_index IS @ |] where - isNotSelfReference :: Reference.Reference -> Bool + isNotSelfReference :: S.Reference -> Bool isNotSelfReference = \case ReferenceBuiltin _ -> True ReferenceDerived (C.Reference.Id oid1 _) -> oid0 /= oid1 -- | Get non-self, user-defined dependencies of a user-defined dependent. -getDependencyIdsForDependent :: Reference.Id -> Transaction [Reference.Id] +getDependencyIdsForDependent :: S.Reference.Id -> Transaction [S.Reference.Id] getDependencyIdsForDependent dependent@(C.Reference.Id oid0 _) = fmap (filter isNotSelfReference) $ queryListRow @@ -1756,7 +1757,7 @@ getDependencyIdsForDependent dependent@(C.Reference.Id oid0 _) = AND dependent_component_index = @ |] where - isNotSelfReference :: Reference.Id -> Bool + isNotSelfReference :: S.Reference.Id -> Bool isNotSelfReference (C.Reference.Id oid1 _) = oid0 /= oid1 @@ -1869,21 +1870,54 @@ getDependenciesBetweenTerms oid1 oid2 = WHERE path_elem IS NOT null |] +-- Mitchell says: why are we enabling and disabling ormolu all over this file? Let's just enable. But right now I'm only +-- adding this one query and don't want a big diff in my PR. + +{- ORMOLU_ENABLE -} + +getDirectDependenciesOfScope :: + DefnsF Set S.TermReferenceId S.TypeReferenceId -> + Transaction (DefnsF Set S.TermReference S.TypeReference) +getDirectDependenciesOfScope scope = do + let tempTableName = [sql| temp_dependents |] + + -- Populate a temporary table with all of the references in `scope` + createTemporaryTableOfReferenceIds tempTableName (Set.union scope.terms scope.types) + + -- Get their direct dependencies (tagged with object type) + dependencies0 <- + queryListRow @(S.Reference :. Only ObjectType) + [sql| + SELECT d.dependency_builtin, d.dependency_object_id, d.dependency_component_index, o.type_id + FROM dependents_index d + JOIN object o ON d.dependency_object_id = o.id + WHERE (d.dependent_object_id, d.dependent_component_index) IN ( + SELECT object_id, component_index + FROM $tempTableName + ) + |] + + -- Post-process the query result + let dependencies1 = + List.foldl' + ( \deps -> \case + dep :. Only TermComponent -> Defns (Set.insert dep deps.terms) deps.types + dep :. Only DeclComponent -> Defns deps.terms (Set.insert dep deps.types) + _ -> deps -- impossible; could error here + ) + (Defns Set.empty Set.empty) + dependencies0 + + pure dependencies1 + +{- ORMOLU_DISABLE -} + -- | `getDependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` (not -- including `query` itself). Each dependent is also tagged with whether it is a term or decl. -getDependentsWithinScope :: Set Reference.Id -> Set S.Reference -> Transaction (Map Reference.Id ObjectType) +getDependentsWithinScope :: Set S.Reference.Id -> Set S.Reference -> Transaction (Map S.Reference.Id ObjectType) getDependentsWithinScope scope query = do -- Populate a temporary table with all of the references in `scope` - execute - [sql| - CREATE TEMPORARY TABLE dependents_search_scope ( - dependent_object_id INTEGER NOT NULL, - dependent_component_index INTEGER NOT NULL, - PRIMARY KEY (dependent_object_id, dependent_component_index) - ) - |] - for_ scope \r -> - execute [sql|INSERT INTO dependents_search_scope VALUES (@r, @)|] + createTemporaryTableOfReferenceIds [sql| dependents_search_scope |] scope -- Populate a temporary table with all of the references in `query` execute @@ -1917,7 +1951,7 @@ getDependentsWithinScope scope query = do -- We use `UNION` rather than `UNION ALL` so as to not track down the transitive dependents of any particular -- reference more than once. - result :: [Reference.Id :. Only ObjectType] <- queryListRow [sql| + result :: [S.Reference.Id :. Only ObjectType] <- queryListRow [sql| WITH RECURSIVE transitive_dependents (dependent_object_id, dependent_component_index, type_id) AS ( SELECT d.dependent_object_id, d.dependent_component_index, object.type_id FROM dependents_index d @@ -1927,8 +1961,8 @@ getDependentsWithinScope scope query = do AND q.dependency_object_id IS d.dependency_object_id AND q.dependency_component_index IS d.dependency_component_index JOIN dependents_search_scope s - ON s.dependent_object_id = d.dependent_object_id - AND s.dependent_component_index = d.dependent_component_index + ON s.object_id = d.dependent_object_id + AND s.component_index = d.dependent_component_index UNION SELECT d.dependent_object_id, d.dependent_component_index, object.type_id FROM dependents_index d @@ -1937,15 +1971,28 @@ getDependentsWithinScope scope query = do ON t.dependent_object_id = d.dependency_object_id AND t.dependent_component_index = d.dependency_component_index JOIN dependents_search_scope s - ON s.dependent_object_id = d.dependent_object_id - AND s.dependent_component_index = d.dependent_component_index + ON s.object_id = d.dependent_object_id + AND s.component_index = d.dependent_component_index ) SELECT * FROM transitive_dependents |] - execute [sql|DROP TABLE dependents_search_scope|] - execute [sql|DROP TABLE dependencies_query|] + execute [sql| DROP TABLE dependents_search_scope |] + execute [sql| DROP TABLE dependencies_query |] pure . Map.fromList $ [(r, t) | r :. Only t <- result] +createTemporaryTableOfReferenceIds :: Sql -> Set S.Reference.Id -> Transaction () +createTemporaryTableOfReferenceIds tableName refs = do + execute + [sql| + CREATE TEMPORARY TABLE $tableName ( + object_id INTEGER NOT NULL, + component_index INTEGER NOT NULL, + PRIMARY KEY (object_id, component_index) + ) + |] + for_ refs \ref -> + execute [sql| INSERT INTO $tableName VALUES (@ref, @) |] + objectIdByBase32Prefix :: ObjectType -> Text -> Transaction [ObjectId] objectIdByBase32Prefix objType prefix = queryListCol @@ -2086,7 +2133,7 @@ deleteNameLookupsExceptFor hashIds = do |] -- | Insert the given set of term names into the name lookup table -insertScopedTermNames :: BranchHashId -> [NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)] -> Transaction () +insertScopedTermNames :: BranchHashId -> [NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType)] -> Transaction () insertScopedTermNames bhId = do traverse_ \name0 -> do let name = NamedRef.ScopedRow (refToRow <$> name0) @@ -2106,11 +2153,11 @@ insertScopedTermNames bhId = do VALUES (:bhId, @name, @, @, @, @, @, @, @) |] where - refToRow :: (Referent.TextReferent, Maybe NamedRef.ConstructorType) -> (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType)) + refToRow :: (S.TextReferent, Maybe NamedRef.ConstructorType) -> (S.TextReferent :. Only (Maybe NamedRef.ConstructorType)) refToRow (ref, ct) = ref :. Only ct -- | Insert the given set of type names into the name lookup table -insertScopedTypeNames :: BranchHashId -> [NamedRef Reference.TextReference] -> Transaction () +insertScopedTypeNames :: BranchHashId -> [NamedRef S.TextReference] -> Transaction () insertScopedTypeNames bhId = traverse_ \name0 -> do let name = NamedRef.ScopedRow name0 @@ -2129,7 +2176,7 @@ insertScopedTypeNames bhId = |] -- | Remove the given set of term names into the name lookup table -removeScopedTermNames :: BranchHashId -> [NamedRef Referent.TextReferent] -> Transaction () +removeScopedTermNames :: BranchHashId -> [NamedRef S.TextReferent] -> Transaction () removeScopedTermNames bhId names = do for_ names \name -> execute @@ -2144,7 +2191,7 @@ removeScopedTermNames bhId names = do |] -- | Remove the given set of term names into the name lookup table -removeScopedTypeNames :: BranchHashId -> [NamedRef Reference.TextReference] -> Transaction () +removeScopedTypeNames :: BranchHashId -> [NamedRef S.TextReference] -> Transaction () removeScopedTypeNames bhId names = do for_ names \name -> execute @@ -2203,9 +2250,9 @@ likeEscape escapeChar pat = -- -- Get the list of a term names in the provided name lookup and relative namespace. -- Includes dependencies, but not transitive dependencies. -termNamesWithinNamespace :: BranchHashId -> PathSegments -> Transaction [NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)] +termNamesWithinNamespace :: BranchHashId -> PathSegments -> Transaction [NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType)] termNamesWithinNamespace bhId namespace = do - results :: [NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- + results :: [NamedRef (S.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- queryListRow [sql| SELECT reversed_name, referent_builtin, referent_component_hash, referent_component_index, referent_constructor_index, referent_constructor_type @@ -2236,7 +2283,7 @@ termNamesWithinNamespace bhId namespace = do -- -- Get the list of a type names in the provided name lookup and relative namespace. -- Includes dependencies, but not transitive dependencies. -typeNamesWithinNamespace :: BranchHashId -> PathSegments -> Transaction [NamedRef Reference.TextReference] +typeNamesWithinNamespace :: BranchHashId -> PathSegments -> Transaction [NamedRef S.TextReference] typeNamesWithinNamespace bhId namespace = queryListRow [sql| @@ -2265,13 +2312,13 @@ typeNamesWithinNamespace bhId namespace = -- is only true on Share. -- -- Get the list of term names within a given namespace which have the given suffix. -termNamesBySuffix :: BranchHashId -> PathSegments -> ReversedName -> Transaction [NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)] +termNamesBySuffix :: BranchHashId -> PathSegments -> ReversedName -> Transaction [NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType)] termNamesBySuffix bhId namespaceRoot suffix = do Debug.debugM Debug.Server "termNamesBySuffix" (namespaceRoot, suffix) let namespaceGlob = toNamespaceGlob namespaceRoot let lastSegment = NonEmpty.head . into @(NonEmpty Text) $ suffix let reversedNameGlob = toSuffixGlob suffix - results :: [NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- + results :: [NamedRef (S.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- -- Note: It may seem strange that we do a last_name_segment constraint AND a reversed_name -- GLOB, but this helps improve query performance. -- The SQLite query optimizer is smart enough to do a prefix-search on globs, but will @@ -2304,7 +2351,7 @@ termNamesBySuffix bhId namespaceRoot suffix = do -- is only true on Share. -- -- Get the list of type names within a given namespace which have the given suffix. -typeNamesBySuffix :: BranchHashId -> PathSegments -> ReversedName -> Transaction [NamedRef Reference.TextReference] +typeNamesBySuffix :: BranchHashId -> PathSegments -> ReversedName -> Transaction [NamedRef S.TextReference] typeNamesBySuffix bhId namespaceRoot suffix = do Debug.debugM Debug.Server "typeNamesBySuffix" (namespaceRoot, suffix) let namespaceGlob = toNamespaceGlob namespaceRoot @@ -2343,10 +2390,10 @@ typeNamesBySuffix bhId namespaceRoot suffix = do -- id. It's the caller's job to select the correct name lookup for your exact name. -- -- See termRefsForExactName in U.Codebase.Sqlite.Operations -termRefsForExactName :: BranchHashId -> ReversedName -> Transaction [NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)] +termRefsForExactName :: BranchHashId -> ReversedName -> Transaction [NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType)] termRefsForExactName bhId reversedSegments = do let reversedName = toReversedName reversedSegments - results :: [NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- + results :: [NamedRef (S.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- queryListRow [sql| SELECT reversed_name, referent_builtin, referent_component_hash, referent_component_index, referent_constructor_index, referent_constructor_type @@ -2366,7 +2413,7 @@ termRefsForExactName bhId reversedSegments = do -- id. It's the caller's job to select the correct name lookup for your exact name. -- -- See termRefsForExactName in U.Codebase.Sqlite.Operations -typeRefsForExactName :: BranchHashId -> ReversedName -> Transaction [NamedRef Reference.TextReference] +typeRefsForExactName :: BranchHashId -> ReversedName -> Transaction [NamedRef S.TextReference] typeRefsForExactName bhId reversedSegments = do let reversedName = toReversedName reversedSegments queryListRow @@ -2382,7 +2429,7 @@ typeRefsForExactName bhId reversedSegments = do -- -- Get the list of term names for a given Referent within a given namespace. -- Considers one level of dependencies, but not transitive dependencies. -termNamesForRefWithinNamespace :: BranchHashId -> PathSegments -> Referent.TextReferent -> Maybe ReversedName -> Transaction [ReversedName] +termNamesForRefWithinNamespace :: BranchHashId -> PathSegments -> S.TextReferent -> Maybe ReversedName -> Transaction [ReversedName] termNamesForRefWithinNamespace bhId namespaceRoot ref maySuffix = do let namespaceGlob = toNamespaceGlob namespaceRoot let suffixGlob = case maySuffix of @@ -2431,7 +2478,7 @@ termNamesForRefWithinNamespace bhId namespaceRoot ref maySuffix = do -- -- Get the list of type names for a given Reference within a given namespace. -- Considers one level of dependencies, but not transitive dependencies. -typeNamesForRefWithinNamespace :: BranchHashId -> PathSegments -> Reference.TextReference -> Maybe ReversedName -> Transaction [ReversedName] +typeNamesForRefWithinNamespace :: BranchHashId -> PathSegments -> S.TextReference -> Maybe ReversedName -> Transaction [ReversedName] typeNamesForRefWithinNamespace bhId namespaceRoot ref maySuffix = do let namespaceGlob = toNamespaceGlob namespaceRoot let suffixGlob = case maySuffix of @@ -2511,7 +2558,7 @@ transitiveDependenciesSql rootBranchHashId = -- Note: this returns the first name it finds by searching in order of: -- Names in the current namespace, then names in the current namespace's dependencies, then -- through the current namespace's dependencies' dependencies, etc. -recursiveTermNameSearch :: BranchHashId -> Referent.TextReferent -> Transaction (Maybe ReversedName) +recursiveTermNameSearch :: BranchHashId -> S.TextReferent -> Transaction (Maybe ReversedName) recursiveTermNameSearch bhId ref = do queryMaybeColCheck [sql| @@ -2548,7 +2595,7 @@ recursiveTermNameSearch bhId ref = do -- Note: this returns the first name it finds by searching in order of: -- Names in the current namespace, then names in the current namespace's dependencies, then -- through the current namespace's dependencies' dependencies, etc. -recursiveTypeNameSearch :: BranchHashId -> Reference.TextReference -> Transaction (Maybe ReversedName) +recursiveTypeNameSearch :: BranchHashId -> S.TextReference -> Transaction (Maybe ReversedName) recursiveTypeNameSearch bhId ref = do queryMaybeColCheck [sql| @@ -2589,13 +2636,13 @@ recursiveTypeNameSearch bhId ref = do -- the longest matching suffix. -- -- Considers one level of dependencies, but not transitive dependencies. -longestMatchingTermNameForSuffixification :: BranchHashId -> PathSegments -> NamedRef Referent.TextReferent -> Transaction (Maybe (NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType))) +longestMatchingTermNameForSuffixification :: BranchHashId -> PathSegments -> NamedRef S.TextReferent -> Transaction (Maybe (NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType))) longestMatchingTermNameForSuffixification bhId namespaceRoot (NamedRef.NamedRef {reversedSegments = revSuffix@(ReversedName (lastSegment NonEmpty.:| _)), ref}) = do let namespaceGlob = toNamespaceGlob namespaceRoot <> ".*" - let loop :: [Text] -> MaybeT Transaction (NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)) + let loop :: [Text] -> MaybeT Transaction (NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType)) loop [] = empty loop (suffGlob : rest) = do - result :: Maybe (NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType))) <- + result :: Maybe (NamedRef (S.TextReferent :. Only (Maybe NamedRef.ConstructorType))) <- lift $ queryMaybeRow -- Note: It may seem strange that we do a last_name_segment constraint AND a reversed_name @@ -2664,13 +2711,13 @@ longestMatchingTermNameForSuffixification bhId namespaceRoot (NamedRef.NamedRef -- the longest matching suffix. -- -- Considers one level of dependencies, but not transitive dependencies. -longestMatchingTypeNameForSuffixification :: BranchHashId -> PathSegments -> NamedRef Reference.TextReference -> Transaction (Maybe (NamedRef Reference.TextReference)) +longestMatchingTypeNameForSuffixification :: BranchHashId -> PathSegments -> NamedRef S.TextReference -> Transaction (Maybe (NamedRef S.TextReference)) longestMatchingTypeNameForSuffixification bhId namespaceRoot (NamedRef.NamedRef {reversedSegments = revSuffix@(ReversedName (lastSegment NonEmpty.:| _)), ref}) = do let namespaceGlob = toNamespaceGlob namespaceRoot <> ".*" - let loop :: [Text] -> MaybeT Transaction (NamedRef Reference.TextReference) + let loop :: [Text] -> MaybeT Transaction (NamedRef S.TextReference) loop [] = empty loop (suffGlob : rest) = do - result :: Maybe (NamedRef (Reference.TextReference)) <- + result :: Maybe (NamedRef (S.TextReference)) <- lift $ queryMaybeRow -- Note: It may seem strange that we do a last_name_segment constraint AND a reversed_name @@ -3036,12 +3083,12 @@ saveTermComponent hh@HashHandle {toReference, toReferenceMentions} maybeEncodedT tpRefs' = Foldable.toList $ C.Type.dependencies tp getTermSRef :: S.Term.TermRef -> S.Reference getTermSRef = \case - C.ReferenceBuiltin t -> C.ReferenceBuiltin (tIds Vector.! fromIntegral t) + ReferenceBuiltin t -> ReferenceBuiltin (tIds Vector.! fromIntegral t) C.Reference.Derived Nothing i -> C.Reference.Derived oId i -- index self-references C.Reference.Derived (Just h) i -> C.Reference.Derived (oIds Vector.! fromIntegral h) i getTypeSRef :: S.Term.TypeRef -> S.Reference getTypeSRef = \case - C.ReferenceBuiltin t -> C.ReferenceBuiltin (tIds Vector.! fromIntegral t) + ReferenceBuiltin t -> ReferenceBuiltin (tIds Vector.! fromIntegral t) C.Reference.Derived h i -> C.Reference.Derived (oIds Vector.! fromIntegral h) i getSTypeLink = getTypeSRef getSTermLink :: S.Term.TermLink -> S.Reference @@ -3096,7 +3143,7 @@ saveDeclComponent hh@HashHandle {toReferenceDecl, toReferenceDeclMentions} maybe dependencies :: Set S.Decl.TypeRef = C.Decl.dependencies decl getSRef :: C.Reference.Reference' LocalTextId (Maybe LocalDefnId) -> S.Reference.Reference getSRef = \case - C.ReferenceBuiltin t -> C.ReferenceBuiltin (tIds Vector.! fromIntegral t) + ReferenceBuiltin t -> ReferenceBuiltin (tIds Vector.! fromIntegral t) C.Reference.Derived Nothing i -> C.Reference.Derived oId i -- index self-references C.Reference.Derived (Just h) i -> C.Reference.Derived (oIds Vector.! fromIntegral h) i in (Set.map getSRef dependencies, self) @@ -4144,7 +4191,7 @@ loadMostRecentBranch projectId = -- | Searches for all names within the given name lookup which contain the provided list of segments -- in order. -- Search is case insensitive. -fuzzySearchTerms :: Bool -> BranchHashId -> Int -> PathSegments -> [Text] -> Transaction [(NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType))] +fuzzySearchTerms :: Bool -> BranchHashId -> Int -> PathSegments -> [Text] -> Transaction [(NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType))] fuzzySearchTerms includeDependencies bhId limit namespace querySegments = do -- Union in the dependencies if required. let dependenciesSql = @@ -4179,14 +4226,14 @@ fuzzySearchTerms includeDependencies bhId limit namespace querySegments = do where namespaceGlob = toNamespaceGlob namespace preparedQuery = prepareFuzzyQuery '\\' querySegments - unRow :: NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType)) -> NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType) + unRow :: NamedRef (S.TextReferent :. Only (Maybe NamedRef.ConstructorType)) -> NamedRef (S.TextReferent, Maybe NamedRef.ConstructorType) unRow = fmap \(a :. Only b) -> (a, b) -- | Searches for all names within the given name lookup which contain the provided list of segments -- in order. -- -- Search is case insensitive. -fuzzySearchTypes :: Bool -> BranchHashId -> Int -> PathSegments -> [Text] -> Transaction [(NamedRef Reference.TextReference)] +fuzzySearchTypes :: Bool -> BranchHashId -> Int -> PathSegments -> [Text] -> Transaction [(NamedRef S.TextReference)] fuzzySearchTypes includeDependencies bhId limit namespace querySegments = do -- Union in the dependencies if required. let dependenciesSql = diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Reference.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Reference.hs index ca228f83d1..7c45dbc97d 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Reference.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Reference.hs @@ -14,12 +14,20 @@ import Unison.Sqlite (FromField, FromRow (fromRow), Only (..), RowParser, SQLDat type Reference = Reference' TextId ObjectId +type TermReference = Reference + +type TypeReference = Reference + -- | The name lookup table uses this because normalizing/denormalizing hashes to ids is slower -- than we'd like when writing/reading the entire name lookup table. type TextReference = Reference' Text Base32Hex type Id = Id' ObjectId +type TermReferenceId = Id + +type TypeReferenceId = Id + type LocalReferenceH = Reference' LocalTextId LocalHashId type LocalReference = Reference' LocalTextId LocalDefnId diff --git a/codebase2/codebase-sqlite/package.yaml b/codebase2/codebase-sqlite/package.yaml index a04fce3a56..bf0bed4ee4 100644 --- a/codebase2/codebase-sqlite/package.yaml +++ b/codebase2/codebase-sqlite/package.yaml @@ -39,6 +39,7 @@ dependencies: - unison-util-base32hex - unison-util-cache - unison-util-file-embed + - unison-util-nametree - unison-util-serialization - unison-util-term - unliftio @@ -71,6 +72,7 @@ default-extensions: - MultiParamTypeClasses - NamedFieldPuns - OverloadedLabels + - OverloadedRecordDot - OverloadedStrings - PatternSynonyms - QuasiQuotes diff --git a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal index ac1f606921..b91e2a51a1 100644 --- a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal +++ b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal @@ -91,6 +91,7 @@ library MultiParamTypeClasses NamedFieldPuns OverloadedLabels + OverloadedRecordDot OverloadedStrings PatternSynonyms QuasiQuotes @@ -132,6 +133,7 @@ library , unison-util-base32hex , unison-util-cache , unison-util-file-embed + , unison-util-nametree , unison-util-serialization , unison-util-term , unliftio From 6c115761c57ed9ce1770d5f33e52f010476c4a36 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 14 Jun 2024 14:55:32 -0700 Subject: [PATCH 169/631] Split migrations into separate transactions --- .../Codebase/SqliteCodebase/Migrations.hs | 93 ++++++++++--------- 1 file changed, 48 insertions(+), 45 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 39026c7f36..dcb7cb59f5 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -36,20 +36,20 @@ import Unison.Prelude import Unison.Sqlite qualified as Sqlite import Unison.Sqlite.Connection qualified as Sqlite.Connection import Unison.Util.Monoid (foldMapM) -import Unison.Util.Monoid qualified as Monoid import Unison.Util.Pretty qualified as Pretty import UnliftIO qualified -- | Mapping from schema version to the migration required to get there. -- E.g. The migration at index 2 must be run on a codebase at version 1. migrations :: + (MVar Region.ConsoleRegion) -> -- | A 'getDeclType'-like lookup, possibly backed by a cache. (C.Reference.Reference -> Sqlite.Transaction CT.ConstructorType) -> TVar (Map Hash Ops2.TermBufferEntry) -> TVar (Map Hash Ops2.DeclBufferEntry) -> CodebasePath -> Map SchemaVersion (Sqlite.Connection -> IO ()) -migrations getDeclType termBuffer declBuffer rootCodebasePath = +migrations regionVar getDeclType termBuffer declBuffer rootCodebasePath = Map.fromList [ (2, runT $ migrateSchema1To2 getDeclType termBuffer declBuffer), -- The 1 to 2 migration kept around hash objects of hash version 1, unfortunately this @@ -68,11 +68,11 @@ migrations getDeclType termBuffer declBuffer rootCodebasePath = -- This migration drops all the v1 hash objects to avoid this issue, since these hash objects -- weren't being used for anything anyways. sqlMigration 3 (Q.removeHashObjectsByHashingVersion (HashVersion 1)), - (4, runT migrateSchema3To4), + (4, runT (migrateSchema3To4 *> runIntegrityChecks regionVar)), -- The 4 to 5 migration adds initial support for out-of-order sync i.e. Unison Share sqlMigration 5 Q.addTempEntityTables, (6, runT $ migrateSchema5To6 rootCodebasePath), - (7, runT migrateSchema6To7), + (7, runT (migrateSchema6To7 *> runIntegrityChecks regionVar)), (8, runT migrateSchema7To8), -- Recreates the name lookup tables because the primary key was missing the root hash id. sqlMigration 9 Q.fixScopedNameLookupTables, @@ -145,7 +145,7 @@ ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer sh Region.displayConsoleRegions do (`UnliftIO.finally` finalizeRegion) do - let migs = migrations getDeclType termBuffer declBuffer root + let migs = migrations regionVar getDeclType termBuffer declBuffer root -- The highest schema that this ucm knows how to migrate to. let highestKnownSchemaVersion = fst . head $ Map.toDescList migs currentSchemaVersion <- Sqlite.runTransaction conn Q.schemaVersion @@ -154,11 +154,10 @@ ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer sh when shouldPrompt do putStrLn "Press to start the migration once all other ucm processes are shutdown..." void $ liftIO getLine - ranMigrations <- - Sqlite.runWriteTransaction conn \run -> do + ranMigrations <- do + currentSchemaVersion <- Sqlite.runTransaction conn $ do -- Get the schema version again now that we're in a transaction. - currentSchemaVersion <- run Q.schemaVersion - let migrationsToRun = Map.filterWithKey (\v _ -> v > currentSchemaVersion) migs + Q.schemaVersion -- This is a bit of a hack, hopefully we can remove this when we have a more -- reliable way to freeze old migration code in time. -- The problem is that 'saveObject' has been changed to flush temp entity tables, @@ -168,42 +167,15 @@ ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer sh -- -- Hopefully we can remove this once we've got better methods of freezing migration -- code in time. - when (currentSchemaVersion < 5) $ run Q.addTempEntityTables - when (currentSchemaVersion < 6) $ run Q.addNamespaceStatsTables - for_ (Map.toAscList migrationsToRun) $ \(SchemaVersion v, migration) -> do - putStrLn $ "🔨 Migrating codebase to version " <> show v <> "..." - run migration - let ranMigrations = not (null migrationsToRun) - when ranMigrations do - region <- - UnliftIO.mask_ do - region <- Region.openConsoleRegion Region.Linear - putMVar regionVar region - pure region - result <- do - -- Ideally we'd check everything here, but certain codebases are known to have objects - -- with missing Hash Objects, we'll want to clean that up in a future migration. - -- integrityCheckAllHashObjects, - let checks = - Monoid.whenM - (currentSchemaVersion < 7) -- Only certain migrations actually make changes which reasonably need to be checked - [ integrityCheckAllBranches, - integrityCheckAllCausals - ] - - zip [(1 :: Int) ..] checks & foldMapM \(i, check) -> do - Region.setConsoleRegion - region - (Text.pack (printf "🕵️ Checking codebase integrity (step %d of %d)..." i (length checks))) - run check - case result of - NoIntegrityErrors -> pure () - IntegrityErrorDetected errs -> do - let msg = prettyPrintIntegrityErrors errs - let rendered = Pretty.toPlain 80 (Pretty.border 2 msg) - Region.setConsoleRegion region (Text.pack rendered) - run (abortMigration "Codebase integrity error detected.") - pure ranMigrations + when (currentSchemaVersion < 5) Q.addTempEntityTables + when (currentSchemaVersion < 6) Q.addNamespaceStatsTables + pure currentSchemaVersion + let migrationsToRun = Map.filterWithKey (\v _ -> v > currentSchemaVersion) migs + for_ (Map.toAscList migrationsToRun) $ \(SchemaVersion v, migration) -> do + putStrLn $ "🔨 Migrating codebase to version " <> show v <> "..." + migration conn + let ranMigrations = not (null migrationsToRun) + pure ranMigrations when ranMigrations do region <- readMVar regionVar -- Vacuum once now that any migrations have taken place. @@ -229,3 +201,34 @@ backupCodebaseIfNecessary backupStrategy localOrRemote conn currentSchemaVersion Sqlite.trySetJournalMode backupConn Sqlite.JournalMode'WAL putStrLn ("📋 I backed up your codebase to " ++ (root backupPath)) putStrLn "⚠️ Please close all other ucm processes and wait for the migration to complete before interacting with your codebase." + +runIntegrityChecks :: + (MVar Region.ConsoleRegion) -> + Sqlite.Transaction () +runIntegrityChecks regionVar = do + region <- Sqlite.unsafeIO . UnliftIO.mask_ $ do + region <- Region.openConsoleRegion Region.Linear + putMVar regionVar region + pure region + result <- do + -- Ideally we'd check everything here, but certain codebases are known to have objects + -- with missing Hash Objects, we'll want to clean that up in a future migration. + -- integrityCheckAllHashObjects, + let checks = + [ integrityCheckAllBranches, + integrityCheckAllCausals + ] + + zip [(1 :: Int) ..] checks & foldMapM \(i, check) -> do + Sqlite.unsafeIO $ + Region.setConsoleRegion + region + (Text.pack (printf "🕵️ Checking codebase integrity (step %d of %d)..." i (length checks))) + check + case result of + NoIntegrityErrors -> pure () + IntegrityErrorDetected errs -> do + let msg = prettyPrintIntegrityErrors errs + let rendered = Pretty.toPlain 80 (Pretty.border 2 msg) + Sqlite.unsafeIO $ Region.setConsoleRegion region (Text.pack rendered) + (abortMigration "Codebase integrity error detected.") From ff2c270fcf750d94ec7cddfc7236b9d7edca3c40 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 14 Jun 2024 15:41:50 -0700 Subject: [PATCH 170/631] Fix up a buncha sql --- .../U/Codebase/Sqlite/Queries.hs | 4 +- .../012-add-current-project-path-table.sql | 7 ++- .../013-add-project-branch-reflog-table.sql | 6 +-- .../Migrations/MigrateSchema16To17.hs | 50 ++++++++++++------- 4 files changed, 42 insertions(+), 25 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index f12053d7d4..89d4839421 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -4343,10 +4343,10 @@ setCurrentProjectPath :: Transaction () setCurrentProjectPath projId branchId path = do execute - [sql| TRUNCATE TABLE current_project_path |] + [sql| DELETE FROM current_project_path |] execute [sql| - INSERT INTO most_recent_namespace(project_id, branch_id, path) + INSERT INTO current_project_path(project_id, branch_id, path) VALUES (:projId, :branchId, :jsonPath) |] where diff --git a/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql b/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql index 5a511a4394..b00290be50 100644 --- a/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql +++ b/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql @@ -4,7 +4,10 @@ CREATE TABLE current_project_path ( project_id INTEGER NOT NULL REFERENCES project (id), branch_id INTEGER NOT NULL REFERENCES project_branch (id), -- A json array like ["foo", "bar"]; the root namespace is represented by the empty array - path TEXT PRIMARY KEY NOT NULL + path TEXT PRIMARY KEY NOT NULL, + + foreign key (project_id, branch_id) + references project_branch (project_id, branch_id), ) WITHOUT ROWID; -DROP TABLE "most_recent_namespace"; +DROP TABLE most_recent_namespace; diff --git a/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql b/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql index d5c66031ae..589ed1812f 100644 --- a/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql +++ b/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql @@ -10,17 +10,17 @@ CREATE TABLE project_branch_reflog ( to_root_causal_id INTEGER NOT NULL REFERENCES causal(self_hash_id), reason TEXT NOT NULL, - foreign key (project_id, branch_id) + foreign key (project_id, project_branch_id) references project_branch (project_id, branch_id) on delete cascade ); -CREATE INDEX project_branch_reflog_by_time ON reflog ( +CREATE INDEX project_branch_reflog_by_time ON project_branch_reflog ( project_branch_id, time DESC ); -CREATE INDEX project_reflog_by_time ON reflog ( +CREATE INDEX project_reflog_by_time ON project_branch_reflog ( project_id, time DESC ); diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs index 31a7e63661..674466212f 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs @@ -4,6 +4,7 @@ module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 (migrateSchema16To17) where import Control.Lens +import Data.Map qualified as Map import Data.Text qualified as Text import Data.UUID (UUID) import Data.UUID qualified as UUID @@ -36,6 +37,8 @@ import UnliftIO qualified as UnsafeIO migrateSchema16To17 :: Sqlite.Connection -> IO () migrateSchema16To17 conn = withDisabledForeignKeys $ do Q.expectSchemaVersion 16 + Q.addProjectBranchReflogTable + addCausalHashesToProjectBranches scratchMain <- Q.loadProjectBranchByNames scratchProjectName scratchBranchName >>= \case Just pb -> pure pb @@ -45,8 +48,6 @@ migrateSchema16To17 conn = withDisabledForeignKeys $ do pure pb Q.addCurrentProjectPathTable Q.setCurrentProjectPath scratchMain.projectId scratchMain.branchId [] - addCausalHashesToProjectBranches - -- TODO: Add causal hash id to project branch table and migrate existing project branches somehow Q.setSchemaVersion 17 where scratchProjectName = UnsafeProjectName "scratch" @@ -91,31 +92,44 @@ without rowid; UUIDNameSegment projectIdUUID -> pure $ ProjectId projectIdUUID _ -> error $ "Invalid Project Id NameSegment:" <> show projectIdNS projectsBranch <- V2Causal.value projectsCausal - ifor_ (V2Branch.children projectsBranch) \branchIdNS projectBranchCausal -> void . runMaybeT $ do - projectBranchId <- case branchIdNS of - UUIDNameSegment branchIdUUID -> pure $ ProjectBranchId branchIdUUID - _ -> error $ "Invalid Branch Id NameSegment:" <> show branchIdNS - let branchCausalHash = V2Causal.causalHash projectBranchCausal - causalHashId <- lift $ Q.expectCausalHashIdByCausalHash branchCausalHash - ProjectBranch {name = branchName} <- MaybeT $ Q.loadProjectBranch projectId projectBranchId - -- Insert the full project branch with HEAD into the new table - lift $ - Sqlite.execute - [Sqlite.sql| - INSERT INTO new_project_branch (project_id, branch_id, name, causal_hash_id) - VALUES (:projectId, :projectBranchId, :branchName, :causalHashId) - |] + case (Map.lookup (NameSegment.unsafeParseText "branches") $ V2Branch.children projectsBranch) of + Nothing -> pure () + Just branchesCausal -> do + branchesBranch <- V2Causal.value branchesCausal + ifor_ (V2Branch.children branchesBranch) \branchIdNS projectBranchCausal -> void . runMaybeT $ do + projectBranchId <- case branchIdNS of + UUIDNameSegment branchIdUUID -> pure $ ProjectBranchId branchIdUUID + _ -> error $ "Invalid Branch Id NameSegment:" <> show branchIdNS + let branchCausalHash = V2Causal.causalHash projectBranchCausal + causalHashId <- lift $ Q.expectCausalHashIdByCausalHash branchCausalHash + branchName <- + MaybeT $ + Sqlite.queryMaybeCol @ProjectBranchName + [Sqlite.sql| + SELECT project_branch.name + FROM project_branch + WHERE + project_branch.project_id = :projectId + AND project_branch.branch_id = :projectBranchId + |] + -- Insert the full project branch with HEAD into the new table + lift $ + Sqlite.execute + [Sqlite.sql| + INSERT INTO new_project_branch (project_id, branch_id, name, causal_hash_id) + VALUES (:projectId, :projectBranchId, :branchName, :causalHashId) + |] -- Delete any project branch data that don't have a matching branch in the current root. -- This is to make sure any old or invalid project branches get cleared out and won't cause problems when we rewrite -- foreign key references. -- We have to do this manually since we had to disable foreign key checks to add the new column. Sqlite.execute - [Sqlite.sql| DELETE FROM project_branch_parent pbp + [Sqlite.sql| DELETE FROM project_branch_parent AS pbp WHERE NOT EXISTS(SELECT 1 FROM new_project_branch npb WHERE npb.project_id = pbp.project_id AND npb.branch_id = pbp.branch_id) |] Sqlite.execute - [Sqlite.sql| DELETE FROM project_branch_remote_mapping pbrp + [Sqlite.sql| DELETE FROM project_branch_remote_mapping AS pbrp WHERE NOT EXISTS(SELECT 1 FROM new_project_branch npb WHERE npb.project_id = pbrp.local_project_id AND npb.branch_id = pbrp.local_branch_id) |] From f192edbed4feba5572aa235a2902366864218566 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 14 Jun 2024 16:42:58 -0700 Subject: [PATCH 171/631] Fix up migration quirks --- .../U/Codebase/Sqlite/Queries.hs | 3 +-- .../012-add-current-project-path-table.sql | 6 +++--- .../Codebase/SqliteCodebase/Migrations.hs | 13 +++++++++++-- .../Migrations/MigrateSchema16To17.hs | 19 +++++++++++++++++-- 4 files changed, 32 insertions(+), 9 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 89d4839421..092a9b0d30 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3551,8 +3551,7 @@ loadProjectBranchSql projectId branchId = project_branch.project_id, project_branch.branch_id, project_branch.name, - project_branch_parent.parent_branch_id, - project_branch.causal_hash_id + project_branch_parent.parent_branch_id FROM project_branch LEFT JOIN project_branch_parent ON project_branch.project_id = project_branch_parent.project_id diff --git a/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql b/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql index b00290be50..63b3d07559 100644 --- a/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql +++ b/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql @@ -1,13 +1,13 @@ -- The most recent namespace that a user cd'd to. -- This table should never have more than one row. CREATE TABLE current_project_path ( - project_id INTEGER NOT NULL REFERENCES project (id), - branch_id INTEGER NOT NULL REFERENCES project_branch (id), + project_id INTEGER NOT NULL, + branch_id INTEGER NOT NULL, -- A json array like ["foo", "bar"]; the root namespace is represented by the empty array path TEXT PRIMARY KEY NOT NULL, foreign key (project_id, branch_id) - references project_branch (project_id, branch_id), + references project_branch (project_id, branch_id) ) WITHOUT ROWID; DROP TABLE most_recent_namespace; diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index dcb7cb59f5..5244facbf8 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -31,6 +31,7 @@ import Unison.Codebase.SqliteCodebase.Operations qualified as Ops2 import Unison.Codebase.SqliteCodebase.Paths (backupCodebasePath) import Unison.Codebase.Type (LocalOrRemote (..)) import Unison.ConstructorType qualified as CT +import Unison.Debug qualified as Debug import Unison.Hash (Hash) import Unison.Prelude import Unison.Sqlite qualified as Sqlite @@ -176,12 +177,20 @@ ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer sh migration conn let ranMigrations = not (null migrationsToRun) pure ranMigrations + Debug.debugLogM Debug.Migration "Migrations complete" when ranMigrations do - region <- readMVar regionVar + region <- + UnliftIO.mask_ do + region <- Region.openConsoleRegion Region.Linear + putMVar regionVar region + pure region -- Vacuum once now that any migrations have taken place. Region.setConsoleRegion region ("✅ All good, cleaning up..." :: Text) case vacuumStrategy of - Vacuum -> void $ Sqlite.Connection.vacuum conn + Vacuum -> do + Debug.debugLogM Debug.Migration "About to VACUUM" + void $ Sqlite.Connection.vacuum conn + Debug.debugLogM Debug.Migration "Done VACUUM" NoVacuum -> pure () Region.setConsoleRegion region ("🏁 Migrations complete 🏁" :: Text) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs index 674466212f..3feba3768a 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs @@ -17,11 +17,13 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path import Unison.Codebase.SqliteCodebase.Operations qualified as Ops import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName), ProjectName (UnsafeProjectName)) +import Unison.Debug qualified as Debug import Unison.NameSegment (NameSegment) import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.Sqlite qualified as Sqlite +import Unison.Sqlite.Connection qualified as Connection import Unison.Syntax.NameSegment qualified as NameSegment import UnliftIO qualified import UnliftIO qualified as UnsafeIO @@ -38,7 +40,9 @@ migrateSchema16To17 :: Sqlite.Connection -> IO () migrateSchema16To17 conn = withDisabledForeignKeys $ do Q.expectSchemaVersion 16 Q.addProjectBranchReflogTable + Debug.debugLogM Debug.Migration "Adding causal hashes to project branches table." addCausalHashesToProjectBranches + Debug.debugLogM Debug.Migration "Adding scratch project" scratchMain <- Q.loadProjectBranchByNames scratchProjectName scratchBranchName >>= \case Just pb -> pure pb @@ -46,16 +50,19 @@ migrateSchema16To17 conn = withDisabledForeignKeys $ do (_, emptyCausalHashId) <- Codebase.emptyCausalHash (_proj, pb) <- Ops.insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId pure pb + Debug.debugLogM Debug.Migration "Adding current project path table" Q.addCurrentProjectPathTable + Debug.debugLogM Debug.Migration "Setting current project path to scratch project" Q.setCurrentProjectPath scratchMain.projectId scratchMain.branchId [] + Debug.debugLogM Debug.Migration "Done migrating to version 17" Q.setSchemaVersion 17 where scratchProjectName = UnsafeProjectName "scratch" scratchBranchName = UnsafeProjectBranchName "main" withDisabledForeignKeys :: Sqlite.Transaction r -> IO r withDisabledForeignKeys m = do - let disable = Sqlite.runWriteTransaction conn \run -> run $ Sqlite.execute [Sqlite.sql| PRAGMA foreign_keys=OFF |] - let enable = Sqlite.runWriteTransaction conn \run -> run $ Sqlite.execute [Sqlite.sql| PRAGMA foreign_keys=ON |] + let disable = Connection.execute conn [Sqlite.sql| PRAGMA foreign_keys=OFF |] + let enable = Connection.execute conn [Sqlite.sql| PRAGMA foreign_keys=ON |] let action = Sqlite.runWriteTransaction conn \run -> run $ m UnsafeIO.bracket disable (const enable) (const action) @@ -69,6 +76,7 @@ newtype ForeignKeyFailureException addCausalHashesToProjectBranches :: Sqlite.Transaction () addCausalHashesToProjectBranches = do + Debug.debugLogM Debug.Migration "Creating new_project_branch" -- Create the new version of the project_branch table with the causal_hash_id column. Sqlite.execute [Sqlite.sql| @@ -91,6 +99,7 @@ without rowid; projectId <- case projectIdNS of UUIDNameSegment projectIdUUID -> pure $ ProjectId projectIdUUID _ -> error $ "Invalid Project Id NameSegment:" <> show projectIdNS + Debug.debugM Debug.Migration "Migrating project" projectId projectsBranch <- V2Causal.value projectsCausal case (Map.lookup (NameSegment.unsafeParseText "branches") $ V2Branch.children projectsBranch) of Nothing -> pure () @@ -100,6 +109,7 @@ without rowid; projectBranchId <- case branchIdNS of UUIDNameSegment branchIdUUID -> pure $ ProjectBranchId branchIdUUID _ -> error $ "Invalid Branch Id NameSegment:" <> show branchIdNS + Debug.debugM Debug.Migration "Migrating project branch" projectBranchId let branchCausalHash = V2Causal.causalHash projectBranchCausal causalHashId <- lift $ Q.expectCausalHashIdByCausalHash branchCausalHash branchName <- @@ -120,6 +130,7 @@ without rowid; VALUES (:projectId, :projectBranchId, :branchName, :causalHashId) |] + Debug.debugLogM Debug.Migration "Deleting orphaned project branch data" -- Delete any project branch data that don't have a matching branch in the current root. -- This is to make sure any old or invalid project branches get cleared out and won't cause problems when we rewrite -- foreign key references. @@ -128,14 +139,18 @@ without rowid; [Sqlite.sql| DELETE FROM project_branch_parent AS pbp WHERE NOT EXISTS(SELECT 1 FROM new_project_branch npb WHERE npb.project_id = pbp.project_id AND npb.branch_id = pbp.branch_id) |] + Debug.debugLogM Debug.Migration "Deleting orphaned remote mapping data" Sqlite.execute [Sqlite.sql| DELETE FROM project_branch_remote_mapping AS pbrp WHERE NOT EXISTS(SELECT 1 FROM new_project_branch npb WHERE npb.project_id = pbrp.local_project_id AND npb.branch_id = pbrp.local_branch_id) |] + Sqlite.execute [Sqlite.sql| DELETE FROM most_recent_branch |] + Debug.debugLogM Debug.Migration "Swapping old and new project branch tables" -- Drop the old project_branch table and rename the new one to take its place. Sqlite.execute [Sqlite.sql| DROP TABLE project_branch |] Sqlite.execute [Sqlite.sql| ALTER TABLE new_project_branch RENAME TO project_branch |] + Debug.debugLogM Debug.Migration "Checking foreign keys" foreignKeyErrs <- Sqlite.queryListRow [Sqlite.sql| PRAGMA foreign_key_check |] when (not . null $ foreignKeyErrs) . Sqlite.unsafeIO . UnliftIO.throwIO $ ForeignKeyFailureException foreignKeyErrs From cc441e97bbcaec271a02b7c6a041ed8e74fc4cdf Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 14 Jun 2024 17:05:34 -0700 Subject: [PATCH 172/631] Fix projectpath updating in memory branch --- unison-cli/src/Unison/Cli/Monad.hs | 21 +++++++++++++++++---- unison-cli/src/Unison/Cli/MonadUtils.hs | 8 +------- unison-cli/src/Unison/Cli/Pretty.hs | 7 ++++++- 3 files changed, 24 insertions(+), 12 deletions(-) diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index b6c137c3ce..7663066237 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -48,6 +48,10 @@ module Unison.Cli.Monad runTransaction, runTransactionWithRollback, + -- * Internal + setMostRecentProjectPath, + setInMemoryCurrentProjectRoot, + -- * Misc types LoadSourceResult (..), ) @@ -81,10 +85,10 @@ import Unison.Codebase.Editor.UCMVersion (UCMVersion) import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) +import Unison.Core.Project (ProjectAndBranch (..)) import Unison.Debug qualified as Debug import Unison.Parser.Ann (Ann) import Unison.Prelude -import Unison.Project (ProjectAndBranch (..)) import Unison.Server.CodebaseServer qualified as Server import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) @@ -387,11 +391,21 @@ cd path = do setMostRecentProjectPath newPP #projectPathStack %= NonEmpty.cons newPP +-- | Set the in-memory project root to the given branch, without updating the database. +setInMemoryCurrentProjectRoot :: Branch IO -> Cli () +setInMemoryCurrentProjectRoot !newRoot = do + rootVar <- use #currentProjectRoot + atomically do + void $ swapTMVar rootVar newRoot + switchProject :: ProjectAndBranch ProjectId ProjectBranchId -> Cli () switchProject (ProjectAndBranch projectId branchId) = do + Env {codebase} <- ask let newPP = PP.ProjectPath projectId branchId Path.absoluteEmpty #projectPathStack %= NonEmpty.cons newPP runTransaction $ Q.setMostRecentBranch projectId branchId + pbr <- liftIO $ Codebase.expectProjectBranchRoot codebase projectId branchId + setInMemoryCurrentProjectRoot pbr setMostRecentProjectPath newPP -- | Pop the latest path off the stack, if it's not the only path in the stack. @@ -408,9 +422,8 @@ popd = do pure True setMostRecentProjectPath :: PP.ProjectPathIds -> Cli () -setMostRecentProjectPath _loc = - -- runTransaction . Queries.setMostRecentLocation . map NameSegment.toUnescapedText . Path.toList . Path.unabsolute - error "Implement setMostRecentLocation" +setMostRecentProjectPath loc = + runTransaction $ Codebase.setCurrentProjectPath loc respond :: Output -> Cli () respond output = do diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 2e6abfdc30..5cd11912d5 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -458,15 +458,9 @@ updateProjectBranchRoot projectBranch reason f = do causalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash new) Q.setProjectBranchHead reason (projectBranch ^. #projectId) (projectBranch ^. #branchId) causalHashId if projectBranch.branchId == currentPB.branchId - then setCurrentProjectRoot new + then Cli.setInMemoryCurrentProjectRoot new else pure () pure result - where - setCurrentProjectRoot :: Branch IO -> Cli () - setCurrentProjectRoot !newRoot = do - rootVar <- use #currentProjectRoot - atomically do - void $ swapTMVar rootVar newRoot updateProjectBranchRoot_ :: ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli () updateProjectBranchRoot_ projectBranch reason f = do diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index ac56a7d644..96ec98d48f 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -121,6 +121,7 @@ import Unison.Term (Term) import Unison.Type (Type) import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF +import Unison.Util.Monoid qualified as Monoid import Unison.Util.Pretty qualified as P import Unison.Var (Var) import Unison.Var qualified as Var @@ -200,7 +201,11 @@ prettyAbsolute :: Path.Absolute -> Pretty prettyAbsolute = P.blue . P.shown prettyProjectPath :: PP.ProjectPath -> Pretty -prettyProjectPath = P.blue . P.shown +prettyProjectPath (PP.ProjectPath project branch path) = + prettyProjectAndBranchName (ProjectAndBranch project.name branch.name) + <> + -- Only show the path if it's not the root + Monoid.whenM (path /= Path.absoluteEmpty) (P.cyan (":" <> P.shown path)) prettySCH :: (IsString s) => ShortCausalHash -> P.Pretty s prettySCH hash = P.group $ "#" <> P.text (SCH.toText hash) From b3baee3ed80674676ee0a327b950f8095e192ccb Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 17 Jun 2024 16:17:00 -0400 Subject: [PATCH 173/631] make `todo` show dependencies without names --- .../src/Unison/Codebase/Branch.hs | 14 ++++- .../Codebase/Editor/HandleInput/Todo.hs | 34 +++++++++-- .../src/Unison/Codebase/Editor/Output.hs | 3 +- .../src/Unison/Codebase/Editor/TodoOutput.hs | 6 +- .../src/Unison/CommandLine/OutputMessages.hs | 57 ++++++++++++++----- 5 files changed, 93 insertions(+), 21 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Branch.hs b/parser-typechecker/src/Unison/Codebase/Branch.hs index 2e981501c9..68c55c88f8 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch.hs @@ -90,7 +90,9 @@ module Unison.Codebase.Branch deepPaths, deepReferents, deepTermReferences, + deepTermReferenceIds, deepTypeReferences, + deepTypeReferenceIds, consBranchSnapshot, ) where @@ -136,7 +138,7 @@ import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment import Unison.Prelude hiding (empty) -import Unison.Reference (TermReference, TypeReference) +import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId) import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Util.List qualified as List @@ -146,6 +148,7 @@ import Unison.Util.Set qualified as Set import Unison.Util.Star2 qualified as Star2 import Witherable (FilterableWithIndex (imapMaybe)) import Prelude hiding (head, read, subtract) +import qualified Unison.Reference as Reference instance AsEmpty (Branch m) where _Empty = prism' (const empty) matchEmpty @@ -201,9 +204,18 @@ deepTermReferences :: Branch0 m -> Set TermReference deepTermReferences = Set.mapMaybe Referent.toTermReference . deepReferents +deepTermReferenceIds :: Branch0 m -> Set TermReferenceId +deepTermReferenceIds = + Set.mapMaybe Referent.toTermReferenceId . deepReferents + deepTypeReferences :: Branch0 m -> Set TypeReference deepTypeReferences = R.dom . deepTypes +deepTypeReferenceIds :: Branch0 m -> Set TypeReferenceId +deepTypeReferenceIds = + Set.mapMaybe Reference.toId . deepTypeReferences + + namespaceStats :: Branch0 m -> NamespaceStats namespaceStats b = NamespaceStats diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index 4cfe62d3b8..2b24d33128 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -4,22 +4,48 @@ module Unison.Codebase.Editor.HandleInput.Todo ) where +import Data.Set qualified as Set +import U.Codebase.Sqlite.Operations qualified as Operations import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.PrettyPrintUtils qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Names qualified as Names +import Unison.Util.Defns (Defns (..)) handleTodo :: Cli () handleTodo = do - branch0 <- Cli.getCurrentBranch0 - let names0 = Branch.toNames branch0 + -- For now, we don't go through any great trouble to seek out the root of the project branch. Just assume the current + -- namespace is the root, which will be the case unless the user uses `deprecated.cd`. + currentNamespace <- Cli.getCurrentBranch0 + let currentNamespaceWithoutLibdeps = Branch.deleteLibdeps currentNamespace + + (hashLen, directDependencies) <- + Cli.runTransaction do + hashLen <- Codebase.hashLength + directDependencies <- + Operations.directDependenciesOfScope + Defns + { terms = Branch.deepTermReferenceIds currentNamespaceWithoutLibdeps, + types = Branch.deepTypeReferenceIds currentNamespaceWithoutLibdeps + } + pure (hashLen, directDependencies) + let todo = TO.TodoOutput - { nameConflicts = Names.conflicts names0 + { directDependenciesWithoutNames = + Defns + { terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace), + types = Set.difference directDependencies.types (Branch.deepTypeReferences currentNamespace) + }, + nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps) } + pped <- Cli.currentPrettyPrintEnvDecl - Cli.respondNumbered $ TodoOutput pped todo + + Cli.respondNumbered (TodoOutput hashLen pped todo) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 027d95ceb0..d36c7dfee5 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -117,8 +117,7 @@ data NumberedOutput | ShowDiffAfterPull Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | -- ShowDiffAfterCreateAuthor NameSegment Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) - | -- | Invariant: there's at least one conflict or edit in the TodoOutput. - TodoOutput PPE.PrettyPrintEnvDecl (TO.TodoOutput Symbol Ann) + | TodoOutput !Int !PPE.PrettyPrintEnvDecl !(TO.TodoOutput Symbol Ann) | -- | CantDeleteDefinitions ppe couldntDelete becauseTheseStillReferenceThem CantDeleteDefinitions PPE.PrettyPrintEnvDecl (Map LabeledDependency (NESet LabeledDependency)) | -- | CantDeleteNamespace ppe couldntDelete becauseTheseStillReferenceThem diff --git a/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs b/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs index e4c859a9f1..48b1e40a85 100644 --- a/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs @@ -5,9 +5,13 @@ module Unison.Codebase.Editor.TodoOutput where import Unison.Names (Names) +import Unison.Prelude +import Unison.Reference (TermReference, TypeReference) +import Unison.Util.Defns (DefnsF) data TodoOutput v a = TodoOutput - { nameConflicts :: Names + { directDependenciesWithoutNames :: DefnsF Set TermReference TypeReference, + nameConflicts :: Names } noConflicts :: TodoOutput v a -> Bool diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 20ff1a4f53..251d11c758 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -142,6 +142,7 @@ import Unison.Term (Term) import Unison.Term qualified as Term import Unison.Type (Type) import Unison.UnisonFile qualified as UF +import Unison.Util.Defns (Defns (..), defnsAreEmpty) import Unison.Util.List qualified as List import Unison.Util.Monoid (intercalateMap) import Unison.Util.Monoid qualified as Monoid @@ -306,7 +307,7 @@ notifyNumbered = \case ] ) (showDiffNamespace ShowNumbers ppe (absPathToBranchId bAbs) (absPathToBranchId bAbs) diff) - TodoOutput names todo -> todoOutput names todo + TodoOutput hashLen names todo -> todoOutput hashLen names todo CantDeleteDefinitions ppeDecl endangerments -> ( P.warnCallout $ P.lines @@ -2590,8 +2591,7 @@ renderNameConflicts ppe conflictedNames = do [ prettyConflictedTypes, prettyConflictedTerms, tip $ - "This occurs when merging branches that both independently introduce the same name." - <> "Use " + "Use " <> makeExample' ( if (not . null) conflictedTypeNames then IP.renameType @@ -2609,7 +2609,7 @@ renderNameConflicts ppe conflictedNames = do showConflictedNames :: Pretty -> Map Name [HQ.HashQualified Name] -> Numbered Pretty showConflictedNames thingKind conflictedNames = P.lines <$> do - for (Map.toList conflictedNames) $ \(name, hashes) -> do + for (Map.toList conflictedNames) \(name, hashes) -> do prettyConflicts <- for hashes \hash -> do n <- addNumberedArg $ SA.HashQualified hash pure $ formatNum n <> (P.blue . P.syntaxToColor . prettyHashQualified $ hash) @@ -2627,8 +2627,9 @@ type Numbered = State.State (Int, Seq.Seq StructuredArgument) addNumberedArg :: StructuredArgument -> Numbered Int addNumberedArg s = do (n, args) <- State.get - State.put (n + 1, args Seq.|> s) - pure $ (n + 1) + let !n' = n + 1 + State.put (n', args Seq.|> s) + pure n' formatNum :: Int -> Pretty formatNum n = P.string (show n <> ". ") @@ -2638,13 +2639,43 @@ runNumbered m = let (a, (_, args)) = State.runState m (0, mempty) in (a, Foldable.toList args) -todoOutput :: (Var v) => PPED.PrettyPrintEnvDecl -> TO.TodoOutput v a -> (Pretty, NumberedArgs) -todoOutput ppe todo = runNumbered do - if TO.noConflicts todo - then pure mempty - else do - nameConflicts <- renderNameConflicts ppeu (TO.nameConflicts todo) - pure $ P.lines $ P.nonEmpty [nameConflicts] +todoOutput :: (Var v) => Int -> PPED.PrettyPrintEnvDecl -> TO.TodoOutput v a -> (Pretty, NumberedArgs) +todoOutput hashLen ppe todo = + runNumbered do + prettyConflicts <- + if TO.noConflicts todo + then pure mempty + else renderNameConflicts ppeu todo.nameConflicts + + prettyDirectTermDependenciesWithoutNames <- do + if Set.null todo.directDependenciesWithoutNames.terms + then pure mempty + else do + terms <- + for (Set.toList todo.directDependenciesWithoutNames.terms) \term -> do + n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term))) + pure (formatNum n <> P.syntaxToColor (prettyReference hashLen term)) + pure $ + P.wrap "These terms do not have any names in the current namespace:" + `P.hang` P.lines terms + + prettyDirectTypeDependenciesWithoutNames <- do + if Set.null todo.directDependenciesWithoutNames.types + then pure mempty + else do + types <- + for (Set.toList todo.directDependenciesWithoutNames.types) \typ -> do + n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ))) + pure (formatNum n <> P.syntaxToColor (prettyReference hashLen typ)) + pure $ + P.wrap "These types do not have any names in the current namespace:" + `P.hang` P.lines types + + (pure . P.sep "\n\n" . P.nonEmpty) + [ prettyConflicts, + prettyDirectTermDependenciesWithoutNames, + prettyDirectTypeDependenciesWithoutNames + ] where ppeu = PPED.unsuffixifiedPPE ppe From 87c2f868be11303ec584bac7c874670452bb7cee Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 17 Jun 2024 22:14:29 -0400 Subject: [PATCH 174/631] bugfix: switch to most recently visited branch --- unison-cli/src/Unison/Cli/ProjectUtils.hs | 4 +-- .../Editor/HandleInput/CommitUpgrade.hs | 20 +++++------ .../Editor/HandleInput/ProjectSwitch.hs | 35 +++++++++---------- 3 files changed, 28 insertions(+), 31 deletions(-) diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index f184349fd4..0735d4d1ae 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -123,8 +123,8 @@ justTheIds x = ProjectAndBranch x.project.projectId x.branch.branchId justTheIds' :: Sqlite.ProjectBranch -> ProjectAndBranch ProjectId ProjectBranchId -justTheIds' x = - ProjectAndBranch x.projectId x.branchId +justTheIds' branch = + ProjectAndBranch branch.projectId branch.branchId justTheNames :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> ProjectAndBranch ProjectName ProjectBranchName justTheNames x = diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs index 76229b8bfd..daa3c38e13 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitUpgrade.hs @@ -5,13 +5,13 @@ module Unison.Codebase.Editor.HandleInput.CommitUpgrade where import U.Codebase.Sqlite.Project qualified +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Editor.HandleInput.DeleteBranch qualified as DeleteBranch import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge -import Unison.Codebase.Editor.HandleInput.ProjectSwitch qualified as ProjectSwitch import Unison.Codebase.Editor.Output qualified as Output import Unison.Merge.TwoWay (TwoWay (..)) import Unison.Prelude @@ -21,27 +21,25 @@ handleCommitUpgrade :: Cli () handleCommitUpgrade = do (upgradeProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch - -- Assert that this is an "upgrade" branch and get its parent, which is the branch we were on when we ran `upgrade`. + -- Assert that this is an "upgrade" branch, get its parent (which is the branch we were on when we ran `upgrade`), + -- and switch to the parent. parentBranchId <- ProjectUtils.getUpgradeBranchParent upgradeProjectAndBranch.branch & onNothing (Cli.returnEarly Output.NoUpgradeInProgress) + parentBranch <- Cli.runTransaction do - Queries.expectProjectBranch upgradeProjectAndBranch.project.projectId parentBranchId - - let parentProjectAndBranch = - ProjectAndBranch upgradeProjectAndBranch.project parentBranch - - -- Switch to the parent - - ProjectSwitch.switchToProjectBranch (ProjectUtils.justTheIds parentProjectAndBranch) + parentBranch <- Queries.expectProjectBranch upgradeProjectAndBranch.project.projectId parentBranchId + Queries.setMostRecentBranch parentBranch.projectId parentBranch.branchId + pure parentBranch + Cli.cd (ProjectUtils.projectBranchPath (ProjectAndBranch parentBranch.projectId parentBranch.branchId)) -- Merge the upgrade branch into the parent Merge.doMergeLocalBranch TwoWay - { alice = parentProjectAndBranch, + { alice = ProjectAndBranch upgradeProjectAndBranch.project parentBranch, bob = upgradeProjectAndBranch } diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs index 688ba58363..ef668fa477 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs @@ -1,13 +1,12 @@ -- | @switch@ input handler module Unison.Codebase.Editor.HandleInput.ProjectSwitch ( projectSwitch, - switchToProjectBranch, ) where import Data.These (These (..)) -import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) import U.Codebase.Sqlite.Project qualified +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -59,21 +58,21 @@ switchToProjectAndBranchByTheseNames projectAndBranchNames0 = do project <- Queries.loadProjectByName projectName & onNothingM do rollback (Output.LocalProjectDoesntExist projectName) - let branchName = unsafeFrom @Text "main" - Queries.loadProjectBranchByName project.projectId branchName & onNothingM do - rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName)) + Queries.loadMostRecentBranch project.projectId >>= \case + Nothing -> do + let branchName = unsafeFrom @Text "main" + branch <- + Queries.loadProjectBranchByName project.projectId branchName & onNothingM do + rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName)) + Queries.setMostRecentBranch branch.projectId branch.branchId + pure branch + Just branchId -> Queries.expectProjectBranch project.projectId branchId _ -> do - projectAndBranchNames@(ProjectAndBranch projectName branchName) <- ProjectUtils.hydrateNames projectAndBranchNames0 + projectAndBranchNames <- ProjectUtils.hydrateNames projectAndBranchNames0 Cli.runTransactionWithRollback \rollback -> do - Queries.loadProjectBranchByNames projectName branchName & onNothingM do - rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) - switchToProjectBranch (ProjectUtils.justTheIds' branch) - --- | Switch to a branch: --- --- * Record it as the most-recent branch (so it's restored when ucm starts). --- * Change the current path in the in-memory loop state. -switchToProjectBranch :: ProjectAndBranch ProjectId ProjectBranchId -> Cli () -switchToProjectBranch x = do - Cli.runTransaction (Queries.setMostRecentBranch x.project x.branch) - Cli.cd (ProjectUtils.projectBranchPath x) + branch <- + Queries.loadProjectBranchByNames projectAndBranchNames.project projectAndBranchNames.branch & onNothingM do + rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames) + Queries.setMostRecentBranch branch.projectId branch.branchId + pure branch + Cli.cd (ProjectUtils.projectBranchPath (ProjectAndBranch branch.projectId branch.branchId)) From 3ec5a5f27a0fd19c8303c700d1a19142f5a43740 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 17 Jun 2024 22:19:05 -0400 Subject: [PATCH 175/631] fix up merge.commit --- .../Editor/HandleInput/CommitMerge.hs | 20 +++++++++---------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs index 1c9061e5d1..9631295219 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/CommitMerge.hs @@ -5,13 +5,13 @@ module Unison.Codebase.Editor.HandleInput.CommitMerge where import U.Codebase.Sqlite.Project qualified +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Editor.HandleInput.DeleteBranch qualified as DeleteBranch import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge -import Unison.Codebase.Editor.HandleInput.ProjectSwitch qualified as ProjectSwitch import Unison.Codebase.Editor.Output qualified as Output import Unison.Merge.TwoWay (TwoWay (..)) import Unison.Prelude @@ -23,27 +23,25 @@ handleCommitMerge :: Cli () handleCommitMerge = do (mergeProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch - -- Assert that this is a "merge" branch and get its parent, which is the branch we were on when we ran `merge`. + -- Assert that this is a "merge" branch, get its parent (which is the branch we were on when we ran `merge`), + -- and switch to the parent. parentBranchId <- ProjectUtils.getMergeBranchParent mergeProjectAndBranch.branch & onNothing (Cli.returnEarly Output.NoMergeInProgress) + parentBranch <- Cli.runTransaction do - Queries.expectProjectBranch mergeProjectAndBranch.project.projectId parentBranchId - - let parentProjectAndBranch = - ProjectAndBranch mergeProjectAndBranch.project parentBranch - - -- Switch to the parent - - ProjectSwitch.switchToProjectBranch (ProjectUtils.justTheIds parentProjectAndBranch) + parentBranch <- Queries.expectProjectBranch mergeProjectAndBranch.project.projectId parentBranchId + Queries.setMostRecentBranch parentBranch.projectId parentBranch.branchId + pure parentBranch + Cli.cd (ProjectUtils.projectBranchPath (ProjectAndBranch parentBranch.projectId parentBranch.branchId)) -- Merge the merge branch into the parent Merge.doMergeLocalBranch TwoWay - { alice = parentProjectAndBranch, + { alice = ProjectAndBranch mergeProjectAndBranch.project parentBranch, bob = mergeProjectAndBranch } From a0527457a611ebb4ac68606cbdc0fbeeec36c332 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Tue, 18 Jun 2024 12:26:25 -0400 Subject: [PATCH 176/631] Implement custom Word64 delay The builtin is specified to take a Nat, but Haskell's threadDelay takes an Int. So the previous implementation was erroneously treating large numbers as negatives and not sleeping at all. Instead we split the wait into multiple delays for large numbers (although practically the second delay won't be reached). --- parser-typechecker/src/Unison/Runtime/Builtin.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Runtime/Builtin.hs b/parser-typechecker/src/Unison/Runtime/Builtin.hs index 3feb0d55e0..f9c827fda9 100644 --- a/parser-typechecker/src/Unison/Runtime/Builtin.hs +++ b/parser-typechecker/src/Unison/Runtime/Builtin.hs @@ -2599,8 +2599,16 @@ declareForeigns = do declareForeign Tracked "IO.kill.impl.v3" boxToEF0 $ mkForeignIOF killThread + let mx :: Word64 + mx = fromIntegral (maxBound :: Int) + + customDelay :: Word64 -> IO () + customDelay n + | n < mx = threadDelay (fromIntegral n) + | otherwise = threadDelay maxBound >> customDelay (n - mx) + declareForeign Tracked "IO.delay.impl.v3" natToEFUnit $ - mkForeignIOF threadDelay + mkForeignIOF customDelay declareForeign Tracked "IO.stdHandle" standard'handle . mkForeign From c004c59189d7b2405fcfea59b30f695537cc35ce Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Tue, 18 Jun 2024 12:56:49 -0400 Subject: [PATCH 177/631] Update ormolu.yaml --- .github/workflows/ormolu.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ormolu.yaml b/.github/workflows/ormolu.yaml index bc0f67f460..008745ee66 100644 --- a/.github/workflows/ormolu.yaml +++ b/.github/workflows/ormolu.yaml @@ -21,7 +21,7 @@ jobs: - name: create pull request with formatting changes uses: peter-evans/create-pull-request@v6 with: - commit_message: automatically run ormolu + commit-message: automatically run ormolu branch: autoformat/${{github.ref_name}} # branch_suffix: random title: format `${{github.ref_name}}` with ormolu ${{env.ormolu_version}} From 0f2e4ba18f6c1e77526b68d388bb23fe34a5193e Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Tue, 18 Jun 2024 13:02:47 -0400 Subject: [PATCH 178/631] Update ormolu.yaml --- .github/workflows/ormolu.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ormolu.yaml b/.github/workflows/ormolu.yaml index 008745ee66..6a7fe9f22b 100644 --- a/.github/workflows/ormolu.yaml +++ b/.github/workflows/ormolu.yaml @@ -23,5 +23,5 @@ jobs: with: commit-message: automatically run ormolu branch: autoformat/${{github.ref_name}} - # branch_suffix: random + branch-suffix: short-commit-hash title: format `${{github.ref_name}}` with ormolu ${{env.ormolu_version}} From 56a7ff4bedc22ef3d18e5e838240a861a892a588 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Tue, 18 Jun 2024 13:13:20 -0400 Subject: [PATCH 179/631] updating tj-actions/changed-files to v44 to hopefully avoid this error https://github.com/unisonweb/unison/actions/runs/9551944735/job/26327430910 https://github.com/tj-actions/changed-files/issues/778 --- .github/workflows/ci.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 4ee48187bd..35489112f1 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -38,7 +38,7 @@ jobs: - uses: actions/checkout@v4 - name: Get changed files id: changed-files - uses: tj-actions/changed-files@v41 + uses: tj-actions/changed-files@v44 with: # globs copied from default settings for run-ormolu files: | From a9f05bbf8acc076fba6fd4179e5af99864a6258e Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 20 Jun 2024 09:29:53 -0400 Subject: [PATCH 180/631] tweak rendering --- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index f03bcd93a2..c2531ab46f 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2640,7 +2640,9 @@ renderNameConflicts ppe conflictedNames = do <> P.green (prettyName name) <> " has conflicting definitions:" ) - `P.hang` P.lines prettyConflicts + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines prettyConflicts) type Numbered = State.State (Int, Seq.Seq StructuredArgument) @@ -2677,7 +2679,9 @@ todoOutput hashLen ppe todo = pure (formatNum n <> P.syntaxToColor (prettyReference hashLen term)) pure $ P.wrap "These terms do not have any names in the current namespace:" - `P.hang` P.lines terms + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines terms) prettyDirectTypeDependenciesWithoutNames <- do if Set.null todo.directDependenciesWithoutNames.types @@ -2689,7 +2693,9 @@ todoOutput hashLen ppe todo = pure (formatNum n <> P.syntaxToColor (prettyReference hashLen typ)) pure $ P.wrap "These types do not have any names in the current namespace:" - `P.hang` P.lines types + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines types) (pure . P.sep "\n\n" . P.nonEmpty) [ prettyConflicts, From 3504ae7e563ff4273e677d9f600deb8d882e1468 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 20 Jun 2024 11:48:51 -0400 Subject: [PATCH 181/631] delete unused import --- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index c2531ab46f..87e06282d0 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -142,7 +142,7 @@ import Unison.Term (Term) import Unison.Term qualified as Term import Unison.Type (Type) import Unison.UnisonFile qualified as UF -import Unison.Util.Defns (Defns (..), defnsAreEmpty) +import Unison.Util.Defns (Defns (..)) import Unison.Util.List qualified as List import Unison.Util.Monoid (intercalateMap) import Unison.Util.Monoid qualified as Monoid From caac3c47d7bf7986509cfb89bf67212a92f714a9 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Sat, 15 Jun 2024 11:14:28 -0500 Subject: [PATCH 182/631] Improve some lexer error messages MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The message mentioned in #5060 was incorrect. This also uses the passed- in `id` for that message and related messages (removing the reliance on ANSI colors for conveying where the error is). And it adds a suggestion on how to avoid the error. It also does some minor adjustment of highlighting – styling individual identifiers rather that a list of them. Fixes #5060 --- parser-typechecker/src/Unison/PrintError.hs | 38 ++++++++++++++------- 1 file changed, 26 insertions(+), 12 deletions(-) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index d95ffed4a1..77dcdd0b0a 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -1366,31 +1366,45 @@ renderParseErrors s = \case <> style ErrorSite (fromString open) <> ".\n\n" <> excerpt - L.InvalidWordyId _id -> + L.InvalidWordyId id -> Pr.lines - [ "This identifier isn't valid syntax: ", + [ "The identifier " <> style Code id <> " isn't valid syntax: ", "", excerpt, "Here's a few examples of valid syntax: " - <> style Code "abba1', snake_case, Foo.zoink!, 🌻" + <> style Code "abba1'" + <> ", " + <> style Code "snake_case" + <> ", " + <> style Code "Foo.zoink!" + <> ", and " + <> style Code "🌻" ] - L.ReservedWordyId _id -> + L.ReservedWordyId id -> Pr.lines - [ "The identifier used here isn't allowed to be a reserved keyword: ", + [ "The identifier " <> style Code id <> " used here is a reserved keyword: ", "", - excerpt + excerpt, + Pr.wrap $ + "You can avoid this problem either by renaming the identifier or wrapping it in backticks (like " + <> style Code ("`" <> id <> "`") + <> ")." ] - L.InvalidSymbolyId _id -> + L.InvalidSymbolyId id -> Pr.lines - [ "This infix identifier isn't valid syntax: ", + [ "The infix identifier " <> style Code id <> " isn’t valid syntax: ", "", excerpt, - "Here's a few valid examples: " - <> style Code "++, Float./, `List.map`" + "Here are a few valid examples: " + <> style Code "++" + <> ", " + <> style Code "Float./" + <> ", and " + <> style Code "`List.map`" ] - L.ReservedSymbolyId _id -> + L.ReservedSymbolyId id -> Pr.lines - [ "This identifier is reserved by Unison and can't be used as an operator: ", + [ "The identifier " <> style Code id <> " is reserved by Unison and can't be used as an operator: ", "", excerpt ] From bb4f39fb2feb0525622647b3f4041a1293223155 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 20 Jun 2024 13:44:55 -0400 Subject: [PATCH 183/631] Update error message in transcripts --- unison-src/transcripts/error-messages.output.md | 4 +++- unison-src/transcripts/generic-parse-errors.output.md | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/unison-src/transcripts/error-messages.output.md b/unison-src/transcripts/error-messages.output.md index 525df31ee9..eb01548045 100644 --- a/unison-src/transcripts/error-messages.output.md +++ b/unison-src/transcripts/error-messages.output.md @@ -343,10 +343,12 @@ use.keyword.in.namespace = 1 Loading changes detected in scratch.u. - The identifier used here isn't allowed to be a reserved keyword: + The identifier namespace used here is a reserved keyword: 1 | use.keyword.in.namespace = 1 + You can avoid this problem either by renaming the identifier + or wrapping it in backticks (like `namespace` ). ``` ```unison diff --git a/unison-src/transcripts/generic-parse-errors.output.md b/unison-src/transcripts/generic-parse-errors.output.md index b055ba9689..039a1fb002 100644 --- a/unison-src/transcripts/generic-parse-errors.output.md +++ b/unison-src/transcripts/generic-parse-errors.output.md @@ -30,10 +30,12 @@ namespace.blah = 1 Loading changes detected in scratch.u. - The identifier used here isn't allowed to be a reserved keyword: + The identifier namespace used here is a reserved keyword: 1 | namespace.blah = 1 + You can avoid this problem either by renaming the identifier + or wrapping it in backticks (like `namespace` ). ``` ```unison From 5353a4e64cb77e43bde3ff45baa633573b007aa5 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 14 Jun 2024 10:16:19 -0400 Subject: [PATCH 184/631] properly handle deleted constructors in merge --- .../Codebase/Editor/HandleInput/Merge2.hs | 57 ++++---- .../src/Unison/Merge/DeclCoherencyCheck.hs | 38 ++++-- unison-merge/src/Unison/Merge/Diff.hs | 122 +++++++++++------- .../src/Unison/Merge/PartialDeclNameLookup.hs | 15 +++ unison-merge/src/Unison/Merge/Synhash.hs | 48 +++---- unison-merge/unison-merge.cabal | 1 + unison-src/transcripts/merge.md | 105 ++++++++++----- unison-src/transcripts/merge.output.md | 99 +++++++++++++- 8 files changed, 333 insertions(+), 152 deletions(-) create mode 100644 unison-merge/src/Unison/Merge/PartialDeclNameLookup.hs diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index ba382842ba..ceee0aa836 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -138,6 +138,7 @@ import Unison.Util.SyntaxText (SyntaxText') import Unison.Var (Var) import Witch (unsafeFrom) import Prelude hiding (unzip, zip, zipWith) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do @@ -245,7 +246,7 @@ doMerge info = do done (Output.MergeDefnsInLib who) -- Load Alice/Bob/LCA definitions and decl name lookups - (defns3, declNameLookups, lcaDeclToConstructors) <- do + (defns3, declNameLookups, lcaDeclNameLookup) <- do let emptyNametree = Nametree {value = Defns Map.empty Map.empty, children = Map.empty} let loadDefns branch = Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) & onLeftM \conflictedName -> @@ -270,20 +271,20 @@ doMerge info = do (aliceDefns0, aliceDeclNameLookup) <- load (Just (mergeTarget, branches.alice)) (bobDefns0, bobDeclNameLookup) <- load (Just (mergeSource, branches.bob)) lcaDefns0 <- maybe (pure emptyNametree) loadDefns branches.lca - lcaDeclToConstructors <- Cli.runTransaction (lenientCheckDeclCoherency db.loadDeclNumConstructors lcaDefns0) + lcaDeclNameLookup <- Cli.runTransaction (lenientCheckDeclCoherency db.loadDeclNumConstructors lcaDefns0) let flatten defns = Defns (flattenNametree (view #terms) defns) (flattenNametree (view #types) defns) let defns3 = flatten <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} let declNameLookups = TwoWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup} - pure (defns3, declNameLookups, lcaDeclToConstructors) + pure (defns3, declNameLookups, lcaDeclNameLookup) let defns = ThreeWay.forgetLca defns3 - liftIO (debugFunctions.debugDefns defns3 declNameLookups lcaDeclToConstructors) + liftIO (debugFunctions.debugDefns defns3 declNameLookups lcaDeclNameLookup) -- Diff LCA->Alice and LCA->Bob - diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups lcaDeclToConstructors defns3) + diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns3) liftIO (debugFunctions.debugDiffs diffs) @@ -1038,7 +1039,7 @@ data DebugFunctions = DebugFunctions debugDefns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> TwoWay DeclNameLookup -> - Map Name [Maybe Name] -> + PartialDeclNameLookup -> IO (), debugDiffs :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) -> IO (), debugCombinedDiff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> IO (), @@ -1080,7 +1081,7 @@ realDebugCausals causals = do realDebugDefns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> TwoWay DeclNameLookup -> - Map Name [Maybe Name] -> + PartialDeclNameLookup -> IO () realDebugDefns defns declNameLookups _lcaDeclNameLookup = do Text.putStrLn (Text.bold "\n=== Alice definitions ===") @@ -1200,28 +1201,28 @@ realDebugPartitionedDiff conflicts unconflicts = do renderConflicts "typeid" conflicts.bob.types (Bob ()) Text.putStrLn (Text.bold "\n=== Alice unconflicts ===") - renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.alice (OnlyAlice ()) - renderUnconflicts Text.green "+" (const "type") Reference.toText unconflicts.types.adds.alice (OnlyAlice ()) - renderUnconflicts Text.red "-" referentLabel Referent.toText unconflicts.terms.deletes.alice (OnlyAlice ()) - renderUnconflicts Text.red "-" (const "type") Reference.toText unconflicts.types.deletes.alice (OnlyAlice ()) - renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.alice (OnlyAlice ()) - renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.alice (OnlyAlice ()) + renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.alice + renderUnconflicts Text.green "+" (const "type") Reference.toText unconflicts.types.adds.alice + renderUnconflicts Text.red "-" referentLabel Referent.toText unconflicts.terms.deletes.alice + renderUnconflicts Text.red "-" (const "type") Reference.toText unconflicts.types.deletes.alice + renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.alice + renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.alice Text.putStrLn (Text.bold "\n=== Bob unconflicts ===") - renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.bob (OnlyBob ()) - renderUnconflicts Text.green "+" (const "type") Reference.toText unconflicts.types.adds.bob (OnlyBob ()) - renderUnconflicts Text.red "-" referentLabel Referent.toText unconflicts.terms.deletes.bob (OnlyBob ()) - renderUnconflicts Text.red "-" (const "type") Reference.toText unconflicts.types.deletes.bob (OnlyBob ()) - renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.bob (OnlyBob ()) - renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.bob (OnlyBob ()) + renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.bob + renderUnconflicts Text.green "+" (const "type") Reference.toText unconflicts.types.adds.bob + renderUnconflicts Text.red "-" referentLabel Referent.toText unconflicts.terms.deletes.bob + renderUnconflicts Text.red "-" (const "type") Reference.toText unconflicts.types.deletes.bob + renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.bob + renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.bob Text.putStrLn (Text.bold "\n=== Alice-and-Bob unconflicts ===") - renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.both (AliceAndBob ()) - renderUnconflicts Text.green "+" (const "type") Reference.toText unconflicts.types.adds.both (AliceAndBob ()) - renderUnconflicts Text.red "-" referentLabel Referent.toText unconflicts.terms.deletes.both (AliceAndBob ()) - renderUnconflicts Text.red "-" (const "type") Reference.toText unconflicts.types.deletes.both (AliceAndBob ()) - renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.both (AliceAndBob ()) - renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.both (AliceAndBob ()) + renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.both + renderUnconflicts Text.green "+" (const "type") Reference.toText unconflicts.types.adds.both + renderUnconflicts Text.red "-" referentLabel Referent.toText unconflicts.terms.deletes.both + renderUnconflicts Text.red "-" (const "type") Reference.toText unconflicts.types.deletes.both + renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.both + renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.both where renderConflicts :: Text -> Map Name Reference.Id -> EitherWay () -> IO () renderConflicts label conflicts who = @@ -1244,9 +1245,8 @@ realDebugPartitionedDiff conflicts unconflicts = do (ref -> Text) -> (ref -> Text) -> Map Name ref -> - EitherWayI () -> IO () - renderUnconflicts color action label renderRef unconflicts who = + renderUnconflicts color action label renderRef unconflicts = for_ (Map.toList unconflicts) \(name, ref) -> Text.putStrLn $ color $ @@ -1257,9 +1257,6 @@ realDebugPartitionedDiff conflicts unconflicts = do <> Name.toText name <> " " <> renderRef ref - <> " (" - <> (case who of OnlyAlice () -> "Alice"; OnlyBob () -> "Bob"; AliceAndBob () -> "Alice and Bob") - <> ")" realDebugDependents :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> IO () realDebugDependents dependents = do diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index a215354b3b..2a75252fcd 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -104,6 +104,7 @@ import U.Codebase.Reference (Reference' (..), TypeReference, TypeReferenceId) import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) @@ -217,21 +218,21 @@ checkDeclCoherency loadDeclNumConstructors = fullName name = Name.fromReverseSegments (name :| prefix) --- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns a mapping from decl name to --- constructor names, where constructor names can be missing. +-- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns partial decl name lookup, +-- which doesn't require a name for every constructor, and allows a constructor with a nameless decl. -- --- This function exists merely to extract a best-effort decl-name-to-constructor-name mapping for the LCA of a merge. --- We require Alice and Bob to have coherent decls, but their LCA is out of the user's control and may have incoherent --- decls, and whether or not it does, we still need to compute *some* syntactic hash for its decls. +-- This function exists merely to extract a best-effort name mapping for the LCA of a merge. We require Alice and Bob to +-- have coherent decls, but their LCA is out of the user's control and may have incoherent decls, and whether or not it +-- does, we still need to compute *some* syntactic hash for its decls. lenientCheckDeclCoherency :: forall m. Monad m => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> - m (Map Name [Maybe Name]) + m PartialDeclNameLookup lenientCheckDeclCoherency loadDeclNumConstructors = - fmap (view #declToConstructors) - . (`State.execStateT` LenientDeclCoherencyCheckState Map.empty Map.empty) + fmap (view #declNameLookup) + . (`State.execStateT` LenientDeclCoherencyCheckState Map.empty (PartialDeclNameLookup Map.empty Map.empty)) . go [] where go :: @@ -259,14 +260,14 @@ lenientCheckDeclCoherency loadDeclNumConstructors = lift (getCompose (Map.upsertF (\_ -> Compose recordNewDecl) typeRef state.expectedConstructors)) case whatHappened of UninhabitedDecl -> do - #declToConstructors %= Map.insert typeName [] + #declNameLookup . #declToConstructors %= Map.insert typeName [] pure Nothing InhabitedDecl expectedConstructors1 -> do let child = Map.findWithDefault (Nametree (Defns Map.empty Map.empty) Map.empty) name children #expectedConstructors .= expectedConstructors1 go (name : prefix) child state <- State.get - let (maybeConstructorNames, expectedConstructors) = + let (constructorNames0, expectedConstructors) = Map.alterF f typeRef state.expectedConstructors where f :: @@ -278,8 +279,21 @@ lenientCheckDeclCoherency loadDeclNumConstructors = fromJust >>> Map.deleteLookupJust typeName >>> over _2 \m -> if Map.null m then Nothing else Just m + + constructorNames :: [Maybe Name] + constructorNames = + IntMap.elems constructorNames0 + #expectedConstructors .= expectedConstructors - #declToConstructors %= Map.insert typeName (IntMap.elems maybeConstructorNames) + #declNameLookup . #constructorToDecl %= \constructorToDecl -> + List.foldl' + ( \acc -> \case + Nothing -> acc + Just constructorName -> Map.insert constructorName typeName acc + ) + constructorToDecl + constructorNames + #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames pure (Just name) where typeName = fullName name @@ -298,7 +312,7 @@ data DeclCoherencyCheckState = DeclCoherencyCheckState data LenientDeclCoherencyCheckState = LenientDeclCoherencyCheckState { expectedConstructors :: !(Map TypeReferenceId (Map Name ConstructorNames)), - declToConstructors :: !(Map Name [Maybe Name]) + declNameLookup :: !PartialDeclNameLookup } deriving stock (Generic) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index 754b36be78..1ad67238a4 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -9,6 +9,7 @@ import Data.Semialign (alignWith) import Data.Set qualified as Set import Data.These (These (..)) import U.Codebase.Reference (TypeReference) +import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration import Unison.Hash (Hash (Hash)) @@ -17,6 +18,7 @@ import Unison.Merge.Database (MergeDatabase (..)) import Unison.Merge.DeclNameLookup (DeclNameLookup) import Unison.Merge.DeclNameLookup qualified as DeclNameLookup import Unison.Merge.DiffOp (DiffOp (..)) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) import Unison.Merge.Synhash import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.ThreeWay (ThreeWay (..)) @@ -30,6 +32,7 @@ import Unison.PrettyPrintEnv (PrettyPrintEnv (..)) import Unison.PrettyPrintEnv qualified as Ppe import Unison.Reference (Reference' (..), TypeReferenceId) import Unison.Referent (Referent) +import Unison.Referent qualified as Referent import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name @@ -48,52 +51,14 @@ import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith) nameBasedNamespaceDiff :: MergeDatabase -> TwoWay DeclNameLookup -> - Map Name [Maybe Name] -> + PartialDeclNameLookup -> ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> Transaction (TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)) -nameBasedNamespaceDiff db declNameLookups lcaDeclToConstructors defns = do - lcaHashes <- - synhashDefnsWith - hashTerm - ( \name -> \case - ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) - ReferenceDerived ref -> - case sequence (lcaDeclToConstructors Map.! name) of - -- If we don't have a name for every constructor, that's okay, just use a dummy syntactic hash here. - -- This is safe; Alice/Bob can't have such a decl (it violates a merge precondition), so there's no risk - -- that we accidentally get an equal hash and classify a real update as unchanged. - Nothing -> pure (Hash mempty) - Just names -> do - decl <- loadDeclWithGoodConstructorNames names ref - pure (synhashDerivedDecl ppe name decl) - ) - defns.lca - hashes <- sequence (synhashDefns <$> declNameLookups <*> ThreeWay.forgetLca defns) +nameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns = do + lcaHashes <- synhashLcaDefns db ppe lcaDeclNameLookup defns.lca + hashes <- sequence (synhashDefns db ppe <$> declNameLookups <*> ThreeWay.forgetLca defns) pure (diffNamespaceDefns lcaHashes <$> hashes) where - synhashDefns :: - DeclNameLookup -> - Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> - Transaction (DefnsF2 (Map Name) Synhashed Referent TypeReference) - synhashDefns declNameLookup = - -- FIXME: use cache so we only synhash each thing once - synhashDefnsWith hashTerm hashType - where - hashType :: Name -> TypeReference -> Transaction Hash - hashType name = \case - ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) - ReferenceDerived ref -> do - decl <- loadDeclWithGoodConstructorNames (DeclNameLookup.expectConstructorNames declNameLookup name) ref - pure (synhashDerivedDecl ppe name decl) - - loadDeclWithGoodConstructorNames :: [Name] -> TypeReferenceId -> Transaction (Decl Symbol Ann) - loadDeclWithGoodConstructorNames names = - fmap (DataDeclaration.setConstructorNames (map Name.toVar names)) . db.loadV1Decl - - hashTerm :: Referent -> Transaction Hash - hashTerm = - synhashTerm db.loadV1Term ppe - ppe :: PrettyPrintEnv ppe = -- The order between Alice and Bob isn't important here for syntactic hashing; not sure right now if it matters @@ -102,6 +67,71 @@ nameBasedNamespaceDiff db declNameLookups lcaDeclToConstructors defns = do `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.bob `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.lca +synhashLcaDefns :: + MergeDatabase -> + PrettyPrintEnv -> + PartialDeclNameLookup -> + Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> + Transaction (DefnsF2 (Map Name) Synhashed Referent TypeReference) +synhashLcaDefns db ppe declNameLookup = + synhashDefnsWith hashReferent hashType + where + -- For the LCA only, if we don't have a name for every constructor, or we don't have a name for a decl, that's okay, + -- just use a dummy syntactic hash (e.g. where we return `Hash mempty` below in two places). + -- + -- This is safe and correct; Alice/Bob can't have such a decl (it violates a merge precondition), so there's no risk + -- that we accidentally get an equal hash and classify a real update as unchanged. + + hashReferent :: Name -> Referent -> Transaction Hash + hashReferent name = \case + Referent.Con (ConstructorReference ref _) _ -> + case Map.lookup name declNameLookup.constructorToDecl of + Nothing -> pure (Hash mempty) -- see note above + Just declName -> hashType declName ref + Referent.Ref ref -> synhashTerm db.loadV1Term ppe ref + + hashType :: Name -> TypeReference -> Transaction Hash + hashType name = \case + ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) + ReferenceDerived ref -> + case sequence (declNameLookup.declToConstructors Map.! name) of + Nothing -> pure (Hash mempty) -- see note above + Just names -> do + decl <- loadDeclWithGoodConstructorNames db names ref + pure (synhashDerivedDecl ppe name decl) + +synhashDefns :: + MergeDatabase -> + PrettyPrintEnv -> + DeclNameLookup -> + Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> + Transaction (DefnsF2 (Map Name) Synhashed Referent TypeReference) +synhashDefns db ppe declNameLookup = + -- FIXME: use cache so we only synhash each thing once + synhashDefnsWith hashReferent hashType + where + hashReferent :: Name -> Referent -> Transaction Hash + hashReferent name = \case + -- We say that a referent constructor *in the namespace* (distinct from a referent that is in a term body) has a + -- synhash that is simply equal to the synhash of its type declaration. This is because the type declaration and + -- constructors are changed in lock-step: it is not possible to change one, but not the other. + -- + -- For example, if Alice updates `type Foo = Bar Nat` to `type Foo = Bar Nat Nat`, we want different synhashes on + -- both the type (Foo) and the constructor (Foo.Bar). + Referent.Con (ConstructorReference ref _) _ -> hashType (DeclNameLookup.expectDeclName declNameLookup name) ref + Referent.Ref ref -> synhashTerm db.loadV1Term ppe ref + + hashType :: Name -> TypeReference -> Transaction Hash + hashType name = \case + ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) + ReferenceDerived ref -> do + decl <- loadDeclWithGoodConstructorNames db (DeclNameLookup.expectConstructorNames declNameLookup name) ref + pure (synhashDerivedDecl ppe name decl) + +loadDeclWithGoodConstructorNames :: MergeDatabase -> [Name] -> TypeReferenceId -> Transaction (Decl Symbol Ann) +loadDeclWithGoodConstructorNames db names = + fmap (DataDeclaration.setConstructorNames (map Name.toVar names)) . db.loadV1Decl + diffNamespaceDefns :: DefnsF2 (Map Name) Synhashed term typ -> DefnsF2 (Map Name) Synhashed term typ -> @@ -139,17 +169,17 @@ deepNamespaceDefinitionsToPpe Defns {terms, types} = synhashDefnsWith :: Monad m => - (term -> m Hash) -> + (Name -> term -> m Hash) -> (Name -> typ -> m Hash) -> Defns (BiMultimap term Name) (BiMultimap typ Name) -> m (DefnsF2 (Map Name) Synhashed term typ) synhashDefnsWith hashTerm hashType = do bitraverse - (traverse hashTerm1 . BiMultimap.range) + (Map.traverseWithKey hashTerm1 . BiMultimap.range) (Map.traverseWithKey hashType1 . BiMultimap.range) where - hashTerm1 term = do - hash <- hashTerm term + hashTerm1 name term = do + hash <- hashTerm name term pure (Synhashed hash term) hashType1 name typ = do diff --git a/unison-merge/src/Unison/Merge/PartialDeclNameLookup.hs b/unison-merge/src/Unison/Merge/PartialDeclNameLookup.hs new file mode 100644 index 0000000000..556ea9f5dc --- /dev/null +++ b/unison-merge/src/Unison/Merge/PartialDeclNameLookup.hs @@ -0,0 +1,15 @@ +module Unison.Merge.PartialDeclNameLookup + ( PartialDeclNameLookup (..), + ) +where + +import Unison.Name (Name) +import Unison.Prelude + +-- | Like a @DeclNameLookup@, but "partial" / more lenient - because we don't require the LCA of a merge to have a full +-- @DeclNameLookup@. +data PartialDeclNameLookup = PartialDeclNameLookup + { constructorToDecl :: !(Map Name Name), + declToConstructors :: !(Map Name [Maybe Name]) + } + deriving stock (Generic) diff --git a/unison-merge/src/Unison/Merge/Synhash.hs b/unison-merge/src/Unison/Merge/Synhash.hs index 29559690bf..6acf835a75 100644 --- a/unison-merge/src/Unison/Merge/Synhash.hs +++ b/unison-merge/src/Unison/Merge/Synhash.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DataKinds #-} + -- | Utilities for computing the "syntactic hash" of a decl or term, which is a hash that is computed after substituting -- references to other terms and decls with names from a pretty-print environment. -- @@ -35,7 +37,6 @@ import Data.Char (ord) import Data.Text qualified as Text import U.Codebase.Reference (TypeReference) import Unison.ABT qualified as ABT -import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType (ConstructorType) import Unison.ConstructorType qualified as CT import Unison.DataDeclaration (DataDeclaration, Decl) @@ -51,8 +52,9 @@ import Unison.Prelude import Unison.PrettyPrintEnv (PrettyPrintEnv) import Unison.PrettyPrintEnv qualified as PPE import Unison.Reference (Reference' (..), TypeReferenceId) -import Unison.Referent qualified as V1 (Referent) -import Unison.Referent qualified as V1.Referent +import Unison.Reference qualified as V1 +import Unison.Referent (Referent) +import Unison.Referent qualified as Referent import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar) import Unison.Term (Term) import Unison.Term qualified as Term @@ -107,7 +109,7 @@ hashConstructorNameToken declName conName = hashDerivedTerm :: Var v => PrettyPrintEnv -> Term v a -> Hash hashDerivedTerm ppe t = - H.accumulate $ isNotBuiltinTag : hashTermTokens ppe t + H.accumulate $ isNotBuiltinTag : isTermTag : hashTermTokens ppe t hashConstructorType :: ConstructorType -> Token hashConstructorType = \case @@ -138,7 +140,7 @@ hashDeclTokens ppe name decl = -- syntactic hashes. synhashDerivedDecl :: Var v => PrettyPrintEnv -> Name -> Decl v a -> Hash synhashDerivedDecl ppe name decl = - H.accumulate $ isNotBuiltinTag : hashDeclTokens ppe name decl + H.accumulate $ isNotBuiltinTag : isDeclTag : hashDeclTokens ppe name decl hashHQNameToken :: HashQualified Name -> Token hashHQNameToken = @@ -170,14 +172,14 @@ hashPatternTokens ppe = \case Pattern.Char _ c -> [H.Tag 7, H.Nat (fromIntegral (ord c))] Pattern.Constructor _ cr ps -> H.Tag 8 - : hashReferentToken ppe (V1.Referent.Con cr CT.Data) + : hashReferentToken ppe (Referent.Con cr CT.Data) : hashLengthToken ps : (ps >>= hashPatternTokens ppe) Pattern.As _ p -> H.Tag 9 : hashPatternTokens ppe p Pattern.EffectPure _ p -> H.Tag 10 : hashPatternTokens ppe p Pattern.EffectBind _ cr ps k -> H.Tag 11 - : hashReferentToken ppe (V1.Referent.Con cr CT.Effect) + : hashReferentToken ppe (Referent.Con cr CT.Effect) : hashLengthToken ps : hashPatternTokens ppe k <> (ps >>= hashPatternTokens ppe) Pattern.SequenceLiteral _ ps -> H.Tag 12 : hashLengthToken ps : (ps >>= hashPatternTokens ppe) @@ -188,36 +190,20 @@ hashPatternTokens ppe = \case Pattern.Snoc -> H.Tag 1 Pattern.Cons -> H.Tag 2 -hashReferentToken :: PrettyPrintEnv -> V1.Referent -> Token +hashReferentToken :: PrettyPrintEnv -> Referent -> Token hashReferentToken ppe = - H.Hashed . H.accumulate . hashReferentTokens ppe - -hashReferentTokens :: PrettyPrintEnv -> V1.Referent -> [Token] -hashReferentTokens ppe referent = - case referent of - -- distinguish constructor name from terms by tumbling in a name (of any alias of) its decl - V1.Referent.Con (ConstructorReference ref _i) _ct -> [hashTypeReferenceToken ppe ref, nameTok] - V1.Referent.Ref _ -> [nameTok] - where - nameTok :: Token - nameTok = - hashHQNameToken (PPE.termNameOrHashOnlyFq ppe referent) + hashHQNameToken . PPE.termNameOrHashOnlyFq ppe --- | Syntactically hash a term, using reference names rather than hashes. --- Two terms will have the same syntactic hash if they would --- print the the same way under the given pretty-print env. synhashTerm :: forall m v a. (Monad m, Var v) => (TypeReferenceId -> m (Term v a)) -> PrettyPrintEnv -> - V1.Referent -> + V1.TermReference -> m Hash synhashTerm loadTerm ppe = \case - V1.Referent.Con ref CT.Data -> pure (hashDerivedTerm ppe (Term.constructor @v () ref)) - V1.Referent.Con ref CT.Effect -> pure (hashDerivedTerm ppe (Term.request @v () ref)) - V1.Referent.Ref (ReferenceBuiltin builtin) -> pure (hashBuiltinTerm builtin) - V1.Referent.Ref (ReferenceDerived ref) -> hashDerivedTerm ppe <$> loadTerm ref + ReferenceBuiltin builtin -> pure (hashBuiltinTerm builtin) + ReferenceDerived ref -> hashDerivedTerm ppe <$> loadTerm ref hashTermTokens :: forall v a. Var v => PrettyPrintEnv -> Term v a -> [Token] hashTermTokens ppe = @@ -242,9 +228,9 @@ hashTermFTokens ppe = \case Term.Char c -> [H.Tag 5, H.Nat (fromIntegral (ord c))] Term.Blank {} -> error "tried to hash a term with blanks, something's very wrong" -- note: these are all hashed the same, just based on the name - Term.Ref r -> [H.Tag 7, hashReferentToken ppe (V1.Referent.Ref r)] - Term.Constructor cr -> [H.Tag 7, hashReferentToken ppe (V1.Referent.Con cr CT.Data)] - Term.Request cr -> [H.Tag 7, hashReferentToken ppe (V1.Referent.Con cr CT.Effect)] + Term.Ref r -> [H.Tag 7, hashReferentToken ppe (Referent.Ref r)] + Term.Constructor cr -> [H.Tag 7, hashReferentToken ppe (Referent.Con cr CT.Data)] + Term.Request cr -> [H.Tag 7, hashReferentToken ppe (Referent.Con cr CT.Effect)] Term.Handle {} -> [H.Tag 8] Term.App {} -> [H.Tag 9] Term.Ann _ ty -> H.Tag 10 : hashTypeTokens ppe ty diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index 84baab088f..ab6bebe3db 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -26,6 +26,7 @@ library Unison.Merge.EitherWay Unison.Merge.EitherWayI Unison.Merge.Libdeps + Unison.Merge.PartialDeclNameLookup Unison.Merge.PartitionCombinedDiffs Unison.Merge.Synhash Unison.Merge.Synhashed diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 9808153561..9436ae5232 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -14,7 +14,7 @@ contains both additions. ## Basic merge: two unconflicted adds ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm:hide @@ -56,7 +56,7 @@ project/alice> view foo bar If Alice and Bob also happen to add the same definition, that's not a conflict. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins project/main> branch alice ``` @@ -97,7 +97,7 @@ project/alice> view foo bar Updates that occur in one branch are propagated to the other. In this example, Alice updates `foo`, while Bob adds a new dependent `bar` of the original `foo`. When Bob's branch is merged into Alice's, her update to `foo` is propagated to his `bar`. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -152,7 +152,7 @@ We classify something as an update if its "syntactic hash"—not its normal Unis Let's see an example. We have `foo`, which depends on `bar` and `baz`. Alice updates `bar` (propagating to `foo`), and Bob updates `baz` (propagating to `foo`). When we merge their updates, both updates will be reflected in the final `foo`. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -216,7 +216,7 @@ project/alice> display foo Of course, it's also possible for Alice's update to propagate to one of Bob's updates. In this example, `foo` depends on `bar` which depends on `baz`. Alice updates `baz`, propagating to `bar` and `foo`, while Bob updates `bar` (to something that still depends on `foo`), propagating to `baz`. The merged result will have Alice's update to `foo` incorporated into Bob's updated `bar`, and both updates will propagate to `baz`. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -286,7 +286,7 @@ project/alice> display foo We don't currently consider "update + delete" a conflict like Git does. In this situation, the delete is just ignored, allowing the update to proceed. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -333,7 +333,7 @@ In a future version, we'd like to give the user a warning at least. Library dependencies don't cause merge conflicts, the library dependencies are just unioned together. If two library dependencies have the same name but different namespace hashes, then the merge algorithm makes up two fresh names. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Alice's adds: @@ -387,7 +387,7 @@ project/alice> view foo bar baz If Bob is equals Alice, then merging Bob into Alice looks like this. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm @@ -405,7 +405,7 @@ project/alice> merge /bob If Bob is behind Alice, then merging Bob into Alice looks like this. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm @@ -433,7 +433,7 @@ project/alice> merge /bob If Bob is ahead of Alice, then merging Bob into Alice looks like this. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm @@ -465,7 +465,7 @@ This can cause merge failures due to out-of-scope identifiers, and the user may In this example, Alice deletes `foo`, while Bob adds a new dependent of `foo`. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -508,7 +508,7 @@ It may be Alice's and Bob's changes merge together cleanly in the sense that the In this example, Alice updates a `Text` to a `Nat`, while Bob adds a new dependent of the `Text`. Upon merging, propagating Alice's update to Bob's dependent causes a typechecking failure. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -557,7 +557,7 @@ Alice and Bob may disagree about the definition of a term. In this case, the con are presented to the user to resolve. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -621,7 +621,7 @@ project/merge-bob-into-alice> view bar baz Ditto for types; if the hashes don't match, it's a conflict. In this example, Alice and Bob do different things to the same constructor. However, any explicit changes to the same type will result in a conflict, including changes that could concievably be merged (e.g. Alice and Bob both add a new constructor, or edit different constructors). ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -664,7 +664,7 @@ project/alice> merge /bob We model the renaming of a type's constructor as an update, so if Alice updates a type and Bob renames one of its constructors (even without changing its structure), we consider it a conflict. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -707,7 +707,7 @@ project/alice> merge /bob Here is another example demonstrating that constructor renames are modeled as updates. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -745,7 +745,7 @@ project/alice> merge bob A constructor on one side can conflict with a regular term definition on the other. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm:hide @@ -786,7 +786,7 @@ project/alice> merge bob Here's a subtle situation where a new type is added on each side of the merge, and an existing term is replaced with a constructor of one of the types. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -835,7 +835,7 @@ project/alice> merge bob Here's a more involved example that demonstrates the same idea. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` In the LCA, we have a type with two constructors, and some term. @@ -914,7 +914,7 @@ which is a parse error. We will resolve this situation automatically in a future version. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm:hide @@ -961,7 +961,7 @@ After merge conflicts are resolved, you can use `merge.commit` rather than `swit ```ucm:hide .> project.create-empty project -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -1026,7 +1026,7 @@ project/alice> branches ```ucm:hide .> project.create-empty project -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm @@ -1051,7 +1051,7 @@ There are a number of conditions under which we can't perform a merge, and the u If `foo` and `bar` are aliases in the nearest common ancestor, but not in Alice's branch, then we don't know whether to update Bob's dependents to Alice's `foo` or Alice's `bar` (and vice-versa). ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -1108,7 +1108,7 @@ conflict involving a builtin, we can't perform a merge. One way to fix this in the future would be to introduce a syntax for defining aliases in the scratch file. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm:hide @@ -1117,7 +1117,7 @@ project/main> branch alice Alice's branch: ```ucm -project/alice> alias.type builtin.Nat MyNat +project/alice> alias.type lib.builtins.Nat MyNat ``` Bob's branch: @@ -1146,7 +1146,7 @@ project/alice> merge /bob Each naming of a decl may not have more than one name for each constructor, within the decl's namespace. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm:hide @@ -1192,7 +1192,7 @@ project/alice> merge /bob Each naming of a decl must have a name for each constructor, within the decl's namespace. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Alice's branch: @@ -1239,7 +1239,7 @@ project/alice> merge /bob A decl cannot be aliased within the namespace of another of its aliased. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Alice's branch: @@ -1287,7 +1287,7 @@ project/alice> merge /bob Constructors may only exist within the corresponding decl's namespace. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Alice's branch: @@ -1331,7 +1331,7 @@ project/alice> merge bob By convention, `lib` can only namespaces; each of these represents a library dependencies. Individual terms and types are not allowed at the top level of `lib`. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Alice's branch: @@ -1375,7 +1375,7 @@ Here's an example. We'll delete a constructor name from the LCA and still be abl together. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` LCA: @@ -1439,7 +1439,7 @@ project/alice> merge /bob ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```unison @@ -1477,3 +1477,44 @@ project/alice> merge /bob ```ucm:hide .> project.delete project ``` + +### Delete a constructor + + +```ucm:hide +project/main> builtins.mergeio lib.builtins +``` + +```unison +type Foo = Bar | Baz +``` + +```ucm +project/main> add +project/main> branch topic +``` + +```unison +boop = "boop" +``` + +```ucm +project/topic> add +``` + +```unison +type Foo = Bar +``` + +```ucm +project/main> update +``` + +```ucm +project/main> merge topic +project/main> view Foo +``` + +```ucm:hide +.> project.delete project +``` diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 1ead9f4581..6334b362da 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1255,7 +1255,7 @@ One way to fix this in the future would be to introduce a syntax for defining al Alice's branch: ```ucm -project/alice> alias.type builtin.Nat MyNat +project/alice> alias.type lib.builtins.Nat MyNat Done. @@ -1696,3 +1696,100 @@ project/alice> merge /bob I merged project/bob into project/alice. ``` +### Delete a constructor + + +```unison +type Foo = Bar | Baz +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type Foo + +``` +```ucm +project/main> add + + ⍟ I've added these definitions: + + type Foo + +project/main> branch topic + + Done. I've created the topic branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic`. + +``` +```unison +boop = "boop" +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + boop : Text + +``` +```ucm +project/topic> add + + ⍟ I've added these definitions: + + boop : Text + +``` +```unison +type Foo = Bar +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These names already exist. You can `update` them to your + new definition: + + type Foo + +``` +```ucm +project/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +``` +```ucm +project/main> merge topic + + I merged project/topic into project/main. + +project/main> view Foo + + type Foo = Bar + +``` From 6ab0ebe8d7da4653eec2a23ce9ab1704e7db19df Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 20 Jun 2024 14:17:46 -0400 Subject: [PATCH 185/631] Improve Haddock for `Path` and `Name` Added some simple docs and converted some comments to Haddock. --- .../src/Unison/Codebase/Path.hs | 10 +++++++- unison-core/src/Unison/Name/Internal.hs | 25 ++++++++++--------- 2 files changed, 22 insertions(+), 13 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Path.hs b/parser-typechecker/src/Unison/Codebase/Path.hs index 516a6c86f6..390c1b1a6a 100644 --- a/parser-typechecker/src/Unison/Codebase/Path.hs +++ b/parser-typechecker/src/Unison/Codebase/Path.hs @@ -100,7 +100,12 @@ import Unison.Prelude hiding (empty, toList) import Unison.Syntax.Name qualified as Name (toText, unsafeParseText) import Unison.Util.List qualified as List --- `Foo.Bar.baz` becomes ["Foo", "Bar", "baz"] +-- | A `Path` is an internal structure representing some namespace in the codebase. +-- +-- @Foo.Bar.baz@ becomes @["Foo", "Bar", "baz"]@. +-- +-- __NB__: This shouldn’t be exposed outside of this module (prefer`Path'`, `Absolute`, or `Relative`), but it’s +-- currently used pretty widely. Such usage should be replaced when encountered. newtype Path = Path {toSeq :: Seq NameSegment} deriving stock (Eq, Ord) deriving newtype (Semigroup, Monoid) @@ -112,10 +117,13 @@ instance GHC.IsList Path where toList (Path segs) = Foldable.toList segs fromList = Path . Seq.fromList +-- | A namespace path that starts from the root. newtype Absolute = Absolute {unabsolute :: Path} deriving (Eq, Ord) +-- | A namespace path that doesn’t necessarily start from the root. newtype Relative = Relative {unrelative :: Path} deriving (Eq, Ord) +-- | A namespace that may be either absolute or relative, This is the most general type that should be used. newtype Path' = Path' {unPath' :: Either Absolute Relative} deriving (Eq, Ord) diff --git a/unison-core/src/Unison/Name/Internal.hs b/unison-core/src/Unison/Name/Internal.hs index fcd855001e..3272d43df1 100644 --- a/unison-core/src/Unison/Name/Internal.hs +++ b/unison-core/src/Unison/Name/Internal.hs @@ -21,21 +21,22 @@ import Unison.Position (Position (..)) import Unison.Prelude import Unison.Util.Alphabetical --- | A name is an absolute-or-relative non-empty list of name segments. +-- | A name is an absolute-or-relative non-empty list of name segments. It is used to represent the path to a +-- definition. +-- +-- A few example names: +-- +-- - "foo.bar" --> Name Relative ("bar" :| ["foo"]) +-- - ".foo.bar" --> Name Absolute ("bar" :| ["foo"]) +-- - "|>.<|" --> Name Relative ("<|" :| ["|>"]) +-- - "." --> Name Relative ("." :| []) +-- - ".." --> Name Absolute (".." :| []) data Name - = -- A few example names: - -- - -- "foo.bar" --> Name Relative ["bar", "foo"] - -- ".foo.bar" --> Name Absolute ["bar", "foo"] - -- "|>.<|" --> Name Relative ["<|", "|>"] - -- "." --> Name Relative ["."] - -- ".." --> Name Absolute ["."] - -- - Name - -- whether the name is positioned absolutely (to some arbitrary root namespace), or relatively + = Name Position - -- the name segments in reverse order + -- ^ whether the name is positioned absolutely (to some arbitrary root namespace), or relatively (List.NonEmpty NameSegment) + -- ^ the name segments in reverse order deriving stock (Eq, Generic, Show) -- | Compare names (kinda) alphabetically: absolute comes before relative, but otherwise compare the name segments From 9e7a9376696eb4f2eaa898a255361e547e3ead32 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 20 Jun 2024 16:19:55 -0400 Subject: [PATCH 186/631] add todo.md transcript --- unison-src/transcripts/todo.md | 27 +++++++++++++ unison-src/transcripts/todo.output.md | 55 +++++++++++++++++++++++++++ 2 files changed, 82 insertions(+) create mode 100644 unison-src/transcripts/todo.md create mode 100644 unison-src/transcripts/todo.output.md diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md new file mode 100644 index 0000000000..8478e4f298 --- /dev/null +++ b/unison-src/transcripts/todo.md @@ -0,0 +1,27 @@ +# Conflicted names + +The todo command shows conflicted names (not demonstrated here yet because it is not easy to create them for tests, yet). + +# Direct dependencies without names + +The `todo` command shows hashes of direct dependencies of local (outside `lib`) definitions that don't have names in +the current namespace. + +```ucm:hide +project/main> builtins.mergeio lib.builtins +``` + +```unison +foo.bar = 15 +baz = foo.bar + foo.bar +``` + +```ucm +project/main> add +project/main> delete.namespace.force foo +project/main> todo +``` + +```ucm:hide +project/main> delete.project project +``` diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md new file mode 100644 index 0000000000..7f3affeb12 --- /dev/null +++ b/unison-src/transcripts/todo.output.md @@ -0,0 +1,55 @@ +# Conflicted names + +The todo command shows conflicted names (not demonstrated here yet because it is not easy to create them for tests, yet). + +# Direct dependencies without names + +The `todo` command shows hashes of direct dependencies of local (outside `lib`) definitions that don't have names in +the current namespace. + +```unison +foo.bar = 15 +baz = foo.bar + foo.bar +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + baz : Nat + foo.bar : Nat + +``` +```ucm +project/main> add + + ⍟ I've added these definitions: + + baz : Nat + foo.bar : Nat + +project/main> delete.namespace.force foo + + Done. + + ⚠️ + + Of the things I deleted, the following are still used in the + following definitions. They now contain un-named references. + + Dependency Referenced In + bar 1. baz + +project/main> todo + + These terms do not have any names in the current namespace: + + 1. #1jujb8oelv + +``` From f4f55b9b4516ef01335907119eb84b68b0bbc5b8 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 20 Jun 2024 17:00:42 -0400 Subject: [PATCH 187/631] Support branch-relative paths for `docs.to-html` Fixes #4402. --- .../src/Unison/Codebase/Editor/HandleInput.hs | 2 +- .../src/Unison/Codebase/Editor/Input.hs | 2 +- .../src/Unison/CommandLine/InputPatterns.hs | 14 ++-- unison-src/transcripts/fix4402.md | 20 +++++ unison-src/transcripts/fix4402.output.md | 75 +++++++++++++++++++ 5 files changed, 105 insertions(+), 8 deletions(-) create mode 100644 unison-src/transcripts/fix4402.md create mode 100644 unison-src/transcripts/fix4402.output.md diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 491cdccea5..a86887313d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -470,7 +470,7 @@ loop e = do Cli.respond $ Output.MarkdownOut (Text.intercalate "\n---\n" mdText) DocsToHtmlI namespacePath' sourceDirectory -> do Cli.Env {codebase, sandboxedRuntime} <- ask - absPath <- Cli.resolvePath' namespacePath' + absPath <- ProjectUtils.branchRelativePathToAbsolute namespacePath' branch <- liftIO $ Codebase.getBranchAtPath codebase absPath _evalErrs <- liftIO $ (Backend.docsInBranchToHtmlFiles sandboxedRuntime codebase branch sourceDirectory) pure () diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index efcc2be7e6..c372f07d69 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -208,7 +208,7 @@ data Input | ApiI | UiI Path' | DocToMarkdownI Name - | DocsToHtmlI Path' FilePath + | DocsToHtmlI BranchRelativePath FilePath | AuthLoginI | VersionI | ProjectCreateI Bool {- try downloading base? -} (Maybe ProjectName) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 65c2c80e13..fbf57765c7 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2768,19 +2768,21 @@ docsToHtml = "docs.to-html" [] I.Visible - [("namespace", Required, namespaceArg), ("", Required, filePathArg)] + [("namespace", Required, branchRelativePathArg), ("", Required, filePathArg)] ( P.wrapColumn2 - [ ( "`docs.to-html .path.to.namespace ~/path/to/file/output`", - "Render all docs contained within a namespace, no matter how deep," - <> "to html files on a file path" + [ ( makeExample docsToHtml [".path.to.ns", "doc-dir"], + "Render all docs contained within the namespace `.path.to.ns`, no matter how deep, to html files in `doc-dir` in the directory UCM was run from." + ), + ( makeExample docsToHtml ["project0/branch0:a.path", "/tmp/doc-dir"], + "Renders all docs anywhere in the namespace `a.path` from `branch0` of `project0` to html in `/tmp/doc-dir`." ) ] ) \case [namespacePath, destinationFilePath] -> Input.DocsToHtmlI - <$> handlePath'Arg namespacePath - <*> unsupportedStructuredArgument "a file name" destinationFilePath + <$> handleBranchRelativePathArg namespacePath + <*> unsupportedStructuredArgument "a directory name" destinationFilePath _ -> Left $ showPatternHelp docsToHtml docToMarkdown :: InputPattern diff --git a/unison-src/transcripts/fix4402.md b/unison-src/transcripts/fix4402.md new file mode 100644 index 0000000000..e79d243e5c --- /dev/null +++ b/unison-src/transcripts/fix4402.md @@ -0,0 +1,20 @@ +```ucm +.> project.create test-4402 +test-4402/main> builtins.merge +``` + +```unison +{{A doc directly in the namespace.}} +some.ns.direct = 1 + +{{A doc pretty deeply nested in the namespace.}} +some.ns.pretty.deeply.nested = 2 + +{{A doc outside the namespace.}} +some.outside = 3 +``` + +```ucm +test-4402/main> add +test-4402/main> docs.to-html some.ns /tmp/test-4402 +``` diff --git a/unison-src/transcripts/fix4402.output.md b/unison-src/transcripts/fix4402.output.md new file mode 100644 index 0000000000..858f6474c5 --- /dev/null +++ b/unison-src/transcripts/fix4402.output.md @@ -0,0 +1,75 @@ +```ucm +.> project.create test-4402 + + 🎉 I've created the project test-4402. + + I'll now fetch the latest version of the base Unison + library... + + Downloaded 14053 entities. + + 🎨 Type `ui` to explore this project's code in your browser. + 🔭 Discover libraries at https://share.unison-lang.org + 📖 Use `help-topic projects` to learn more about projects. + + Write your first Unison code with UCM: + + 1. Open scratch.u. + 2. Write some Unison code and save the file. + 3. In UCM, type `add` to save it to your new project. + + 🎉 🥳 Happy coding! + +test-4402/main> builtins.merge + + Done. + +``` +```unison +{{A doc directly in the namespace.}} +some.ns.direct = 1 + +{{A doc pretty deeply nested in the namespace.}} +some.ns.pretty.deeply.nested = 2 + +{{A doc outside the namespace.}} +some.outside = 3 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + some.ns.direct : Nat + some.ns.direct.doc : Doc + some.ns.pretty.deeply.nested : Nat + (also named lib.base.data.Map.internal.ratio) + some.ns.pretty.deeply.nested.doc : Doc + some.outside : Nat + (also named lib.base.data.Map.internal.delta) + some.outside.doc : Doc + +``` +```ucm +test-4402/main> add + + ⍟ I've added these definitions: + + some.ns.direct : Nat + some.ns.direct.doc : Doc + some.ns.pretty.deeply.nested : Nat + (also named lib.base.data.Map.internal.ratio) + some.ns.pretty.deeply.nested.doc : Doc + some.outside : Nat + (also named lib.base.data.Map.internal.delta) + some.outside.doc : Doc + +test-4402/main> docs.to-html some.ns /tmp/test-4402 + +``` From d4a2ed906600325fcf36232a4f3ce534c6d8027b Mon Sep 17 00:00:00 2001 From: Paul Chiusano Date: Thu, 20 Jun 2024 16:52:57 -0500 Subject: [PATCH 188/631] Switch to `foo()` with no space as preferred syntax instead of `!foo` --- .../src/Unison/Syntax/TermParser.hs | 27 +++++++++++++++++-- .../src/Unison/Syntax/TermPrinter.hs | 2 +- .../transcripts/cycle-update-1.output.md | 4 +-- .../transcripts/cycle-update-2.output.md | 2 +- .../transcripts/cycle-update-3.output.md | 2 +- .../transcripts/cycle-update-4.output.md | 6 ++--- .../transcripts/cycle-update-5.output.md | 2 +- unison-src/transcripts/delete.output.md | 2 +- unison-src/transcripts/formatter.output.md | 2 +- unison-syntax/src/Unison/Syntax/Parser.hs | 1 + 10 files changed, 37 insertions(+), 13 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 8c91633700..6682d6b872 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -38,6 +38,7 @@ import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names +import Unison.Parser.Ann qualified as Ann import Unison.Parser.Ann (Ann) import Unison.Pattern (Pattern) import Unison.Pattern qualified as Pattern @@ -48,7 +49,7 @@ import Unison.Syntax.Lexer qualified as L import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser hiding (seq) -import Unison.Syntax.Parser qualified as Parser (seq, uniqueName) +import Unison.Syntax.Parser qualified as Parser (seq, uniqueName, seq') import Unison.Syntax.TypeParser qualified as TypeParser import Unison.Term (IsTop, Term) import Unison.Term qualified as Term @@ -439,7 +440,8 @@ resolveHashQualified tok = do termLeaf :: forall m v. (Monad m, Var v) => TermP v m termLeaf = asum - [ hashQualifiedPrefixTerm, + [ forceOrFnApplication, + hashQualifiedPrefixTerm, text, char, number, @@ -991,6 +993,27 @@ bang = P.label "bang" do e <- termLeaf pure $ DD.forceTerm (ann start <> ann e) (ann start) e +forceOrFnApplication :: forall m v . (Monad m, Var v) => TermP v m +forceOrFnApplication = P.label "force" do + -- `foo sqrt(2.0)` parses as `foo (sqrt 2.0)` + -- `forkAt pool() blah` parses as `forkAt (pool ()) blah` + -- `foo max(x, y) z` parsed as `foo (max x y) z` + -- That is, parens immediately (no space) following a symbol is + -- treated as function application, but higher precedence than + -- the usual application syntax where args are separated by spaces + fn <- P.try do + r <- hashQualifiedPrefixTerm + P.lookAhead do + tok <- ann <$> openBlockWith "(" + guard (L.column (Ann.start tok) == L.column (Ann.end (ann r))) + pure r + Parser.seq' "(" (done fn) term + where + done :: Term v Ann -> Ann -> [Term v Ann] -> Term v Ann + done fn a [] = DD.forceTerm a a fn + done fn _ [arg] = Term.apps' fn [arg] + done fn _ args = Term.apps' fn args + seqOp :: (Ord v) => P v m Pattern.SeqOp seqOp = Pattern.Snoc diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index bc33c43ca2..6a70a04067 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -490,7 +490,7 @@ pretty0 (App' x (Constructor' (ConstructorReference DD.UnitRef 0)), _) | isLeaf x -> do px <- pretty0 (ac (if isBlock x then 0 else 9) Normal im doc) x pure . paren (p >= 11 || isBlock x && p >= 3) $ - fmt S.DelayForceChar (l "!") <> PP.indentNAfterNewline 1 px + px <> fmt S.DelayForceChar (l "()") (Apps' f (unsnoc -> Just (args, lastArg)), _) | isSoftHangable lastArg -> do fun <- goNormal 9 f diff --git a/unison-src/transcripts/cycle-update-1.output.md b/unison-src/transcripts/cycle-update-1.output.md index 3906248333..b5f381b73c 100644 --- a/unison-src/transcripts/cycle-update-1.output.md +++ b/unison-src/transcripts/cycle-update-1.output.md @@ -67,11 +67,11 @@ ping _ = !pong + 3 ping : 'Nat ping _ = use Nat + - !pong + 3 + pong() + 3 pong : 'Nat pong _ = use Nat + - !ping + 2 + ping() + 2 ``` diff --git a/unison-src/transcripts/cycle-update-2.output.md b/unison-src/transcripts/cycle-update-2.output.md index 6884788130..4d9639a9c4 100644 --- a/unison-src/transcripts/cycle-update-2.output.md +++ b/unison-src/transcripts/cycle-update-2.output.md @@ -70,6 +70,6 @@ ping _ = 3 pong : 'Nat pong _ = use Nat + - !ping + 2 + ping() + 2 ``` diff --git a/unison-src/transcripts/cycle-update-3.output.md b/unison-src/transcripts/cycle-update-3.output.md index 7a0a499dbc..281e389e61 100644 --- a/unison-src/transcripts/cycle-update-3.output.md +++ b/unison-src/transcripts/cycle-update-3.output.md @@ -65,6 +65,6 @@ ping = 3 pong : 'Nat pong _ = use Nat + - !#4t465jk908.1 + 2 + #4t465jk908.1() + 2 ``` diff --git a/unison-src/transcripts/cycle-update-4.output.md b/unison-src/transcripts/cycle-update-4.output.md index fd525176bf..d4b8b8030c 100644 --- a/unison-src/transcripts/cycle-update-4.output.md +++ b/unison-src/transcripts/cycle-update-4.output.md @@ -74,16 +74,16 @@ clang _ = !pong + 3 clang : 'Nat clang _ = use Nat + - !pong + 3 + pong() + 3 ping : 'Nat ping _ = use Nat + - !clang + 1 + clang() + 1 pong : 'Nat pong _ = use Nat + - !ping + 2 + ping() + 2 ``` diff --git a/unison-src/transcripts/cycle-update-5.output.md b/unison-src/transcripts/cycle-update-5.output.md index 3e3361f70c..017d92b347 100644 --- a/unison-src/transcripts/cycle-update-5.output.md +++ b/unison-src/transcripts/cycle-update-5.output.md @@ -65,7 +65,7 @@ inner.ping _ = !pong + 3 inner.ping : 'Nat inner.ping _ = use Nat + - !pong + 1 + pong() + 1 ``` The bug here is that `inner.ping` still refers to `pong` by name. But if we properly identified the nameless (in the diff --git a/unison-src/transcripts/delete.output.md b/unison-src/transcripts/delete.output.md index 05a998cc1e..02b757d4c4 100644 --- a/unison-src/transcripts/delete.output.md +++ b/unison-src/transcripts/delete.output.md @@ -486,6 +486,6 @@ pong _ = 4 Nat.+ !ping pong : 'Nat pong _ = use Nat + - 4 + !#l9uq1dpl5v.1 + 4 + #l9uq1dpl5v.1() ``` diff --git a/unison-src/transcripts/formatter.output.md b/unison-src/transcripts/formatter.output.md index 95af2a545d..5ddf656afe 100644 --- a/unison-src/transcripts/formatter.output.md +++ b/unison-src/transcripts/formatter.output.md @@ -142,7 +142,7 @@ provide a action = h = cases { ask -> resume } -> handle resume a with h { r } -> r - handle !action with h + handle action() with h Optional.doc = {{ A Doc before a type }} structural type Optional a = More Text | Some | Other a | None Nat diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 28bbdf042e..9dee6337e9 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -39,6 +39,7 @@ module Unison.Syntax.Parser run, semi, Unison.Syntax.Parser.seq, + Unison.Syntax.Parser.seq', sepBy, sepBy1, string, From 6302089b8e28579749ff13fd387fad31b62ba574 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Thu, 20 Jun 2024 18:00:16 -0400 Subject: [PATCH 189/631] drop branch filter for CI runs We had previously tried to avoid what we saw as duplicate runs of CI on each PR commit. We didn't realize (or didn't document) that the two runs represent the actual branch (`on: push`) vs a hypothetical merge (`on: pull_request`). --- .github/workflows/ci.yaml | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 35489112f1..e0649b5ef5 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -5,16 +5,10 @@ defaults: shell: bash on: - # Build on every pull request (and new PR commit) + # Run on the post-merge result of every PR commit pull_request: - # Build on new pushes to trunk (E.g. Merge commits) - # Without the branch filter, each commit on a branch with a PR is triggered twice. - # See: https://github.community/t/how-to-trigger-an-action-on-push-or-pull-request-but-not-both/16662 + # Build on the pre-merge result of every branch commit push: - branches: - - trunk - tags: - - release/* workflow_dispatch: env: From 72a05780a02e08905d6172e7be7dd38596efa91e Mon Sep 17 00:00:00 2001 From: Paul Chiusano Date: Thu, 20 Jun 2024 17:18:04 -0500 Subject: [PATCH 190/631] add round trip test case --- .../transcripts-round-trip/main.output.md | 22 ++++++++++++++----- .../reparses-with-same-hash.u | 10 ++++++++- 2 files changed, 25 insertions(+), 7 deletions(-) diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index fdeb756531..54f4cf9d53 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -24,7 +24,7 @@ So we can see the pretty-printed output: ☝️ - I added 105 definitions to the top of scratch.u + I added 106 definitions to the top of scratch.u You can edit them there, then run `update` to replace the definitions currently in this namespace. @@ -73,13 +73,13 @@ structural ability Zoink where Abort.toDefault! : a -> '{g, Abort} a ->{g} a Abort.toDefault! default thunk = h x = Abort.toDefault! (handler_1778 default x) thunk - handle !thunk with h + handle thunk() with h Abort.toOptional : '{g, Abort} a -> '{g} Optional a Abort.toOptional thunk = do toOptional! thunk Abort.toOptional! : '{g, Abort} a ->{g} Optional a -Abort.toOptional! thunk = toDefault! None do Some !thunk +Abort.toOptional! thunk = toDefault! None do Some thunk() catchAll : x -> Nat catchAll x = 99 @@ -87,7 +87,7 @@ catchAll x = 99 Decode.remainder : '{Ask (Optional Bytes)} Bytes Decode.remainder = do match ask with None -> Bytes.empty - Some b -> b Bytes.++ !Decode.remainder + Some b -> b Bytes.++ Decode.remainder() ex1 : Nat ex1 = @@ -194,7 +194,7 @@ fix_2650 = use Nat + y = 12 13 + y - !addNumbers + addNumbers() fix_2650a : tvar -> fun -> () fix_2650a tvar fun = () @@ -342,6 +342,16 @@ fix_525_exampleTerm quaffle = fix_525_exampleType : Id qualifiedName -> Id Fully.qualifiedName fix_525_exampleType z = Id (Dontcare () 19) +fnApplicationSyntax : Nat +fnApplicationSyntax = + use Nat + + Environment.default = do 1 + 1 + oog = do 2 + 2 + blah : Nat -> Float -> Nat + blah x y = x + 1 + _ = blah Environment.default() 1.0 + blah oog() (max 1.0 2.0) + Foo.bar.qux1 : Nat Foo.bar.qux1 = 42 @@ -672,7 +682,7 @@ UUID.random = do UUID 0 (0, 0) UUID.randomUUIDBytes : 'Bytes UUID.randomUUIDBytes = do - (UUID a (b, _)) = !random + (UUID a (b, _)) = random() encodeNat64be a Bytes.++ encodeNat64be b (|>) : a -> (a ->{e} b) ->{e} b diff --git a/unison-src/transcripts-round-trip/reparses-with-same-hash.u b/unison-src/transcripts-round-trip/reparses-with-same-hash.u index 09b941ff64..d719a178c3 100644 --- a/unison-src/transcripts-round-trip/reparses-with-same-hash.u +++ b/unison-src/transcripts-round-trip/reparses-with-same-hash.u @@ -542,4 +542,12 @@ fix_4384d = {{ {{ docExampleBlock 0 '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17, fix_4384e = id : x -> x id x = x - {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0) }} }} \ No newline at end of file + {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0) }} }} + +fnApplicationSyntax = + Environment.default = do 1 + 1 + oog = do 2 + 2 + blah : Nat -> Float -> Nat + blah x y = x + 1 + _ = blah Environment.default() 1.0 + blah oog() Float.max(1.0, 2.0) \ No newline at end of file From 6f26a1640150541f040caa6a615c64e5d38ad870 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 20 Jun 2024 21:40:07 -0400 Subject: [PATCH 191/631] Add `quoteCode` for printing errors This both colorizes and wraps code in backticks, in order to separate it from surrounding context. --- parser-typechecker/src/Unison/PrintError.hs | 41 +++++++++++-------- .../transcripts/error-messages.output.md | 12 +++--- .../generic-parse-errors.output.md | 2 +- 3 files changed, 30 insertions(+), 25 deletions(-) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 77dcdd0b0a..56bf11fcfd 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -126,6 +126,10 @@ styleAnnotated sty a = (,sty) <$> rangeForAnnotated a style :: s -> String -> Pretty (AnnotatedText s) style sty str = Pr.lit . AT.annotate sty $ fromString str +-- | Applies the color highlighting for `Code`, but also quotes the code, to separate it from the containing context. +quoteCode :: String -> Pretty ColorText +quoteCode = Pr.backticked . style Code + stylePretty :: Color -> Pretty ColorText -> Pretty ColorText stylePretty = Pr.map . AT.annotate @@ -1368,21 +1372,21 @@ renderParseErrors s = \case <> excerpt L.InvalidWordyId id -> Pr.lines - [ "The identifier " <> style Code id <> " isn't valid syntax: ", + [ "The identifier, " <> quoteCode id <> ", isn't valid syntax: ", "", excerpt, "Here's a few examples of valid syntax: " - <> style Code "abba1'" + <> quoteCode "abba1'" <> ", " - <> style Code "snake_case" + <> quoteCode "snake_case" <> ", " - <> style Code "Foo.zoink!" + <> quoteCode "Foo.zoink!" <> ", and " - <> style Code "🌻" + <> quoteCode "🌻" ] L.ReservedWordyId id -> Pr.lines - [ "The identifier " <> style Code id <> " used here is a reserved keyword: ", + [ "The identifier, " <> quoteCode id <> ", used here is a reserved keyword: ", "", excerpt, Pr.wrap $ @@ -1392,19 +1396,19 @@ renderParseErrors s = \case ] L.InvalidSymbolyId id -> Pr.lines - [ "The infix identifier " <> style Code id <> " isn’t valid syntax: ", + [ "The infix identifier, " <> quoteCode id <> ", isn’t valid syntax: ", "", excerpt, "Here are a few valid examples: " - <> style Code "++" + <> quoteCode "++" <> ", " - <> style Code "Float./" + <> quoteCode "Float./" <> ", and " - <> style Code "`List.map`" + <> quoteCode "List.map" ] L.ReservedSymbolyId id -> Pr.lines - [ "The identifier " <> style Code id <> " is reserved by Unison and can't be used as an operator: ", + [ "The identifier, " <> quoteCode id <> ", is reserved by Unison and can't be used as an operator: ", "", excerpt ] @@ -1458,11 +1462,12 @@ renderParseErrors s = \case "", excerpt, Pr.wrap $ - "I was expecting some digits after the '.'," - <> "for example: " - <> style Code (n <> "0") + "I was expecting some digits after the " + <> quoteCode "." + <> ", for example: " + <> quoteCode (n <> "0") <> "or" - <> Pr.group (style Code (n <> "1e37") <> ".") + <> Pr.group (quoteCode (n <> "1e37") <> ".") ] L.MissingExponent n -> Pr.lines @@ -1472,7 +1477,7 @@ renderParseErrors s = \case Pr.wrap $ "I was expecting some digits for the exponent," <> "for example: " - <> Pr.group (style Code (n <> "37") <> ".") + <> Pr.group (quoteCode (n <> "37") <> ".") ] L.TextLiteralMissingClosingQuote _txt -> Pr.lines @@ -1488,7 +1493,7 @@ renderParseErrors s = \case "", "I only know about the following escape characters:", "", - let s ch = style Code (fromString $ "\\" <> [ch]) + let s ch = quoteCode (fromString $ "\\" <> [ch]) in Pr.indentN 2 $ intercalateMap "," s (fst <$> L.escapeChars) ] L.LayoutError -> @@ -1719,7 +1724,7 @@ renderParseErrors s = \case let msg = mconcat [ "This looks like the start of an expression here but I was expecting a binding.", - "\nDid you mean to use a single " <> style Code ":", + "\nDid you mean to use a single " <> quoteCode ":", " here for a type signature?", "\n\n", tokenAsErrorSite s t diff --git a/unison-src/transcripts/error-messages.output.md b/unison-src/transcripts/error-messages.output.md index eb01548045..dacc86ac7a 100644 --- a/unison-src/transcripts/error-messages.output.md +++ b/unison-src/transcripts/error-messages.output.md @@ -19,8 +19,8 @@ x = 1. -- missing some digits after the decimal 1 | x = 1. -- missing some digits after the decimal - I was expecting some digits after the '.', for example: 1.0 or - 1.1e37. + I was expecting some digits after the `.` , for example: `1.0` + or `1.1e37`. ``` ```unison @@ -36,7 +36,7 @@ x = 1e -- missing an exponent 1 | x = 1e -- missing an exponent I was expecting some digits for the exponent, for example: - 1e37. + `1e37`. ``` ```unison @@ -52,7 +52,7 @@ x = 1e- -- missing an exponent 1 | x = 1e- -- missing an exponent I was expecting some digits for the exponent, for example: - 1e-37. + `1e-37`. ``` ```unison @@ -68,7 +68,7 @@ x = 1E+ -- missing an exponent 1 | x = 1E+ -- missing an exponent I was expecting some digits for the exponent, for example: - 1e+37. + `1e+37`. ``` ### Hex, octal, and bytes literals @@ -343,7 +343,7 @@ use.keyword.in.namespace = 1 Loading changes detected in scratch.u. - The identifier namespace used here is a reserved keyword: + The identifier, `namespace`, used here is a reserved keyword: 1 | use.keyword.in.namespace = 1 diff --git a/unison-src/transcripts/generic-parse-errors.output.md b/unison-src/transcripts/generic-parse-errors.output.md index 039a1fb002..3a1c7b19ec 100644 --- a/unison-src/transcripts/generic-parse-errors.output.md +++ b/unison-src/transcripts/generic-parse-errors.output.md @@ -30,7 +30,7 @@ namespace.blah = 1 Loading changes detected in scratch.u. - The identifier namespace used here is a reserved keyword: + The identifier, `namespace`, used here is a reserved keyword: 1 | namespace.blah = 1 From 91dc53d246459a7fada00393ab79e7809c081b25 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 21 Jun 2024 01:42:26 -0400 Subject: [PATCH 192/631] Remove a very lawless type class `Convert` mostly just hides some rather unsavory (but at least not partial) mappings between types. --- .../src/Unison/Codebase/Path.hs | 37 +------------------ unison-cli/src/Unison/Cli/MonadUtils.hs | 4 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 20 +++++----- .../Codebase/Editor/HandleInput/MoveTerm.hs | 6 +-- .../Codebase/Editor/HandleInput/MoveType.hs | 6 +-- .../Unison/CommandLine/BranchRelativePath.hs | 4 +- .../src/Unison/CommandLine/InputPatterns.hs | 8 +++- unison-core/src/Unison/HashQualified'.hs | 10 +---- unison-core/src/Unison/HashQualified.hs | 8 +--- unison-core/src/Unison/Name.hs | 4 -- unison-core/src/Unison/NamesWithHistory.hs | 2 +- unison-core/src/Unison/Term.hs | 5 ++- unison-core/src/Unison/Type/Names.hs | 3 +- 13 files changed, 36 insertions(+), 81 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Path.hs b/parser-typechecker/src/Unison/Codebase/Path.hs index 516a6c86f6..b849d6bc8d 100644 --- a/parser-typechecker/src/Unison/Codebase/Path.hs +++ b/parser-typechecker/src/Unison/Codebase/Path.hs @@ -43,7 +43,7 @@ module Unison.Codebase.Path isRoot, isRoot', - -- * things that could be replaced with `Convert` instances + -- * conversions absoluteToPath', fromList, fromName, @@ -76,8 +76,6 @@ module Unison.Codebase.Path -- * things that could be replaced with `Snoc` instances snoc, unsnoc, - -- This should be moved to a common util module, or we could use the 'witch' package. - Convert (..), ) where @@ -93,7 +91,7 @@ import Data.Sequence qualified as Seq import Data.Text qualified as Text import GHC.Exts qualified as GHC import Unison.HashQualified' qualified as HQ' -import Unison.Name (Convert (..), Name) +import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.Prelude hiding (empty, toList) @@ -534,34 +532,3 @@ instance Resolve Absolute HQSplit HQSplitAbsolute where instance Resolve Absolute Path' Absolute where resolve _ (AbsolutePath' a) = a resolve a (RelativePath' r) = resolve a r - -instance Convert Absolute Path where convert = unabsolute - -instance Convert Absolute Path' where convert = absoluteToPath' - -instance Convert Absolute Text where convert = toText' . absoluteToPath' - -instance Convert Relative Text where convert = toText . unrelative - -instance Convert Absolute String where convert = Text.unpack . convert - -instance Convert Relative String where convert = Text.unpack . convert - -instance Convert [NameSegment] Path where convert = fromList - -instance Convert Path [NameSegment] where convert = toList - -instance Convert HQSplit (HQ'.HashQualified Path) where convert = unsplitHQ - -instance Convert HQSplit' (HQ'.HashQualified Path') where convert = unsplitHQ' - -instance Convert Name Split where - convert = splitFromName - -instance Convert (path, NameSegment) (path, HQ'.HQSegment) where - convert (path, name) = - (path, HQ'.fromName name) - -instance (Convert path0 path1) => Convert (path0, name) (path1, name) where - convert = - over _1 convert diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 5aa583ee4c..a397a3b093 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -481,7 +481,7 @@ updateRoot new reason = getTermsAt :: (Path.Absolute, HQ'.HQSegment) -> Cli (Set Referent) getTermsAt path = do rootBranch0 <- getRootBranch0 - pure (BranchUtil.getTerm (Path.convert path) rootBranch0) + pure (BranchUtil.getTerm (first Path.unabsolute path) rootBranch0) ------------------------------------------------------------------------------------------------------------------------ -- Getting types @@ -489,7 +489,7 @@ getTermsAt path = do getTypesAt :: (Path.Absolute, HQ'.HQSegment) -> Cli (Set TypeReference) getTypesAt path = do rootBranch0 <- getRootBranch0 - pure (BranchUtil.getType (Path.convert path) rootBranch0) + pure (BranchUtil.getType (first Path.unabsolute path) rootBranch0) ------------------------------------------------------------------------------------------------------------------------ -- Getting patches diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 491cdccea5..dc73a118cc 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -352,7 +352,7 @@ loop e = do Left hash -> (,WhichBranchEmptyHash hash) <$> Cli.resolveShortCausalHash hash Right path' -> do absPath <- ProjectUtils.branchRelativePathToAbsolute path' - let srcp = Path.convert absPath + let srcp = Path.AbsolutePath' absPath srcb <- Cli.expectBranchAtPath' srcp pure (srcb, WhichBranchEmptyPath srcp) description <- inputDescription input @@ -492,11 +492,11 @@ loop e = do hqLength <- Cli.runTransaction Codebase.hashLength pure (DeleteNameAmbiguous hqLength name srcTerms Set.empty) dest <- Cli.resolveSplit' dest' - destTerms <- Cli.getTermsAt (Path.convert dest) + destTerms <- Cli.getTermsAt (HQ'.NameOnly <$> dest) when (not (Set.null destTerms)) do Cli.returnEarly (TermAlreadyExists dest' destTerms) description <- inputDescription input - Cli.stepAt description (BranchUtil.makeAddTermName (Path.convert dest) srcTerm) + Cli.stepAt description (BranchUtil.makeAddTermName (first Path.unabsolute dest) srcTerm) Cli.respond Success AliasTypeI src' dest' -> do src <- traverseOf _Right Cli.resolveSplit' src' @@ -515,11 +515,11 @@ loop e = do hqLength <- Cli.runTransaction Codebase.hashLength pure (DeleteNameAmbiguous hqLength name Set.empty srcTypes) dest <- Cli.resolveSplit' dest' - destTypes <- Cli.getTypesAt (Path.convert dest) + destTypes <- Cli.getTypesAt (HQ'.NameOnly <$> dest) when (not (Set.null destTypes)) do Cli.returnEarly (TypeAlreadyExists dest' destTypes) description <- inputDescription input - Cli.stepAt description (BranchUtil.makeAddTypeName (Path.convert dest) srcType) + Cli.stepAt description (BranchUtil.makeAddTypeName (first Path.unabsolute dest) srcType) Cli.respond Success -- this implementation will happily produce name conflicts, @@ -621,9 +621,9 @@ loop e = do guidPath <- Cli.resolveSplit' (authorPath' |> NameSegment.guidSegment) Cli.stepManyAt description - [ BranchUtil.makeAddTermName (Path.convert authorPath) (d authorRef), - BranchUtil.makeAddTermName (Path.convert copyrightHolderPath) (d copyrightHolderRef), - BranchUtil.makeAddTermName (Path.convert guidPath) (d guidRef) + [ BranchUtil.makeAddTermName (first Path.unabsolute authorPath) (d authorRef), + BranchUtil.makeAddTermName (first Path.unabsolute copyrightHolderPath) (d copyrightHolderRef), + BranchUtil.makeAddTermName (first Path.unabsolute guidPath) (d guidRef) ] currentPath <- Cli.getCurrentPath finalBranch <- Cli.getCurrentBranch0 @@ -1624,7 +1624,7 @@ checkDeletes typesTermsTuples doutput inputs = do (Path.HQSplit', Set Reference, Set Referent) -> Cli (Path.Split, Name, Set Reference, Set Referent) toSplitName hq = do - resolvedPath <- Path.convert <$> Cli.resolveSplit' (HQ'.toName <$> hq ^. _1) + resolvedPath <- first Path.unabsolute <$> Cli.resolveSplit' (HQ'.toName <$> hq ^. _1) return (resolvedPath, Path.unsafeToName (Path.unsplit resolvedPath), hq ^. _2, hq ^. _3) -- get the splits and names with terms and types splitsNames <- traverse toSplitName typesTermsTuples @@ -1771,7 +1771,7 @@ docsI src = do (codebaseByName) Lastly check for `foo.doc` in the codebase and if found do `display foo.doc` -} dotDoc :: HQ.HashQualified Name - dotDoc = Name.convert . Name.joinDot src $ Name.fromSegment NameSegment.docSegment + dotDoc = HQ.NameOnly . Name.joinDot src $ Name.fromSegment NameSegment.docSegment findInScratchfileByName :: Cli () findInScratchfileByName = do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs index 374e58ac56..c329060303 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs @@ -26,14 +26,14 @@ moveTermSteps src' dest' = do Cli.returnEarly (Output.DeleteNameAmbiguous hqLength src' srcTerms Set.empty) [srcTerm] -> do dest <- Cli.resolveSplit' dest' - destTerms <- Cli.getTermsAt (Path.convert dest) + destTerms <- Cli.getTermsAt (HQ'.NameOnly <$> dest) when (not (Set.null destTerms)) do Cli.returnEarly (Output.TermAlreadyExists dest' destTerms) - let p = Path.convert src + let p = first Path.unabsolute src pure [ -- Mitchell: throwing away any hash-qualification here seems wrong! BranchUtil.makeDeleteTermName (over _2 HQ'.toName p) srcTerm, - BranchUtil.makeAddTermName (Path.convert dest) srcTerm + BranchUtil.makeAddTermName (first Path.unabsolute dest) srcTerm ] doMoveTerm :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli () diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs index 95f3ba09b5..bdf9fe88cd 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs @@ -26,14 +26,14 @@ moveTypeSteps src' dest' = do Cli.returnEarly (Output.DeleteNameAmbiguous hqLength src' Set.empty srcTypes) [srcType] -> do dest <- Cli.resolveSplit' dest' - destTypes <- Cli.getTypesAt (Path.convert dest) + destTypes <- Cli.getTypesAt (HQ'.NameOnly <$> dest) when (not (Set.null destTypes)) do Cli.returnEarly (Output.TypeAlreadyExists dest' destTypes) - let p = Path.convert src + let p = first Path.unabsolute src pure [ -- Mitchell: throwing away any hash-qualification here seems wrong! BranchUtil.makeDeleteTypeName (over _2 HQ'.toName p) srcType, - BranchUtil.makeAddTypeName (Path.convert dest) srcType + BranchUtil.makeAddTypeName (first Path.unabsolute dest) srcType ] doMoveType :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli () diff --git a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs index a999edbbe0..7e0a0682ac 100644 --- a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs +++ b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs @@ -63,13 +63,13 @@ instance From BranchRelativePath Text where That path -> Text.Builder.run ( Text.Builder.char ':' - <> Text.Builder.text (Path.convert path) + <> Text.Builder.text (Path.toText' $ Path.RelativePath' path) ) These eitherProj path -> Text.Builder.run ( Text.Builder.text (eitherProjToText eitherProj) <> Text.Builder.char ':' - <> Text.Builder.text (Path.convert path) + <> Text.Builder.text (Path.toText' $ Path.RelativePath' path) ) LoosePath path -> Path.toText' path where diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 65c2c80e13..54b65279d2 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -3837,7 +3837,8 @@ branchRelativePathSuggestions config inputStr codebase _httpClient currentPath = Just projectBranch -> do let branchPath = review ProjectUtils.projectBranchPathPrism (projectAndBranch, mempty) projectAndBranch = ProjectAndBranch (projectBranch ^. #projectId) (projectBranch ^. #branchId) - map prefixPathSep <$> prefixCompleteNamespace (Path.convert relPath) branchPath + map prefixPathSep + <$> prefixCompleteNamespace (Text.unpack . Path.toText' $ Path.RelativePath' relPath) branchPath BranchRelativePath.IncompletePath projStuff mpath -> do Codebase.runTransaction codebase do mprojectBranch <- runMaybeT do @@ -3853,7 +3854,10 @@ branchRelativePathSuggestions config inputStr codebase _httpClient currentPath = Just (projectBranch, prefix) -> do let branchPath = review ProjectUtils.projectBranchPathPrism (projectAndBranch, mempty) projectAndBranch = ProjectAndBranch (projectBranch ^. #projectId) (projectBranch ^. #branchId) - map (addBranchPrefix prefix) <$> prefixCompleteNamespace (maybe "" Path.convert mpath) branchPath + map (addBranchPrefix prefix) + <$> prefixCompleteNamespace + (maybe "" (Text.unpack . Path.toText' . Path.RelativePath') mpath) + branchPath where (mayCurrentProjectId, mayCurrentBranchId) = case projectContextFromPath currentPath of LooseCodePath {} -> (Nothing, Nothing) diff --git a/unison-core/src/Unison/HashQualified'.hs b/unison-core/src/Unison/HashQualified'.hs index 48bacfc6d1..90659df641 100644 --- a/unison-core/src/Unison/HashQualified'.hs +++ b/unison-core/src/Unison/HashQualified'.hs @@ -2,7 +2,7 @@ module Unison.HashQualified' where import Data.Text qualified as Text import Unison.HashQualified qualified as HQ -import Unison.Name (Convert, Name, Parse) +import Unison.Name (Name, Parse) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.Prelude @@ -114,13 +114,5 @@ instance (Name.Alphabetical n) => Name.Alphabetical (HashQualified n) where compareAlphabetical HashQualified {} NameOnly {} = GT compareAlphabetical (HashQualified n sh) (HashQualified n2 sh2) = Name.compareAlphabetical n n2 <> compare sh sh2 -instance (Convert n n2) => Parse (HashQualified n) n2 where - parse = \case - NameOnly n -> Just (Name.convert n) - _ -> Nothing - -instance Convert (HashQualified n) (HQ.HashQualified n) where - convert = toHQ - instance Parse (HQ.HashQualified n) (HashQualified n) where parse = fromHQ diff --git a/unison-core/src/Unison/HashQualified.hs b/unison-core/src/Unison/HashQualified.hs index cc1a0aa548..d143dc4740 100644 --- a/unison-core/src/Unison/HashQualified.hs +++ b/unison-core/src/Unison/HashQualified.hs @@ -3,7 +3,7 @@ module Unison.HashQualified where import Data.Text qualified as Text import Unison.ConstructorReference (ConstructorReference) import Unison.ConstructorReference qualified as ConstructorReference -import Unison.Name (Convert, Name) +import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Prelude hiding (fromString) import Unison.Reference (Reference) @@ -139,9 +139,3 @@ instance (Name.Alphabetical n) => Name.Alphabetical (HashQualified n) where (Nothing, Just _) -> LT -- prefer NameOnly to HashQualified (Just _, Nothing) -> GT (Just sh, Just sh2) -> compare sh sh2 - -instance (Convert n n2) => Convert (HashQualified n) (HashQualified n2) where - convert = fmap Name.convert - -instance Convert n (HashQualified n) where - convert = NameOnly diff --git a/unison-core/src/Unison/Name.hs b/unison-core/src/Unison/Name.hs index 30f4f6d59a..570519e452 100644 --- a/unison-core/src/Unison/Name.hs +++ b/unison-core/src/Unison/Name.hs @@ -1,6 +1,5 @@ module Unison.Name ( Name, - Convert (..), Parse (..), -- * Basic construction @@ -571,9 +570,6 @@ commonPrefix x@(Name p1 _) y@(Name p2 _) | a == b = a : commonPrefix' as bs commonPrefix' _ _ = [] -class Convert a b where - convert :: a -> b - class Parse a b where parse :: a -> Maybe b diff --git a/unison-core/src/Unison/NamesWithHistory.hs b/unison-core/src/Unison/NamesWithHistory.hs index 5ba7ea72fa..7e2d126ec4 100644 --- a/unison-core/src/Unison/NamesWithHistory.hs +++ b/unison-core/src/Unison/NamesWithHistory.hs @@ -225,7 +225,7 @@ longestTermName :: Int -> Referent -> Names -> HQ.HashQualified Name longestTermName length r ns = case reverse (termNamesByLength length r ns) of [] -> HQ.take length (HQ.fromReferent r) - (h : _) -> Name.convert h + (h : _) -> HQ'.toHQ h termName :: Int -> Referent -> Names -> Set (HQ'.HashQualified Name) termName length r names = diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index acde4533fb..73df6fc3ae 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -19,6 +19,7 @@ import Unison.Blank qualified as B import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) import Unison.ConstructorType qualified as CT import Unison.DataDeclaration.ConstructorId (ConstructorId) +import Unison.HashQualified qualified as HQ import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name qualified as Name @@ -160,14 +161,14 @@ bindNames unsafeVarToName keepFreeTerms ns e = do -- !_ = trace "bindNames.free type vars: " () -- !_ = traceShow $ fst <$> freeTyVars okTm :: (v, a) -> Names.ResolutionResult v a (v, Term v a) - okTm (v, a) = case Names.lookupHQTerm Names.IncludeSuffixes (Name.convert $ unsafeVarToName v) ns of + okTm (v, a) = case Names.lookupHQTerm Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns of rs | Set.size rs == 1 -> pure (v, fromReferent a $ Set.findMin rs) | otherwise -> case NES.nonEmptySet rs of Nothing -> Left (pure (Names.TermResolutionFailure v a Names.NotFound)) Just refs -> Left (pure (Names.TermResolutionFailure v a (Names.Ambiguous ns refs))) - okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes (Name.convert $ unsafeVarToName v) ns of + okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns of rs | Set.size rs == 1 -> pure (v, Type.ref a $ Set.findMin rs) | otherwise -> case NES.nonEmptySet rs of diff --git a/unison-core/src/Unison/Type/Names.hs b/unison-core/src/Unison/Type/Names.hs index a88a913c66..5451406cdd 100644 --- a/unison-core/src/Unison/Type/Names.hs +++ b/unison-core/src/Unison/Type/Names.hs @@ -6,6 +6,7 @@ where import Data.Set qualified as Set import Data.Set.NonEmpty qualified as NES import Unison.ABT qualified as ABT +import Unison.HashQualified qualified as HQ import Unison.Name qualified as Name import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names @@ -24,7 +25,7 @@ bindNames :: Names.ResolutionResult v a (Type v a) bindNames unsafeVarToName keepFree ns t = let fvs = ABT.freeVarOccurrences keepFree t - rs = [(v, a, Names.lookupHQType Names.IncludeSuffixes (Name.convert $ unsafeVarToName v) ns) | (v, a) <- fvs] + rs = [(v, a, Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns) | (v, a) <- fvs] ok (v, a, rs) = if Set.size rs == 1 then pure (v, Set.findMin rs) From 8b12645745f066304d8d0c87d81769d29aa45a3f Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 21 Jun 2024 01:55:43 -0400 Subject: [PATCH 193/631] Remove an even more lawless type class At least `Parse` was unused. --- unison-core/src/Unison/HashQualified'.hs | 5 +---- unison-core/src/Unison/Name.hs | 7 ------- unison-syntax/src/Unison/Syntax/HashQualified'.hs | 6 +----- unison-syntax/src/Unison/Syntax/HashQualified.hs | 6 +----- 4 files changed, 3 insertions(+), 21 deletions(-) diff --git a/unison-core/src/Unison/HashQualified'.hs b/unison-core/src/Unison/HashQualified'.hs index 90659df641..b1ea8c1deb 100644 --- a/unison-core/src/Unison/HashQualified'.hs +++ b/unison-core/src/Unison/HashQualified'.hs @@ -2,7 +2,7 @@ module Unison.HashQualified' where import Data.Text qualified as Text import Unison.HashQualified qualified as HQ -import Unison.Name (Name, Parse) +import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.Prelude @@ -113,6 +113,3 @@ instance (Name.Alphabetical n) => Name.Alphabetical (HashQualified n) where compareAlphabetical NameOnly {} HashQualified {} = LT compareAlphabetical HashQualified {} NameOnly {} = GT compareAlphabetical (HashQualified n sh) (HashQualified n2 sh2) = Name.compareAlphabetical n n2 <> compare sh sh2 - -instance Parse (HQ.HashQualified n) (HashQualified n) where - parse = fromHQ diff --git a/unison-core/src/Unison/Name.hs b/unison-core/src/Unison/Name.hs index 570519e452..371a567e66 100644 --- a/unison-core/src/Unison/Name.hs +++ b/unison-core/src/Unison/Name.hs @@ -1,6 +1,5 @@ module Unison.Name ( Name, - Parse (..), -- * Basic construction cons, @@ -569,9 +568,3 @@ commonPrefix x@(Name p1 _) y@(Name p2 _) commonPrefix' (a : as) (b : bs) | a == b = a : commonPrefix' as bs commonPrefix' _ _ = [] - -class Parse a b where - parse :: a -> Maybe b - -instance (Parse a a2, Parse b b2) => Parse (a, b) (a2, b2) where - parse (a, b) = (,) <$> parse a <*> parse b diff --git a/unison-syntax/src/Unison/Syntax/HashQualified'.hs b/unison-syntax/src/Unison/Syntax/HashQualified'.hs index 56fb96304b..de5c4bfeab 100644 --- a/unison-syntax/src/Unison/Syntax/HashQualified'.hs +++ b/unison-syntax/src/Unison/Syntax/HashQualified'.hs @@ -17,17 +17,13 @@ import Text.Megaparsec (ParsecT) import Text.Megaparsec qualified as P import Text.Megaparsec.Internal qualified as P (withParsecT) import Unison.HashQualified' qualified as HQ' -import Unison.Name (Name, Parse) -import Unison.Name qualified as Name +import Unison.Name (Name) import Unison.Prelude hiding (fromString) import Unison.Syntax.Lexer.Token (Token) import Unison.Syntax.Name qualified as Name (nameP, toText) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.ShortHash qualified as ShortHash (shortHashP) -instance Parse Text (HQ'.HashQualified Name) where - parse = parseText - ------------------------------------------------------------------------------------------------------------------------ -- String conversions diff --git a/unison-syntax/src/Unison/Syntax/HashQualified.hs b/unison-syntax/src/Unison/Syntax/HashQualified.hs index cb7175555a..e90d8c6cb7 100644 --- a/unison-syntax/src/Unison/Syntax/HashQualified.hs +++ b/unison-syntax/src/Unison/Syntax/HashQualified.hs @@ -22,8 +22,7 @@ import Text.Megaparsec.Internal qualified as P (withParsecT) import Unison.HashQualified (HashQualified (..)) import Unison.HashQualified qualified as HashQualified import Unison.HashQualified' qualified as HQ' -import Unison.Name (Name, Parse) -import Unison.Name qualified as Name +import Unison.Name (Name) import Unison.Prelude hiding (fromString) import Unison.Syntax.HashQualified' qualified as HQ' import Unison.Syntax.Lexer.Token (Token) @@ -34,9 +33,6 @@ import Unison.Var (Var) import Unison.Var qualified as Var import Prelude hiding (take) -instance Parse Text (HashQualified Name) where - parse = parseText - parseText :: Text -> Maybe (HashQualified Name) parseText text = eitherToMaybe (P.runParser parser "" (Text.unpack text)) From ff05361e402595c2c744ab1bba8cdfab4feac02e Mon Sep 17 00:00:00 2001 From: Paul Chiusano Date: Fri, 21 Jun 2024 08:48:08 -0500 Subject: [PATCH 194/631] update transcripts --- unison-src/transcripts-manual/rewrites.output.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-src/transcripts-manual/rewrites.output.md b/unison-src/transcripts-manual/rewrites.output.md index a4764c7735..415330f135 100644 --- a/unison-src/transcripts-manual/rewrites.output.md +++ b/unison-src/transcripts-manual/rewrites.output.md @@ -183,7 +183,7 @@ woot1to2 x = wootEx : Nat ->{Woot2} Nat wootEx a = - _ = !Woot2.woot2 + _ = Woot2.woot2() blah2 blah = 123 @@ -198,7 +198,7 @@ After adding the rewritten form to the codebase, here's the rewritten `Woot1` to wootEx : Nat ->{Woot2} Nat wootEx a = - _ = !woot2 + _ = woot2() blah2 ``` From 58818242a3b03d1a2ee8661bfebfa2af015a3f8e Mon Sep 17 00:00:00 2001 From: Paul Chiusano Date: Fri, 21 Jun 2024 09:41:32 -0500 Subject: [PATCH 195/631] reduce scope of PR to just `!foo` vs `foo()`, refresh transcripts --- .../src/Unison/Syntax/TermParser.hs | 32 +++++++------------ .../reparses-with-same-hash.u | 2 +- 2 files changed, 12 insertions(+), 22 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 6682d6b872..044a29ead5 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -49,7 +49,7 @@ import Unison.Syntax.Lexer qualified as L import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser hiding (seq) -import Unison.Syntax.Parser qualified as Parser (seq, uniqueName, seq') +import Unison.Syntax.Parser qualified as Parser (seq, uniqueName) import Unison.Syntax.TypeParser qualified as TypeParser import Unison.Term (IsTop, Term) import Unison.Term qualified as Term @@ -440,7 +440,7 @@ resolveHashQualified tok = do termLeaf :: forall m v. (Monad m, Var v) => TermP v m termLeaf = asum - [ forceOrFnApplication, + [ force, hashQualifiedPrefixTerm, text, char, @@ -993,26 +993,16 @@ bang = P.label "bang" do e <- termLeaf pure $ DD.forceTerm (ann start <> ann e) (ann start) e -forceOrFnApplication :: forall m v . (Monad m, Var v) => TermP v m -forceOrFnApplication = P.label "force" do - -- `foo sqrt(2.0)` parses as `foo (sqrt 2.0)` +force :: forall m v . (Monad m, Var v) => TermP v m +force = P.label "force" $ P.try do -- `forkAt pool() blah` parses as `forkAt (pool ()) blah` - -- `foo max(x, y) z` parsed as `foo (max x y) z` - -- That is, parens immediately (no space) following a symbol is - -- treated as function application, but higher precedence than - -- the usual application syntax where args are separated by spaces - fn <- P.try do - r <- hashQualifiedPrefixTerm - P.lookAhead do - tok <- ann <$> openBlockWith "(" - guard (L.column (Ann.start tok) == L.column (Ann.end (ann r))) - pure r - Parser.seq' "(" (done fn) term - where - done :: Term v Ann -> Ann -> [Term v Ann] -> Term v Ann - done fn a [] = DD.forceTerm a a fn - done fn _ [arg] = Term.apps' fn [arg] - done fn _ args = Term.apps' fn args + -- That is, empty parens immediately (no space) following a symbol + -- is treated as high precedence function application of `Unit` + fn <- hashQualifiedPrefixTerm + tok <- ann <$> openBlockWith "(" + guard (L.column (Ann.start tok) == L.column (Ann.end (ann fn))) + close <- closeBlock + pure $ DD.forceTerm (ann fn <> ann close) (tok <> ann close) fn seqOp :: (Ord v) => P v m Pattern.SeqOp seqOp = diff --git a/unison-src/transcripts-round-trip/reparses-with-same-hash.u b/unison-src/transcripts-round-trip/reparses-with-same-hash.u index d719a178c3..6add4b6e25 100644 --- a/unison-src/transcripts-round-trip/reparses-with-same-hash.u +++ b/unison-src/transcripts-round-trip/reparses-with-same-hash.u @@ -550,4 +550,4 @@ fnApplicationSyntax = blah : Nat -> Float -> Nat blah x y = x + 1 _ = blah Environment.default() 1.0 - blah oog() Float.max(1.0, 2.0) \ No newline at end of file + blah oog() (Float.max 1.0 2.0) \ No newline at end of file From 0c2e8c5193fa210483bd6ee2a080dcc760cc88f3 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 21 Jun 2024 13:52:58 -0400 Subject: [PATCH 196/631] bugfix: don't emit virtual semis inside { or [ --- unison-syntax/src/Unison/Syntax/Lexer.hs | 8 +++++++- unison-syntax/test/Main.hs | 8 +++++++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 9938e2e41c..e17074b519 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -224,7 +224,7 @@ token'' tok p = do pops p = do env <- S.get let l = layout env - if top l == column p && topBlockName l /= Just "(" -- don't emit virtual semis inside parens + if top l == column p && topContainsVirtualSemis l then pure [Token (Semi True) p p] else if column p > top l || topHasClosePair l @@ -234,6 +234,12 @@ token'' tok p = do then S.put (env {layout = pop l}) >> ((Token Close p p :) <$> pops p) else error "impossible" + -- don't emit virtual semis in (, {, or [ blocks + topContainsVirtualSemis :: Layout -> Bool + topContainsVirtualSemis = \case + [] -> False + ((name, _) : _) -> name /= "(" && name /= "{" && name /= "[" + topHasClosePair :: Layout -> Bool topHasClosePair [] = False topHasClosePair ((name, _) : _) = diff --git a/unison-syntax/test/Main.hs b/unison-syntax/test/Main.hs index e566b52609..3b3319567d 100644 --- a/unison-syntax/test/Main.hs +++ b/unison-syntax/test/Main.hs @@ -210,7 +210,13 @@ test = [Textual "test escaped quotes \"in quotes\""], t "\"\\n \\t \\b \\a\"" [Textual "\n \t \b \a"], -- Delayed string - t "'\"\"" [Reserved "'", Textual ""] + t "'\"\"" [Reserved "'", Textual ""], + -- https://github.com/unisonweb/unison/issues/4683 + -- don't emit virtual semis in ability lists or normal lists + t "{foo\n,bar}" [Open "{", simpleWordyId "foo", Reserved ",", simpleWordyId "bar", Close], + t "{foo\n ,bar}" [Open "{", simpleWordyId "foo", Reserved ",", simpleWordyId "bar", Close], + t "[foo\n,bar]" [Open "[", simpleWordyId "foo", Reserved ",", simpleWordyId "bar", Close], + t "[foo\n ,bar]" [Open "[", simpleWordyId "foo", Reserved ",", simpleWordyId "bar", Close] ] t :: String -> [Lexeme] -> Test () From b96044c2692cbb38c8c2202ffde98c31c37693a4 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 21 Jun 2024 15:37:56 -0400 Subject: [PATCH 197/631] add `alias.term.force` --- .../src/Unison/Codebase/Editor/HandleInput.hs | 8 +- .../src/Unison/Codebase/Editor/Input.hs | 2 +- .../src/Unison/CommandLine/InputPatterns.hs | 31 +++-- unison-src/transcripts/alias-term.md | 30 +++++ unison-src/transcripts/alias-term.output.md | 108 ++++++++++++++++++ 5 files changed, 166 insertions(+), 13 deletions(-) create mode 100644 unison-src/transcripts/alias-term.md create mode 100644 unison-src/transcripts/alias-term.output.md diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index dc73a118cc..9e01500cd8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -474,7 +474,7 @@ loop e = do branch <- liftIO $ Codebase.getBranchAtPath codebase absPath _evalErrs <- liftIO $ (Backend.docsInBranchToHtmlFiles sandboxedRuntime codebase branch sourceDirectory) pure () - AliasTermI src' dest' -> do + AliasTermI force src' dest' -> do Cli.Env {codebase} <- ask src <- traverseOf _Right Cli.resolveSplit' src' srcTerms <- @@ -493,7 +493,7 @@ loop e = do pure (DeleteNameAmbiguous hqLength name srcTerms Set.empty) dest <- Cli.resolveSplit' dest' destTerms <- Cli.getTermsAt (HQ'.NameOnly <$> dest) - when (not (Set.null destTerms)) do + when (not force && not (Set.null destTerms)) do Cli.returnEarly (TermAlreadyExists dest' destTerms) description <- inputDescription input Cli.stepAt description (BranchUtil.makeAddTermName (first Path.unabsolute dest) srcTerm) @@ -998,10 +998,10 @@ inputDescription input = ResetRootI src0 -> do src <- hp' src0 pure ("reset-root " <> src) - AliasTermI src0 dest0 -> do + AliasTermI force src0 dest0 -> do src <- hhqs' src0 dest <- ps' dest0 - pure ("alias.term " <> src <> " " <> dest) + pure ((if force then "alias.term.force " else "alias.term ") <> src <> " " <> dest) AliasTypeI src0 dest0 -> do src <- hhqs' src0 dest <- ps' dest0 diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index efcc2be7e6..fb968dc5af 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -132,7 +132,7 @@ data Input -- > names .foo.bar#asdflkjsdf -- > names #sdflkjsdfhsdf NamesI IsGlobal (HQ.HashQualified Name) - | AliasTermI HashOrHQSplit' Path.Split' + | AliasTermI !Bool HashOrHQSplit' Path.Split' -- bool = force? | AliasTypeI HashOrHQSplit' Path.Split' | AliasManyI [Path.HQSplit] Path' | MoveAllI Path.Path' Path.Path' diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 54b65279d2..7f5bc46dc6 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1397,14 +1397,28 @@ deleteBranch = aliasTerm :: InputPattern aliasTerm = InputPattern - "alias.term" - [] - I.Visible - [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)] - "`alias.term foo bar` introduces `bar` with the same definition as `foo`." - $ \case - [oldName, newName] -> Input.AliasTermI <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName - _ -> Left . warn $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`." + { patternName = "alias.term", + aliases = [], + visibility = I.Visible, + args = [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)], + help = "`alias.term foo bar` introduces `bar` with the same definition as `foo`.", + parse = \case + [oldName, newName] -> Input.AliasTermI False <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + _ -> Left . warn $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`." + } + +aliasTermForce :: InputPattern +aliasTermForce = + InputPattern + { patternName = "alias.term.force", + aliases = [], + visibility = I.Hidden, + args = [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)], + help = "`alias.term.force foo bar` introduces `bar` with the same definition as `foo`.", + parse = \case + [oldName, newName] -> Input.AliasTermI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + _ -> Left . warn $ P.wrap "`alias.term.force` takes two arguments, like `alias.term.force oldname newname`." + } aliasType :: InputPattern aliasType = @@ -3296,6 +3310,7 @@ validInputs = [ add, aliasMany, aliasTerm, + aliasTermForce, aliasType, api, authLogin, diff --git a/unison-src/transcripts/alias-term.md b/unison-src/transcripts/alias-term.md new file mode 100644 index 0000000000..b9a3a5e4a9 --- /dev/null +++ b/unison-src/transcripts/alias-term.md @@ -0,0 +1,30 @@ +`alias.term` makes a new name for a term. + +```ucm:hide +project/main> builtins.mergeio lib.builtins +``` + +```ucm +project/main> alias.term lib.builtins.bug foo +project/main> ls +project/main> reflog +``` + +It won't create a conflicted name, though. + +```ucm:error +project/main> alias.term lib.builtins.todo foo +``` + +```ucm +project/main> ls +project/main> reflog +``` + +You can use `alias.term.force` for that. + +```ucm +project/main> alias.term.force lib.builtins.todo foo +project/main> ls +project/main> reflog +``` diff --git a/unison-src/transcripts/alias-term.output.md b/unison-src/transcripts/alias-term.output.md new file mode 100644 index 0000000000..16b0648706 --- /dev/null +++ b/unison-src/transcripts/alias-term.output.md @@ -0,0 +1,108 @@ +`alias.term` makes a new name for a term. + +```ucm +project/main> alias.term lib.builtins.bug foo + + Done. + +project/main> ls + + 1. foo (a -> b) + 2. lib/ (643 terms, 92 types) + +project/main> reflog + + Here is a log of the root namespace hashes, starting with the + most recent, along with the command that got us there. Try: + + `fork 2 .old` + `fork #akvmucsmam .old` to make an old namespace + accessible again, + + `reset-root #akvmucsmam` to reset the root namespace and + its history to that of the + specified namespace. + + When Root Hash Action + 1. now #94cs49dp5a alias.term .__projects._f3c06c2f_7513_4da4_87a2_5b7860d8895f... + 2. now #akvmucsmam builtins.mergeio .__projects._f3c06c2f_7513_4da4_87a2_5b7860... + 3. #sg60bvjo91 history starts here + + Tip: Use `diff.namespace 1 7` to compare namespaces between + two points in history. + +``` +It won't create a conflicted name, though. + +```ucm +project/main> alias.term lib.builtins.todo foo + + ⚠️ + + A term by that name already exists. + +``` +```ucm +project/main> ls + + 1. foo (a -> b) + 2. lib/ (643 terms, 92 types) + +project/main> reflog + + Here is a log of the root namespace hashes, starting with the + most recent, along with the command that got us there. Try: + + `fork 2 .old` + `fork #akvmucsmam .old` to make an old namespace + accessible again, + + `reset-root #akvmucsmam` to reset the root namespace and + its history to that of the + specified namespace. + + When Root Hash Action + 1. now #94cs49dp5a alias.term .__projects._f3c06c2f_7513_4da4_87a2_5b7860d8895f... + 2. now #akvmucsmam builtins.mergeio .__projects._f3c06c2f_7513_4da4_87a2_5b7860... + 3. #sg60bvjo91 history starts here + + Tip: Use `diff.namespace 1 7` to compare namespaces between + two points in history. + +``` +You can use `alias.term.force` for that. + +```ucm +project/main> alias.term.force lib.builtins.todo foo + + Done. + +project/main> ls + + 1. foo (a -> b) + 2. foo (a -> b) + 3. lib/ (643 terms, 92 types) + +project/main> reflog + + Here is a log of the root namespace hashes, starting with the + most recent, along with the command that got us there. Try: + + `fork 2 .old` + `fork #94cs49dp5a .old` to make an old namespace + accessible again, + + `reset-root #94cs49dp5a` to reset the root namespace and + its history to that of the + specified namespace. + + When Root Hash Action + 1. now #agpq4mvdbu alias.term.force .__projects._f3c06c2f_7513_4da4_87a2_5b7860... + 2. now #94cs49dp5a alias.term .__projects._f3c06c2f_7513_4da4_87a2_5b7860d8895f... + 3. now #akvmucsmam builtins.mergeio .__projects._f3c06c2f_7513_4da4_87a2_5b7860... + 4. #sg60bvjo91 history starts here + + Tip: Use `diff.namespace 1 7` to compare namespaces between + two points in history. + +``` From db3d0e73b35aab4e694e81ce35b029cffb0625df Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 21 Jun 2024 16:09:50 -0400 Subject: [PATCH 198/631] delete `reflog` calls to make transcript more idempotent --- unison-src/transcripts/alias-term.md | 3 - unison-src/transcripts/alias-term.output.md | 64 --------------------- 2 files changed, 67 deletions(-) diff --git a/unison-src/transcripts/alias-term.md b/unison-src/transcripts/alias-term.md index b9a3a5e4a9..cd4f7454ae 100644 --- a/unison-src/transcripts/alias-term.md +++ b/unison-src/transcripts/alias-term.md @@ -7,7 +7,6 @@ project/main> builtins.mergeio lib.builtins ```ucm project/main> alias.term lib.builtins.bug foo project/main> ls -project/main> reflog ``` It won't create a conflicted name, though. @@ -18,7 +17,6 @@ project/main> alias.term lib.builtins.todo foo ```ucm project/main> ls -project/main> reflog ``` You can use `alias.term.force` for that. @@ -26,5 +24,4 @@ You can use `alias.term.force` for that. ```ucm project/main> alias.term.force lib.builtins.todo foo project/main> ls -project/main> reflog ``` diff --git a/unison-src/transcripts/alias-term.output.md b/unison-src/transcripts/alias-term.output.md index 16b0648706..733ff13849 100644 --- a/unison-src/transcripts/alias-term.output.md +++ b/unison-src/transcripts/alias-term.output.md @@ -10,27 +10,6 @@ project/main> ls 1. foo (a -> b) 2. lib/ (643 terms, 92 types) -project/main> reflog - - Here is a log of the root namespace hashes, starting with the - most recent, along with the command that got us there. Try: - - `fork 2 .old` - `fork #akvmucsmam .old` to make an old namespace - accessible again, - - `reset-root #akvmucsmam` to reset the root namespace and - its history to that of the - specified namespace. - - When Root Hash Action - 1. now #94cs49dp5a alias.term .__projects._f3c06c2f_7513_4da4_87a2_5b7860d8895f... - 2. now #akvmucsmam builtins.mergeio .__projects._f3c06c2f_7513_4da4_87a2_5b7860... - 3. #sg60bvjo91 history starts here - - Tip: Use `diff.namespace 1 7` to compare namespaces between - two points in history. - ``` It won't create a conflicted name, though. @@ -48,27 +27,6 @@ project/main> ls 1. foo (a -> b) 2. lib/ (643 terms, 92 types) -project/main> reflog - - Here is a log of the root namespace hashes, starting with the - most recent, along with the command that got us there. Try: - - `fork 2 .old` - `fork #akvmucsmam .old` to make an old namespace - accessible again, - - `reset-root #akvmucsmam` to reset the root namespace and - its history to that of the - specified namespace. - - When Root Hash Action - 1. now #94cs49dp5a alias.term .__projects._f3c06c2f_7513_4da4_87a2_5b7860d8895f... - 2. now #akvmucsmam builtins.mergeio .__projects._f3c06c2f_7513_4da4_87a2_5b7860... - 3. #sg60bvjo91 history starts here - - Tip: Use `diff.namespace 1 7` to compare namespaces between - two points in history. - ``` You can use `alias.term.force` for that. @@ -83,26 +41,4 @@ project/main> ls 2. foo (a -> b) 3. lib/ (643 terms, 92 types) -project/main> reflog - - Here is a log of the root namespace hashes, starting with the - most recent, along with the command that got us there. Try: - - `fork 2 .old` - `fork #94cs49dp5a .old` to make an old namespace - accessible again, - - `reset-root #94cs49dp5a` to reset the root namespace and - its history to that of the - specified namespace. - - When Root Hash Action - 1. now #agpq4mvdbu alias.term.force .__projects._f3c06c2f_7513_4da4_87a2_5b7860... - 2. now #94cs49dp5a alias.term .__projects._f3c06c2f_7513_4da4_87a2_5b7860d8895f... - 3. now #akvmucsmam builtins.mergeio .__projects._f3c06c2f_7513_4da4_87a2_5b7860... - 4. #sg60bvjo91 history starts here - - Tip: Use `diff.namespace 1 7` to compare namespaces between - two points in history. - ``` From e367a67d897e8d14e1a02caa683793b6d8e048aa Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Sat, 22 Jun 2024 13:37:14 +0100 Subject: [PATCH 199/631] Use a stack to keep track of section levels --- unison-syntax/src/Unison/Syntax/Lexer.hs | 48 +++++++++++++++--------- 1 file changed, 31 insertions(+), 17 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index e17074b519..eb78edb020 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -71,11 +71,18 @@ type BlockName = String type Layout = [(BlockName, Column)] data ParsingEnv = ParsingEnv - { layout :: !Layout, -- layout stack - opening :: Maybe BlockName, -- `Just b` if a block of type `b` is being opened - inLayout :: Bool, -- are we inside a construct that uses layout? - parentSection :: Int, -- 1 means we are inside a # Heading 1 - parentListColumn :: Int -- 4 means we are inside a list starting at the fourth column + { -- layout stack + layout :: !Layout, + -- `Just b` if a block of type `b` is being opened + opening :: Maybe BlockName, + -- are we inside a construct that uses layout? + inLayout :: Bool, + -- Use a stack to remember the parent section and + -- allow docSections within docSessions. + -- 1 means we are inside a # Heading 1 + parentSections :: [Int], + -- 4 means we are inside a list starting at the fourth column + parentListColumn :: Int } deriving (Show) @@ -309,7 +316,7 @@ lexer0' scope rem = (P.EndOfInput) -> "end of input" customErrs es = [Err <$> e | P.ErrorCustom e <- toList es] toPos (P.SourcePos _ line col) = Pos (P.unPos line) (P.unPos col) - env0 = ParsingEnv [] (Just scope) True 0 0 + env0 = ParsingEnv [] (Just scope) True [0] 0 -- hacky postprocessing pass to do some cleanup of stuff that's annoying to -- fix without adding more state to the lexer: -- - 1+1 lexes as [1, +1], convert this to [1, +, 1] @@ -429,13 +436,20 @@ lexemes' eof = -- Construct the token for opening the doc block. let openTok = Token (Open "syntax.docUntitledSection") openStart openEnd env0 <- S.get - -- Disable layout while parsing the doc block - (bodyToks0, closeTok) <- local (\env -> env {inLayout = False}) do - bodyToks <- body - closeStart <- posP - lit "}}" - closeEnd <- posP - pure (bodyToks, Token Close closeStart closeEnd) + -- Disable layout while parsing the doc block and reset the section number + (bodyToks0, closeTok) <- local + ( \env -> + env + { inLayout = False, + parentSections = 0 : (parentSections env0) + } + ) + do + bodyToks <- body + closeStart <- posP + lit "}}" + closeEnd <- posP + pure (bodyToks, Token Close closeStart closeEnd) let docToks = beforeStartToks <> [openTok] <> bodyToks0 <> [closeTok] -- Parse any layout tokens after the doc block, e.g. virtual semicolon endToks <- token' ignore (pure ()) @@ -814,12 +828,12 @@ lexemes' eof = -- # A section title (not a subsection) section :: P [Token Lexeme] section = wrap "syntax.docSection" $ do - n <- S.gets parentSection - hashes <- P.try $ lit (replicate n '#') *> P.takeWhile1P Nothing (== '#') <* sp + ns <- S.gets parentSections + hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp title <- paragraph <* CP.space - let m = length hashes + n + let m = length hashes + head ns body <- - local (\env -> env {parentSection = m}) $ + local (\env -> env {parentSections = (m : (tail ns))}) $ P.many (sectionElem <* CP.space) pure $ title <> join body From 25ce29301bb939c7b43b34c6ed7ea905768c5fdd Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Sat, 22 Jun 2024 13:37:32 +0100 Subject: [PATCH 200/631] add tests --- .../transcripts-round-trip/main.output.md | 55 ++++++++++++++++++- .../reparses-with-same-hash.u | 31 ++++++++++- 2 files changed, 84 insertions(+), 2 deletions(-) diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index fdeb756531..a085eba7cb 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -24,7 +24,7 @@ So we can see the pretty-printed output: ☝️ - I added 105 definitions to the top of scratch.u + I added 107 definitions to the top of scratch.u You can edit them there, then run `update` to replace the definitions currently in this namespace. @@ -331,6 +331,59 @@ fix_4384e = }} }} +fix_4729a : Doc2 +fix_4729a = + {{ + # H1A + + ## H2A + + ``` + {{ + # H1B + + ## B2B + + + }} + ``` + + ## H2A + + + }} + +fix_4729b : Doc2 +fix_4729b = + {{ + # H1A + + ## H2A + + {{ docTable + [[{{ + # HA + + + }}, {{ + # HB + + + }}], [{{ + # a + + + }}, {{ + # b + + + }}]] }} + + ## H2A + + + }} + Fix_525.bar.quaffle : Nat Fix_525.bar.quaffle = 32 diff --git a/unison-src/transcripts-round-trip/reparses-with-same-hash.u b/unison-src/transcripts-round-trip/reparses-with-same-hash.u index 09b941ff64..7c41b2d83c 100644 --- a/unison-src/transcripts-round-trip/reparses-with-same-hash.u +++ b/unison-src/transcripts-round-trip/reparses-with-same-hash.u @@ -542,4 +542,33 @@ fix_4384d = {{ {{ docExampleBlock 0 '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17, fix_4384e = id : x -> x id x = x - {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0) }} }} \ No newline at end of file + {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0) }} }} + +fix_4729a = {{ + # H1A + + ## H2A + + ``` + {{ + # H1B + + ## B2B + }} + ``` + + ## H2A +}} + +fix_4729b = {{ + # H1A + + ## H2A + + {{ docTable [ + [ {{ # HA }}, {{ # HB }} ], + [ {{ ## a }}, {{ ## b }} ] + ] }} + + ## H2A +}} From 7108787a5a7826a751d9836651a06cb286454ee0 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Sat, 22 Jun 2024 14:02:40 +0100 Subject: [PATCH 201/631] add more tests --- .../transcripts-round-trip/main.output.md | 25 ++++++++++++++++++- .../reparses-with-same-hash.u | 12 +++++++++ 2 files changed, 36 insertions(+), 1 deletion(-) diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index a085eba7cb..7b03f20f3e 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -24,7 +24,7 @@ So we can see the pretty-printed output: ☝️ - I added 107 definitions to the top of scratch.u + I added 108 definitions to the top of scratch.u You can edit them there, then run `update` to replace the definitions currently in this namespace. @@ -384,6 +384,29 @@ fix_4729b = }} +fix_4729c : Doc2 +fix_4729c = + {{ + # Examples `` + docCallout + (Some + (syntax.docUntitledSection + [syntax.docSection (syntax.docParagraph [syntax.docWord "Title"]) []])) + (syntax.docUntitledSection + [ syntax.docParagraph + [ syntax.docWord "This" + , syntax.docWord "is" + , syntax.docWord "a" + , syntax.docWord "callout" + , syntax.docWord "with" + , syntax.docWord "a" + , syntax.docWord "title" + ] + ]) `` + + + }} + Fix_525.bar.quaffle : Nat Fix_525.bar.quaffle = 32 diff --git a/unison-src/transcripts-round-trip/reparses-with-same-hash.u b/unison-src/transcripts-round-trip/reparses-with-same-hash.u index 7c41b2d83c..4209b09b1e 100644 --- a/unison-src/transcripts-round-trip/reparses-with-same-hash.u +++ b/unison-src/transcripts-round-trip/reparses-with-same-hash.u @@ -572,3 +572,15 @@ fix_4729b = {{ ## H2A }} + +fix_4729c = {{ + # Examples + ``` + docCallout + (Some + {{ + # Title + + }}) {{ This is a callout with a title }} + ``` +}} From e806225540f51854f257e7b8783adce0f3223e90 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Sat, 22 Jun 2024 17:13:40 +0100 Subject: [PATCH 202/631] Add group such that elements are concatenated without space --- parser-typechecker/src/Unison/Syntax/TermPrinter.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index bc33c43ca2..596ca1d77b 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -459,7 +459,7 @@ pretty0 go tm = goNormal 10 tm PP.hang kw <$> fmap PP.lines (traverse go rs) (Bytes' bs, _) -> - pure $ fmt S.BytesLiteral "0xs" <> PP.shown (Bytes.fromWord8s (map fromIntegral bs)) + pure $ PP.group $ fmt S.BytesLiteral "0xs" <> PP.shown (Bytes.fromWord8s (map fromIntegral bs)) BinaryAppsPred' apps lastArg -> do prettyLast <- pretty0 (ac 3 Normal im doc) lastArg prettyApps <- binaryApps apps prettyLast From 85ab99f60590119ec1d81816ad76a5cf3dd21976 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Sat, 22 Jun 2024 17:21:02 +0100 Subject: [PATCH 203/631] add test in reparses-with-same-hash # Conflicts: # unison-src/transcripts-round-trip/reparses-with-same-hash.u --- unison-src/transcripts-round-trip/reparses-with-same-hash.u | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/unison-src/transcripts-round-trip/reparses-with-same-hash.u b/unison-src/transcripts-round-trip/reparses-with-same-hash.u index 09b941ff64..0e702cc793 100644 --- a/unison-src/transcripts-round-trip/reparses-with-same-hash.u +++ b/unison-src/transcripts-round-trip/reparses-with-same-hash.u @@ -542,4 +542,6 @@ fix_4384d = {{ {{ docExampleBlock 0 '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17, fix_4384e = id : x -> x id x = x - {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0) }} }} \ No newline at end of file + {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0) }} }} + +fix_4727 = {{ `` 0xs900dc0ffee `` }} From 9c610510c1e1d21e29ccdd2e2122a16e9cc1405e Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Sat, 22 Jun 2024 18:08:33 +0100 Subject: [PATCH 204/631] update main.output.md --- unison-src/transcripts-round-trip/main.output.md | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index fdeb756531..15839be0d8 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -24,7 +24,7 @@ So we can see the pretty-printed output: ☝️ - I added 105 definitions to the top of scratch.u + I added 106 definitions to the top of scratch.u You can edit them there, then run `update` to replace the definitions currently in this namespace. @@ -331,6 +331,9 @@ fix_4384e = }} }} +fix_4727 : Doc2 +fix_4727 = {{ `` 0xs900dc0ffee `` }} + Fix_525.bar.quaffle : Nat Fix_525.bar.quaffle = 32 From d4946ed22c990866a6cac9f6643849e845fd9718 Mon Sep 17 00:00:00 2001 From: Ed Date: Sat, 22 Jun 2024 20:03:24 +0100 Subject: [PATCH 205/631] Fix typo Co-authored-by: Arya Irani <538571+aryairani@users.noreply.github.com> --- unison-syntax/src/Unison/Syntax/Lexer.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index eb78edb020..2a5e2506ae 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -78,7 +78,7 @@ data ParsingEnv = ParsingEnv -- are we inside a construct that uses layout? inLayout :: Bool, -- Use a stack to remember the parent section and - -- allow docSections within docSessions. + -- allow docSections within docSections. -- 1 means we are inside a # Heading 1 parentSections :: [Int], -- 4 means we are inside a list starting at the fourth column From 3a9e8e51a09e037f40c77a61191f268af480ff7b Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Sun, 23 Jun 2024 19:34:27 -0500 Subject: [PATCH 206/631] Test that `docs.to-html` actually writes files --- .github/workflows/ci.yaml | 10 +++++++++- .github/workflows/update-transcripts.yaml | 3 +++ scripts/check.sh | 1 + .../fix4402.md => transcripts-manual/docs.to-html.md} | 8 ++++---- .../docs.to-html.output.md} | 10 +++++----- .../transcripts-manual/docs.to-html/direct/doc.html | 1 + .../docs.to-html/pretty/deeply/nested/doc.html | 1 + 7 files changed, 24 insertions(+), 10 deletions(-) rename unison-src/{transcripts/fix4402.md => transcripts-manual/docs.to-html.md} (56%) rename unison-src/{transcripts/fix4402.output.md => transcripts-manual/docs.to-html.output.md} (88%) create mode 100644 unison-src/transcripts-manual/docs.to-html/direct/doc.html create mode 100644 unison-src/transcripts-manual/docs.to-html/pretty/deeply/nested/doc.html diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 35489112f1..91fac8abea 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -270,6 +270,14 @@ jobs: ${{env.transcripts}} # Fail if any transcripts cause git diffs. git diff --ignore-cr-at-eol --exit-code unison-src/transcripts + - name: docs.to-html + if: steps.cache-transcript-test-results.outputs.cache-hit != 'true' + run: | + ${{env.ucm}} transcript unison-src/transcripts-manual/docs.to-html.md + # Fail if the output or generated docs differ. + git diff --ignore-cr-at-eol --exit-code \ + unison-src/transcripts-manual/docs.to-html.output.md \ + unison-src/transcripts-manual/docs.to-html - name: mark transcripts as passing if: steps.cache-transcript-test-results.outputs.cache-hit != 'true' run: | @@ -417,7 +425,7 @@ jobs: build-jit-binary: name: build jit binary needs: generate-jit-source - uses: ./.github/workflows/ci-build-jit-binary.yaml + uses: ./.github/workflows/ci-build-jit-binary.yaml test-jit: name: test jit diff --git a/.github/workflows/update-transcripts.yaml b/.github/workflows/update-transcripts.yaml index 3c35e9f04f..68b7ec1e92 100644 --- a/.github/workflows/update-transcripts.yaml +++ b/.github/workflows/update-transcripts.yaml @@ -36,6 +36,9 @@ jobs: stack exec unison transcript unison-src/transcripts-manual/rewrites.md - name: transcripts run: stack exec transcripts + - name: docs.to-html + run: | + stack exec unison transcript unison-src/transcripts-manual/docs.to-html.md - name: save transcript changes uses: stefanzweifel/git-auto-commit-action@v5 with: diff --git a/scripts/check.sh b/scripts/check.sh index 03bb6609f9..1784f69c6d 100755 --- a/scripts/check.sh +++ b/scripts/check.sh @@ -6,4 +6,5 @@ true \ && stack exec transcripts \ && stack exec unison transcript unison-src/transcripts-round-trip/main.md \ && stack exec unison transcript unison-src/transcripts-manual/rewrites.md \ + && stack exec unison transcript unison-src/transcripts-manual/docs.to-html.md \ && stack exec cli-integration-tests diff --git a/unison-src/transcripts/fix4402.md b/unison-src/transcripts-manual/docs.to-html.md similarity index 56% rename from unison-src/transcripts/fix4402.md rename to unison-src/transcripts-manual/docs.to-html.md index e79d243e5c..528d038e49 100644 --- a/unison-src/transcripts/fix4402.md +++ b/unison-src/transcripts-manual/docs.to-html.md @@ -1,6 +1,6 @@ ```ucm -.> project.create test-4402 -test-4402/main> builtins.merge +.> project.create test-html-docs +test-html-docs/main> builtins.merge ``` ```unison @@ -15,6 +15,6 @@ some.outside = 3 ``` ```ucm -test-4402/main> add -test-4402/main> docs.to-html some.ns /tmp/test-4402 +test-html-docs/main> add +test-html-docs/main> docs.to-html some.ns unison-src/transcripts-manual/docs.to-html ``` diff --git a/unison-src/transcripts/fix4402.output.md b/unison-src/transcripts-manual/docs.to-html.output.md similarity index 88% rename from unison-src/transcripts/fix4402.output.md rename to unison-src/transcripts-manual/docs.to-html.output.md index 858f6474c5..bdfc5fa4a6 100644 --- a/unison-src/transcripts/fix4402.output.md +++ b/unison-src/transcripts-manual/docs.to-html.output.md @@ -1,7 +1,7 @@ ```ucm -.> project.create test-4402 +.> project.create test-html-docs - 🎉 I've created the project test-4402. + 🎉 I've created the project test-html-docs. I'll now fetch the latest version of the base Unison library... @@ -20,7 +20,7 @@ 🎉 🥳 Happy coding! -test-4402/main> builtins.merge +test-html-docs/main> builtins.merge Done. @@ -57,7 +57,7 @@ some.outside = 3 ``` ```ucm -test-4402/main> add +test-html-docs/main> add ⍟ I've added these definitions: @@ -70,6 +70,6 @@ test-4402/main> add (also named lib.base.data.Map.internal.delta) some.outside.doc : Doc -test-4402/main> docs.to-html some.ns /tmp/test-4402 +test-html-docs/main> docs.to-html some.ns unison-src/transcripts-manual/docs.to-html ``` diff --git a/unison-src/transcripts-manual/docs.to-html/direct/doc.html b/unison-src/transcripts-manual/docs.to-html/direct/doc.html new file mode 100644 index 0000000000..0e9f37a540 --- /dev/null +++ b/unison-src/transcripts-manual/docs.to-html/direct/doc.html @@ -0,0 +1 @@ +
A doc directly in the namespace.
\ No newline at end of file diff --git a/unison-src/transcripts-manual/docs.to-html/pretty/deeply/nested/doc.html b/unison-src/transcripts-manual/docs.to-html/pretty/deeply/nested/doc.html new file mode 100644 index 0000000000..1e5a75f500 --- /dev/null +++ b/unison-src/transcripts-manual/docs.to-html/pretty/deeply/nested/doc.html @@ -0,0 +1 @@ +
A doc pretty deeply nested in the namespace.
\ No newline at end of file From 10d26229910ac77024ba6072c80f7bf6a2af0174 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Sun, 23 Jun 2024 22:09:51 -0500 Subject: [PATCH 207/631] Remove unused error case --- parser-typechecker/src/Unison/PrintError.hs | 14 -------------- unison-syntax/src/Unison/Syntax/Lexer.hs | 3 +-- 2 files changed, 1 insertion(+), 16 deletions(-) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 56bf11fcfd..835b2c4e2a 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -1370,20 +1370,6 @@ renderParseErrors s = \case <> style ErrorSite (fromString open) <> ".\n\n" <> excerpt - L.InvalidWordyId id -> - Pr.lines - [ "The identifier, " <> quoteCode id <> ", isn't valid syntax: ", - "", - excerpt, - "Here's a few examples of valid syntax: " - <> quoteCode "abba1'" - <> ", " - <> quoteCode "snake_case" - <> ", " - <> quoteCode "Foo.zoink!" - <> ", and " - <> quoteCode "🌻" - ] L.ReservedWordyId id -> Pr.lines [ "The identifier, " <> quoteCode id <> ", used here is a reserved keyword: ", diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 9938e2e41c..e708bc772c 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -95,8 +95,7 @@ parseFailure :: EP.ParseError [Char] (Token Err) -> P a parseFailure e = PI.ParsecT $ \s _ _ _ eerr -> eerr e s data Err - = InvalidWordyId String - | ReservedWordyId String + = ReservedWordyId String | InvalidSymbolyId String | ReservedSymbolyId String | InvalidShortHash String From 782ac4164d54c02457bcbc10134fce22894bbd0b Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Sun, 23 Jun 2024 22:18:51 -0500 Subject: [PATCH 208/631] Remove redundant `,` from lexer errors MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Appositives only need to be offset by commas if there isn’t already some other punctuation. --- parser-typechecker/src/Unison/PrintError.hs | 6 +++--- unison-src/transcripts/error-messages.output.md | 2 +- unison-src/transcripts/generic-parse-errors.output.md | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 835b2c4e2a..d6e50ebbb5 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -1372,7 +1372,7 @@ renderParseErrors s = \case <> excerpt L.ReservedWordyId id -> Pr.lines - [ "The identifier, " <> quoteCode id <> ", used here is a reserved keyword: ", + [ "The identifier " <> quoteCode id <> " used here is a reserved keyword: ", "", excerpt, Pr.wrap $ @@ -1382,7 +1382,7 @@ renderParseErrors s = \case ] L.InvalidSymbolyId id -> Pr.lines - [ "The infix identifier, " <> quoteCode id <> ", isn’t valid syntax: ", + [ "The infix identifier " <> quoteCode id <> " isn’t valid syntax: ", "", excerpt, "Here are a few valid examples: " @@ -1394,7 +1394,7 @@ renderParseErrors s = \case ] L.ReservedSymbolyId id -> Pr.lines - [ "The identifier, " <> quoteCode id <> ", is reserved by Unison and can't be used as an operator: ", + [ "The identifier " <> quoteCode id <> " is reserved by Unison and can't be used as an operator: ", "", excerpt ] diff --git a/unison-src/transcripts/error-messages.output.md b/unison-src/transcripts/error-messages.output.md index dacc86ac7a..82ae8a88b9 100644 --- a/unison-src/transcripts/error-messages.output.md +++ b/unison-src/transcripts/error-messages.output.md @@ -343,7 +343,7 @@ use.keyword.in.namespace = 1 Loading changes detected in scratch.u. - The identifier, `namespace`, used here is a reserved keyword: + The identifier `namespace` used here is a reserved keyword: 1 | use.keyword.in.namespace = 1 diff --git a/unison-src/transcripts/generic-parse-errors.output.md b/unison-src/transcripts/generic-parse-errors.output.md index 3a1c7b19ec..7800cbab47 100644 --- a/unison-src/transcripts/generic-parse-errors.output.md +++ b/unison-src/transcripts/generic-parse-errors.output.md @@ -30,7 +30,7 @@ namespace.blah = 1 Loading changes detected in scratch.u. - The identifier, `namespace`, used here is a reserved keyword: + The identifier `namespace` used here is a reserved keyword: 1 | namespace.blah = 1 From 0d441f3b75a91c527a7a781f4889766684dc4aaf Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 24 Jun 2024 08:26:52 -0400 Subject: [PATCH 209/631] move todo data types around --- .../Codebase/Editor/HandleInput/Todo.hs | 26 +++++++++---------- .../src/Unison/Codebase/Editor/Output.hs | 17 +++++++++--- .../src/Unison/Codebase/Editor/TodoOutput.hs | 19 -------------- .../src/Unison/CommandLine/OutputMessages.hs | 18 ++++++------- unison-cli/unison-cli.cabal | 1 - 5 files changed, 34 insertions(+), 47 deletions(-) delete mode 100644 unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index 2b24d33128..6795581dc2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -14,7 +14,6 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.Output -import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Names qualified as Names import Unison.Util.Defns (Defns (..)) @@ -36,16 +35,17 @@ handleTodo = do } pure (hashLen, directDependencies) - let todo = - TO.TodoOutput - { directDependenciesWithoutNames = - Defns - { terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace), - types = Set.difference directDependencies.types (Branch.deepTypeReferences currentNamespace) - }, - nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps) - } + ppe <- Cli.currentPrettyPrintEnvDecl - pped <- Cli.currentPrettyPrintEnvDecl - - Cli.respondNumbered (TodoOutput hashLen pped todo) + Cli.respondNumbered $ + Output'Todo + TodoOutput + { hashLen, + ppe, + directDependenciesWithoutNames = + Defns + { terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace), + types = Set.difference directDependencies.types (Branch.deepTypeReferences currentNamespace) + }, + nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps) + } diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index de47f53a83..8a5efe3949 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -8,6 +8,7 @@ module Unison.Codebase.Editor.Output ListDetailed, HistoryTail (..), TestReportStats (..), + TodoOutput (..), UndoFailureReason (..), ShareError (..), UpdateOrUpgrade (..), @@ -37,7 +38,6 @@ import Unison.Codebase.Editor.RemoteRepo import Unison.Codebase.Editor.SlurpResult (SlurpResult (..)) import Unison.Codebase.Editor.SlurpResult qualified as SR import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) -import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Codebase.IntegrityCheck (IntegrityResult (..)) import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path @@ -59,9 +59,10 @@ import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE +import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl) import Unison.PrettyPrintEnvDecl qualified as PPE import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName, Semver) -import Unison.Reference (Reference, TermReferenceId, TypeReference) +import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Server.Backend (ShallowListEntry (..)) @@ -75,6 +76,7 @@ import Unison.Term (Term) import Unison.Type (Type) import Unison.Typechecker.Context qualified as Context import Unison.UnisonFile qualified as UF +import Unison.Util.Defns (DefnsF) import Unison.Util.Pretty qualified as P import Unison.Util.Relation (Relation) import Unison.WatchKind qualified as WK @@ -117,7 +119,7 @@ data NumberedOutput | ShowDiffAfterPull Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | -- ShowDiffAfterCreateAuthor NameSegment Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) - | TodoOutput !Int !PPE.PrettyPrintEnvDecl !(TO.TodoOutput Symbol Ann) + | Output'Todo !TodoOutput | -- | CantDeleteDefinitions ppe couldntDelete becauseTheseStillReferenceThem CantDeleteDefinitions PPE.PrettyPrintEnvDecl (Map LabeledDependency (NESet LabeledDependency)) | -- | CantDeleteNamespace ppe couldntDelete becauseTheseStillReferenceThem @@ -140,6 +142,13 @@ data NumberedOutput Path.Absolute -- The namespace we're checking dependencies for. (Map LabeledDependency (Set Name)) -- Mapping of external dependencies to their local dependents. +data TodoOutput = TodoOutput + { hashLen :: !Int, + ppe :: !PrettyPrintEnvDecl, + directDependenciesWithoutNames :: DefnsF Set TermReference TypeReference, + nameConflicts :: Names + } + data AmbiguousReset'Argument = AmbiguousReset'Hash | AmbiguousReset'Target @@ -667,4 +676,4 @@ isNumberedFailure = \case ShowDiffAfterUndo {} -> False ShowDiffNamespace _ _ _ bd -> BD.isEmpty bd ListNamespaceDependencies {} -> False - TodoOutput {} -> False + Output'Todo {} -> False diff --git a/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs b/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs deleted file mode 100644 index 48b1e40a85..0000000000 --- a/unison-cli/src/Unison/Codebase/Editor/TodoOutput.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Unison.Codebase.Editor.TodoOutput - ( TodoOutput (..), - noConflicts, - ) -where - -import Unison.Names (Names) -import Unison.Prelude -import Unison.Reference (TermReference, TypeReference) -import Unison.Util.Defns (DefnsF) - -data TodoOutput v a = TodoOutput - { directDependenciesWithoutNames :: DefnsF Set TermReference TypeReference, - nameConflicts :: Names - } - -noConflicts :: TodoOutput v a -> Bool -noConflicts todo = - nameConflicts todo == mempty diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 87e06282d0..5b83541a00 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -53,6 +53,7 @@ import Unison.Codebase.Editor.Output Output (..), ShareError (..), TestReportStats (CachedTests, NewlyComputed), + TodoOutput, UndoFailureReason (CantUndoPastMerge, CantUndoPastStart), ) import Unison.Codebase.Editor.Output qualified as E @@ -63,7 +64,6 @@ import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) import Unison.Codebase.Editor.StructuredArgument qualified as SA -import Unison.Codebase.Editor.TodoOutput qualified as TO import Unison.Codebase.IntegrityCheck (IntegrityResult (..), prettyPrintIntegrityErrors) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path qualified as Path @@ -307,7 +307,7 @@ notifyNumbered = \case ] ) (showDiffNamespace ShowNumbers ppe (absPathToBranchId bAbs) (absPathToBranchId bAbs) diff) - TodoOutput hashLen names todo -> todoOutput hashLen names todo + Output'Todo todoOutput -> handleTodoOutput todoOutput CantDeleteDefinitions ppeDecl endangerments -> ( P.warnCallout $ P.lines @@ -2661,13 +2661,13 @@ runNumbered m = let (a, (_, args)) = State.runState m (0, mempty) in (a, Foldable.toList args) -todoOutput :: (Var v) => Int -> PPED.PrettyPrintEnvDecl -> TO.TodoOutput v a -> (Pretty, NumberedArgs) -todoOutput hashLen ppe todo = +handleTodoOutput :: TodoOutput -> (Pretty, NumberedArgs) +handleTodoOutput todo = runNumbered do prettyConflicts <- - if TO.noConflicts todo + if todo.nameConflicts == mempty then pure mempty - else renderNameConflicts ppeu todo.nameConflicts + else renderNameConflicts (PPED.unsuffixifiedPPE todo.ppe) todo.nameConflicts prettyDirectTermDependenciesWithoutNames <- do if Set.null todo.directDependenciesWithoutNames.terms @@ -2676,7 +2676,7 @@ todoOutput hashLen ppe todo = terms <- for (Set.toList todo.directDependenciesWithoutNames.terms) \term -> do n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term))) - pure (formatNum n <> P.syntaxToColor (prettyReference hashLen term)) + pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen term)) pure $ P.wrap "These terms do not have any names in the current namespace:" <> P.newline @@ -2690,7 +2690,7 @@ todoOutput hashLen ppe todo = types <- for (Set.toList todo.directDependenciesWithoutNames.types) \typ -> do n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ))) - pure (formatNum n <> P.syntaxToColor (prettyReference hashLen typ)) + pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen typ)) pure $ P.wrap "These types do not have any names in the current namespace:" <> P.newline @@ -2702,8 +2702,6 @@ todoOutput hashLen ppe todo = prettyDirectTermDependenciesWithoutNames, prettyDirectTypeDependenciesWithoutNames ] - where - ppeu = PPED.unsuffixifiedPPE ppe listOfDefinitions :: (Var v) => Input.FindScope -> PPE.PrettyPrintEnv -> E.ListDetailed -> [SR'.SearchResult' v a] -> IO Pretty diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 59b0445d9a..03e6533b13 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -101,7 +101,6 @@ library Unison.Codebase.Editor.SlurpComponent Unison.Codebase.Editor.SlurpResult Unison.Codebase.Editor.StructuredArgument - Unison.Codebase.Editor.TodoOutput Unison.Codebase.Editor.UCMVersion Unison.Codebase.Editor.UriParser Unison.Codebase.TranscriptParser From a2e2ae475162ba0e37efbd4dce309cc3cb2cb54a Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 24 Jun 2024 08:44:51 -0400 Subject: [PATCH 210/631] sketch out todo dependent rendering --- .../Codebase/Editor/HandleInput/Todo.hs | 5 +- .../src/Unison/Codebase/Editor/Output.hs | 9 +- .../src/Unison/CommandLine/OutputMessages.hs | 102 +++++++++++------- 3 files changed, 69 insertions(+), 47 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index 6795581dc2..7fddd132fc 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -41,11 +41,12 @@ handleTodo = do Output'Todo TodoOutput { hashLen, - ppe, + dependentsOfTodo = Set.empty, directDependenciesWithoutNames = Defns { terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace), types = Set.difference directDependencies.types (Branch.deepTypeReferences currentNamespace) }, - nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps) + nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps), + ppe } diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 8a5efe3949..105683c2b2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -143,10 +143,11 @@ data NumberedOutput (Map LabeledDependency (Set Name)) -- Mapping of external dependencies to their local dependents. data TodoOutput = TodoOutput - { hashLen :: !Int, - ppe :: !PrettyPrintEnvDecl, - directDependenciesWithoutNames :: DefnsF Set TermReference TypeReference, - nameConflicts :: Names + { dependentsOfTodo :: !(Set TermReferenceId), + directDependenciesWithoutNames :: !(DefnsF Set TermReference TypeReference), + hashLen :: !Int, + nameConflicts :: !Names, + ppe :: !PrettyPrintEnvDecl } data AmbiguousReset'Argument diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 5b83541a00..291fcf6e2e 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -307,7 +307,7 @@ notifyNumbered = \case ] ) (showDiffNamespace ShowNumbers ppe (absPathToBranchId bAbs) (absPathToBranchId bAbs) diff) - Output'Todo todoOutput -> handleTodoOutput todoOutput + Output'Todo todoOutput -> runNumbered (handleTodoOutput todoOutput) CantDeleteDefinitions ppeDecl endangerments -> ( P.warnCallout $ P.lines @@ -2661,47 +2661,67 @@ runNumbered m = let (a, (_, args)) = State.runState m (0, mempty) in (a, Foldable.toList args) -handleTodoOutput :: TodoOutput -> (Pretty, NumberedArgs) -handleTodoOutput todo = - runNumbered do - prettyConflicts <- - if todo.nameConflicts == mempty - then pure mempty - else renderNameConflicts (PPED.unsuffixifiedPPE todo.ppe) todo.nameConflicts - - prettyDirectTermDependenciesWithoutNames <- do - if Set.null todo.directDependenciesWithoutNames.terms - then pure mempty - else do - terms <- - for (Set.toList todo.directDependenciesWithoutNames.terms) \term -> do - n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term))) - pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen term)) - pure $ - P.wrap "These terms do not have any names in the current namespace:" - <> P.newline - <> P.newline - <> P.indentN 2 (P.lines terms) - - prettyDirectTypeDependenciesWithoutNames <- do - if Set.null todo.directDependenciesWithoutNames.types - then pure mempty - else do - types <- - for (Set.toList todo.directDependenciesWithoutNames.types) \typ -> do - n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ))) - pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen typ)) - pure $ - P.wrap "These types do not have any names in the current namespace:" - <> P.newline - <> P.newline - <> P.indentN 2 (P.lines types) +handleTodoOutput :: TodoOutput -> Numbered Pretty +handleTodoOutput todo = do + prettyConflicts <- + if todo.nameConflicts == mempty + then pure mempty + else renderNameConflicts todo.ppe.unsuffixifiedPPE todo.nameConflicts + + prettyDependentsOfTodo <- do + if Set.null todo.dependentsOfTodo + then pure mempty + else do + terms <- + for (Set.toList todo.dependentsOfTodo) \term -> do + n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.idToShortHash term))) + let name = + term + & Referent.fromTermReferenceId + & PPE.termName todo.ppe.suffixifiedPPE + & prettyHashQualified + & P.syntaxToColor + pure (formatNum n <> name) + pure $ + P.wrap "These terms call `todo`:" + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines terms) + + prettyDirectTermDependenciesWithoutNames <- do + if Set.null todo.directDependenciesWithoutNames.terms + then pure mempty + else do + terms <- + for (Set.toList todo.directDependenciesWithoutNames.terms) \term -> do + n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term))) + pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen term)) + pure $ + P.wrap "These terms do not have any names in the current namespace:" + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines terms) + + prettyDirectTypeDependenciesWithoutNames <- do + if Set.null todo.directDependenciesWithoutNames.types + then pure mempty + else do + types <- + for (Set.toList todo.directDependenciesWithoutNames.types) \typ -> do + n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ))) + pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen typ)) + pure $ + P.wrap "These types do not have any names in the current namespace:" + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines types) - (pure . P.sep "\n\n" . P.nonEmpty) - [ prettyConflicts, - prettyDirectTermDependenciesWithoutNames, - prettyDirectTypeDependenciesWithoutNames - ] + (pure . P.sep "\n\n" . P.nonEmpty) + [ prettyDependentsOfTodo, + prettyDirectTermDependenciesWithoutNames, + prettyDirectTypeDependenciesWithoutNames, + prettyConflicts + ] listOfDefinitions :: (Var v) => Input.FindScope -> PPE.PrettyPrintEnv -> E.ListDetailed -> [SR'.SearchResult' v a] -> IO Pretty From 2ddea6372dabf48dbd3f1f12701642e4e1c7f306 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 24 Jun 2024 08:55:54 -0400 Subject: [PATCH 211/631] drop temp table --- codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 66af3c846a..9a386fe1d3 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -1897,6 +1897,9 @@ getDirectDependenciesOfScope scope = do ) |] + -- Drop the temporary table + execute [sql| DROP TABLE $tempTableName |] + -- Post-process the query result let dependencies1 = List.foldl' From 827cb0c0a23db18092e4a7291070bd188aea35fc Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 24 Jun 2024 09:04:38 -0400 Subject: [PATCH 212/631] make dependentsWithinScope return type less awkward --- .../U/Codebase/Sqlite/Operations.hs | 18 ++++++------ .../U/Codebase/Sqlite/Queries.hs | 19 +++++++++++-- .../Codebase/Editor/HandleInput/Update2.hs | 28 +++++-------------- 3 files changed, 33 insertions(+), 32 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index d0b9935014..dc1015d5fc 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -1156,17 +1156,19 @@ dependents selector r = do -- | `dependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` (not -- including `query` itself). Each dependent is also tagged with whether it is a term or decl. -dependentsWithinScope :: Set C.Reference.Id -> Set C.Reference -> Transaction (Map C.Reference.Id C.ReferenceType) +dependentsWithinScope :: Set C.Reference.Id -> Set C.Reference -> Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId) dependentsWithinScope scope query = do + -- Convert C -> S scope' <- Set.traverse c2sReferenceId scope query' <- Set.traverse c2sReference query - Q.getDependentsWithinScope scope' query' - >>= Map.bitraverse s2cReferenceId (pure . objectTypeToReferenceType) - where - objectTypeToReferenceType = \case - ObjectType.TermComponent -> C.RtTerm - ObjectType.DeclComponent -> C.RtType - _ -> error "Q.getDependentsWithinScope shouldn't return any other types" + + -- Do the query + dependents0 <- Q.getDependentsWithinScope scope' query' + + -- Convert S -> C + dependents1 <- bitraverse (Set.traverse s2cReferenceId) (Set.traverse s2cReferenceId) dependents0 + + pure dependents1 -- | returns a list of known definitions referencing `h` dependentsOfComponent :: H.Hash -> Transaction (Set C.Reference.Id) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 66af3c846a..02afe493a4 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -1914,7 +1914,7 @@ getDirectDependenciesOfScope scope = do -- | `getDependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` (not -- including `query` itself). Each dependent is also tagged with whether it is a term or decl. -getDependentsWithinScope :: Set S.Reference.Id -> Set S.Reference -> Transaction (Map S.Reference.Id ObjectType) +getDependentsWithinScope :: Set S.Reference.Id -> Set S.Reference -> Transaction (DefnsF Set S.TermReferenceId S.TypeReferenceId) getDependentsWithinScope scope query = do -- Populate a temporary table with all of the references in `scope` createTemporaryTableOfReferenceIds [sql| dependents_search_scope |] scope @@ -1951,7 +1951,7 @@ getDependentsWithinScope scope query = do -- We use `UNION` rather than `UNION ALL` so as to not track down the transitive dependents of any particular -- reference more than once. - result :: [S.Reference.Id :. Only ObjectType] <- queryListRow [sql| + result0 :: [S.Reference.Id :. Only ObjectType] <- queryListRow [sql| WITH RECURSIVE transitive_dependents (dependent_object_id, dependent_component_index, type_id) AS ( SELECT d.dependent_object_id, d.dependent_component_index, object.type_id FROM dependents_index d @@ -1976,9 +1976,22 @@ getDependentsWithinScope scope query = do ) SELECT * FROM transitive_dependents |] + execute [sql| DROP TABLE dependents_search_scope |] execute [sql| DROP TABLE dependencies_query |] - pure . Map.fromList $ [(r, t) | r :. Only t <- result] + + -- Post-process the query result + let result1 = + List.foldl' + ( \deps -> \case + dep :. Only TermComponent -> Defns (Set.insert dep deps.terms) deps.types + dep :. Only DeclComponent -> Defns deps.terms (Set.insert dep deps.types) + _ -> deps -- impossible; could error here + ) + (Defns Set.empty Set.empty) + result0 + + pure result1 createTemporaryTableOfReferenceIds :: Sql -> Set S.Reference.Id -> Transaction () createTemporaryTableOfReferenceIds tableName refs = do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 1fb4e5eda4..f2682cca3b 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -512,16 +512,7 @@ getNamespaceDependentsOf :: Transaction (DefnsF (Relation Name) TermReferenceId TypeReferenceId) getNamespaceDependentsOf names dependencies = do dependents <- Ops.dependentsWithinScope (Names.referenceIds names) dependencies - let dependents1 :: DefnsF Set TermReferenceId TypeReferenceId - dependents1 = - Map.foldlWithKey' - ( \defns refId -> \case - Reference.RtTerm -> let !terms1 = Set.insert refId defns.terms in defns & #terms .~ terms1 - Reference.RtType -> let !types1 = Set.insert refId defns.types in defns & #types .~ types1 - ) - (Defns Set.empty Set.empty) - dependents - pure (bimap (foldMap nameTerm) (foldMap nameType) dependents1) + pure (bimap (foldMap nameTerm) (foldMap nameType) dependents) where nameTerm :: TermReferenceId -> Relation Name TermReferenceId nameTerm ref = @@ -544,24 +535,19 @@ getNamespaceDependentsOf2 defns dependencies = do dependents <- Ops.dependentsWithinScope scope dependencies - let (termDependentRefs, typeDependentRefs) = - dependents & Map.partition \case - Reference.RtTerm -> True - Reference.RtType -> False - pure Defns - { terms = Map.foldlWithKey' addTerms Map.empty termDependentRefs, - types = Map.foldlWithKey' addTypes Map.empty typeDependentRefs + { terms = Set.foldl' addTerms Map.empty dependents.terms, + types = Set.foldl' addTypes Map.empty dependents.types } where - addTerms :: Map Name TermReferenceId -> TermReferenceId -> ignored -> Map Name TermReferenceId - addTerms acc0 ref _ = + addTerms :: Map Name TermReferenceId -> TermReferenceId -> Map Name TermReferenceId + addTerms acc0 ref = let names = BiMultimap.lookupDom (Referent.fromTermReferenceId ref) defns.terms in Set.foldl' (\acc name -> Map.insert name ref acc) acc0 names - addTypes :: Map Name TypeReferenceId -> TypeReferenceId -> ignored -> Map Name TypeReferenceId - addTypes acc0 ref _ = + addTypes :: Map Name TypeReferenceId -> TypeReferenceId -> Map Name TypeReferenceId + addTypes acc0 ref = let names = BiMultimap.lookupDom (Reference.fromId ref) defns.types in Set.foldl' (\acc name -> Map.insert name ref acc) acc0 names From b57ada5e929c45fddeac98adb73f0f895f7ba9db Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 24 Jun 2024 09:15:32 -0400 Subject: [PATCH 213/631] include dependents of `todo` builtin in `todo` command output --- .../Codebase/Editor/HandleInput/Todo.hs | 26 ++++++++++++++++--- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index 7fddd132fc..6e1a7d9944 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -6,6 +6,7 @@ where import Data.Set qualified as Set import U.Codebase.Sqlite.Operations qualified as Operations +import Unison.Builtin qualified as Builtin import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli @@ -15,7 +16,11 @@ import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.Output import Unison.Names qualified as Names +import Unison.Prelude +import Unison.Reference (TermReference) +import Unison.Syntax.Name qualified as Name import Unison.Util.Defns (Defns (..)) +import Unison.Util.Set qualified as Set handleTodo :: Cli () handleTodo = do @@ -24,16 +29,29 @@ handleTodo = do currentNamespace <- Cli.getCurrentBranch0 let currentNamespaceWithoutLibdeps = Branch.deleteLibdeps currentNamespace - (hashLen, directDependencies) <- + (dependentsOfTodo, directDependencies, hashLen) <- Cli.runTransaction do - hashLen <- Codebase.hashLength + let todoReference :: TermReference + todoReference = + Set.asSingleton (Names.refTermsNamed Builtin.names (Name.unsafeParseText "todo")) + & fromMaybe (error (reportBug "E260496" "No reference for builtin named 'todo'")) + + -- All type-and-term dependents of the `todo` builtin, but we know they're all terms. + dependentsOfTodo <- + Operations.dependentsWithinScope + (Branch.deepTermReferenceIds currentNamespaceWithoutLibdeps) + (Set.singleton todoReference) + directDependencies <- Operations.directDependenciesOfScope Defns { terms = Branch.deepTermReferenceIds currentNamespaceWithoutLibdeps, types = Branch.deepTypeReferenceIds currentNamespaceWithoutLibdeps } - pure (hashLen, directDependencies) + + hashLen <- Codebase.hashLength + + pure (dependentsOfTodo.terms, directDependencies, hashLen) ppe <- Cli.currentPrettyPrintEnvDecl @@ -41,7 +59,7 @@ handleTodo = do Output'Todo TodoOutput { hashLen, - dependentsOfTodo = Set.empty, + dependentsOfTodo, directDependenciesWithoutNames = Defns { terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace), From 4ef8450130b56d0e9d1d90cafba1ca18c74bd907 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 24 Jun 2024 09:24:29 -0400 Subject: [PATCH 214/631] rename `dependentsWithinScope` to `transitiveDependentsWithinScope` --- .../U/Codebase/Sqlite/Operations.hs | 15 ++-- .../U/Codebase/Sqlite/Queries.hs | 69 ++++++++++--------- .../Codebase/Editor/HandleInput/Todo.hs | 2 +- .../Codebase/Editor/HandleInput/Update2.hs | 4 +- 4 files changed, 49 insertions(+), 41 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index dc1015d5fc..d2335e6ece 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -66,7 +66,7 @@ module U.Codebase.Sqlite.Operations directDependenciesOfScope, dependents, dependentsOfComponent, - dependentsWithinScope, + transitiveDependentsWithinScope, -- ** type index Q.addTypeToIndexForTerm, @@ -1154,16 +1154,19 @@ dependents selector r = do sIds <- Q.getDependentsForDependency selector r' Set.traverse s2cReferenceId sIds --- | `dependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` (not --- including `query` itself). Each dependent is also tagged with whether it is a term or decl. -dependentsWithinScope :: Set C.Reference.Id -> Set C.Reference -> Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId) -dependentsWithinScope scope query = do +-- | `transitiveDependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` +-- (not including `query` itself). Each dependent is also tagged with whether it is a term or decl. +transitiveDependentsWithinScope :: + Set C.Reference.Id -> + Set C.Reference -> + Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId) +transitiveDependentsWithinScope scope query = do -- Convert C -> S scope' <- Set.traverse c2sReferenceId scope query' <- Set.traverse c2sReference query -- Do the query - dependents0 <- Q.getDependentsWithinScope scope' query' + dependents0 <- Q.getTransitiveDependentsWithinScope scope' query' -- Convert S -> C dependents1 <- bitraverse (Set.traverse s2cReferenceId) (Set.traverse s2cReferenceId) dependents0 diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 02afe493a4..10e5aa05cf 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -166,7 +166,7 @@ module U.Codebase.Sqlite.Queries getDependencyIdsForDependent, getDependenciesBetweenTerms, getDirectDependenciesOfScope, - getDependentsWithinScope, + getTransitiveDependentsWithinScope, -- ** type index addToTypeIndex, @@ -1910,12 +1910,13 @@ getDirectDependenciesOfScope scope = do pure dependencies1 -{- ORMOLU_DISABLE -} - --- | `getDependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` (not --- including `query` itself). Each dependent is also tagged with whether it is a term or decl. -getDependentsWithinScope :: Set S.Reference.Id -> Set S.Reference -> Transaction (DefnsF Set S.TermReferenceId S.TypeReferenceId) -getDependentsWithinScope scope query = do +-- | `getTransitiveDependentsWithinScope scope query` returns all of transitive dependents of `query` that are in +-- `scope` (not including `query` itself). +getTransitiveDependentsWithinScope :: + Set S.Reference.Id -> + Set S.Reference -> + Transaction (DefnsF Set S.TermReferenceId S.TypeReferenceId) +getTransitiveDependentsWithinScope scope query = do -- Populate a temporary table with all of the references in `scope` createTemporaryTableOfReferenceIds [sql| dependents_search_scope |] scope @@ -1951,31 +1952,33 @@ getDependentsWithinScope scope query = do -- We use `UNION` rather than `UNION ALL` so as to not track down the transitive dependents of any particular -- reference more than once. - result0 :: [S.Reference.Id :. Only ObjectType] <- queryListRow [sql| - WITH RECURSIVE transitive_dependents (dependent_object_id, dependent_component_index, type_id) AS ( - SELECT d.dependent_object_id, d.dependent_component_index, object.type_id - FROM dependents_index d - JOIN object ON d.dependent_object_id = object.id - JOIN dependencies_query q - ON q.dependency_builtin IS d.dependency_builtin - AND q.dependency_object_id IS d.dependency_object_id - AND q.dependency_component_index IS d.dependency_component_index - JOIN dependents_search_scope s - ON s.object_id = d.dependent_object_id - AND s.component_index = d.dependent_component_index - - UNION SELECT d.dependent_object_id, d.dependent_component_index, object.type_id - FROM dependents_index d - JOIN object ON d.dependent_object_id = object.id - JOIN transitive_dependents t - ON t.dependent_object_id = d.dependency_object_id - AND t.dependent_component_index = d.dependency_component_index - JOIN dependents_search_scope s - ON s.object_id = d.dependent_object_id - AND s.component_index = d.dependent_component_index - ) - SELECT * FROM transitive_dependents - |] + result0 :: [S.Reference.Id :. Only ObjectType] <- + queryListRow + [sql| + WITH RECURSIVE transitive_dependents (dependent_object_id, dependent_component_index, type_id) AS ( + SELECT d.dependent_object_id, d.dependent_component_index, object.type_id + FROM dependents_index d + JOIN object ON d.dependent_object_id = object.id + JOIN dependencies_query q + ON q.dependency_builtin IS d.dependency_builtin + AND q.dependency_object_id IS d.dependency_object_id + AND q.dependency_component_index IS d.dependency_component_index + JOIN dependents_search_scope s + ON s.object_id = d.dependent_object_id + AND s.component_index = d.dependent_component_index + + UNION SELECT d.dependent_object_id, d.dependent_component_index, object.type_id + FROM dependents_index d + JOIN object ON d.dependent_object_id = object.id + JOIN transitive_dependents t + ON t.dependent_object_id = d.dependency_object_id + AND t.dependent_component_index = d.dependency_component_index + JOIN dependents_search_scope s + ON s.object_id = d.dependent_object_id + AND s.component_index = d.dependent_component_index + ) + SELECT * FROM transitive_dependents + |] execute [sql| DROP TABLE dependents_search_scope |] execute [sql| DROP TABLE dependencies_query |] @@ -1993,6 +1996,8 @@ getDependentsWithinScope scope query = do pure result1 +{- ORMOLU_DISABLE -} + createTemporaryTableOfReferenceIds :: Sql -> Set S.Reference.Id -> Transaction () createTemporaryTableOfReferenceIds tableName refs = do execute diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index 6e1a7d9944..c3b37c7054 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -38,7 +38,7 @@ handleTodo = do -- All type-and-term dependents of the `todo` builtin, but we know they're all terms. dependentsOfTodo <- - Operations.dependentsWithinScope + Operations.transitiveDependentsWithinScope (Branch.deepTermReferenceIds currentNamespaceWithoutLibdeps) (Set.singleton todoReference) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index f2682cca3b..b0dd664a25 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -511,7 +511,7 @@ getNamespaceDependentsOf :: Set Reference -> Transaction (DefnsF (Relation Name) TermReferenceId TypeReferenceId) getNamespaceDependentsOf names dependencies = do - dependents <- Ops.dependentsWithinScope (Names.referenceIds names) dependencies + dependents <- Ops.transitiveDependentsWithinScope (Names.referenceIds names) dependencies pure (bimap (foldMap nameTerm) (foldMap nameType) dependents) where nameTerm :: TermReferenceId -> Relation Name TermReferenceId @@ -533,7 +533,7 @@ getNamespaceDependentsOf2 defns dependencies = do let scope = bifoldMap toTermScope toTypeScope defns dependents <- - Ops.dependentsWithinScope scope dependencies + Ops.transitiveDependentsWithinScope scope dependencies pure Defns From 058882b388b366d070727e4e0d1ceb3276cfc37b Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 24 Jun 2024 09:29:57 -0400 Subject: [PATCH 215/631] pull out createTemporaryTableOfReferences helper --- .../U/Codebase/Sqlite/Queries.hs | 51 +++++++++++-------- 1 file changed, 29 insertions(+), 22 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 10e5aa05cf..8647a86273 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -1918,21 +1918,12 @@ getTransitiveDependentsWithinScope :: Transaction (DefnsF Set S.TermReferenceId S.TypeReferenceId) getTransitiveDependentsWithinScope scope query = do -- Populate a temporary table with all of the references in `scope` - createTemporaryTableOfReferenceIds [sql| dependents_search_scope |] scope + let scopeTableName = [sql| dependents_search_scope |] + createTemporaryTableOfReferenceIds scopeTableName scope -- Populate a temporary table with all of the references in `query` - execute - [sql| - CREATE TEMPORARY TABLE dependencies_query ( - dependency_builtin INTEGER NULL, - dependency_object_id INTEGER NULL, - dependency_component_index INTEGER NULL, - CHECK ((dependency_builtin IS NULL) = (dependency_object_id IS NOT NULL)), - CHECK ((dependency_object_id IS NULL) = (dependency_component_index IS NULL)) - ) - |] - for_ query \r -> - execute [sql|INSERT INTO dependencies_query VALUES (@r, @, @)|] + let queryTableName = [sql| dependencies_query |] + createTemporaryTableOfReferences queryTableName query -- Say the query set is { #foo, #bar }, and the scope set is { #foo, #bar, #baz, #qux, #honk }. -- @@ -1959,11 +1950,11 @@ getTransitiveDependentsWithinScope scope query = do SELECT d.dependent_object_id, d.dependent_component_index, object.type_id FROM dependents_index d JOIN object ON d.dependent_object_id = object.id - JOIN dependencies_query q - ON q.dependency_builtin IS d.dependency_builtin - AND q.dependency_object_id IS d.dependency_object_id - AND q.dependency_component_index IS d.dependency_component_index - JOIN dependents_search_scope s + JOIN $queryTableName q + ON q.builtin IS d.dependency_builtin + AND q.object_id IS d.dependency_object_id + AND q.component_index IS d.dependency_component_index + JOIN $scopeTableName s ON s.object_id = d.dependent_object_id AND s.component_index = d.dependent_component_index @@ -1973,15 +1964,15 @@ getTransitiveDependentsWithinScope scope query = do JOIN transitive_dependents t ON t.dependent_object_id = d.dependency_object_id AND t.dependent_component_index = d.dependency_component_index - JOIN dependents_search_scope s + JOIN $scopeTableName s ON s.object_id = d.dependent_object_id AND s.component_index = d.dependent_component_index ) SELECT * FROM transitive_dependents |] - execute [sql| DROP TABLE dependents_search_scope |] - execute [sql| DROP TABLE dependencies_query |] + execute [sql| DROP TABLE $scopeTableName |] + execute [sql| DROP TABLE $queryTableName |] -- Post-process the query result let result1 = @@ -1996,7 +1987,21 @@ getTransitiveDependentsWithinScope scope query = do pure result1 -{- ORMOLU_DISABLE -} +createTemporaryTableOfReferences :: Sql -> Set S.Reference -> Transaction () +createTemporaryTableOfReferences tableName refs = do + execute + [sql| + CREATE TEMPORARY TABLE $tableName ( + builtin INTEGER NULL, + object_id INTEGER NULL, + component_index INTEGER NULL + CHECK ((builtin IS NULL) = (object_id IS NOT NULL)), + CHECK ((object_id IS NULL) = (component_index IS NULL)) + ) + |] + + for_ refs \ref -> + execute [sql| INSERT INTO $tableName VALUES (@ref, @, @) |] createTemporaryTableOfReferenceIds :: Sql -> Set S.Reference.Id -> Transaction () createTemporaryTableOfReferenceIds tableName refs = do @@ -2011,6 +2016,8 @@ createTemporaryTableOfReferenceIds tableName refs = do for_ refs \ref -> execute [sql| INSERT INTO $tableName VALUES (@ref, @) |] +{- ORMOLU_DISABLE -} + objectIdByBase32Prefix :: ObjectType -> Text -> Transaction [ObjectId] objectIdByBase32Prefix objType prefix = queryListCol From 297bfd8d7fcb48a8c2f207fb9858b097ab0dee61 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 24 Jun 2024 09:38:36 -0400 Subject: [PATCH 216/631] add getDirectDependentsWithinScope --- .../U/Codebase/Sqlite/Operations.hs | 32 ++++++++--- .../U/Codebase/Sqlite/Queries.hs | 53 ++++++++++++++++++- 2 files changed, 77 insertions(+), 8 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index d2335e6ece..324177438f 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -66,6 +66,7 @@ module U.Codebase.Sqlite.Operations directDependenciesOfScope, dependents, dependentsOfComponent, + directDependentsWithinScope, transitiveDependentsWithinScope, -- ** type index @@ -1154,19 +1155,38 @@ dependents selector r = do sIds <- Q.getDependentsForDependency selector r' Set.traverse s2cReferenceId sIds --- | `transitiveDependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` --- (not including `query` itself). Each dependent is also tagged with whether it is a term or decl. +-- | `directDependentsWithinScope scope query` returns all direct dependents of `query` that are in `scope` (not +-- including `query` itself). +directDependentsWithinScope :: + Set C.Reference.Id -> + Set C.Reference -> + Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId) +directDependentsWithinScope scope0 query0 = do + -- Convert C -> S + scope1 <- Set.traverse c2sReferenceId scope0 + query1 <- Set.traverse c2sReference query0 + + -- Do the query + dependents0 <- Q.getDirectDependentsWithinScope scope1 query1 + + -- Convert S -> C + dependents1 <- bitraverse (Set.traverse s2cReferenceId) (Set.traverse s2cReferenceId) dependents0 + + pure dependents1 + +-- | `transitiveDependentsWithinScope scope query` returns all transitive dependents of `query` that are in `scope` (not +-- including `query` itself). transitiveDependentsWithinScope :: Set C.Reference.Id -> Set C.Reference -> Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId) -transitiveDependentsWithinScope scope query = do +transitiveDependentsWithinScope scope0 query0 = do -- Convert C -> S - scope' <- Set.traverse c2sReferenceId scope - query' <- Set.traverse c2sReference query + scope1 <- Set.traverse c2sReferenceId scope0 + query1 <- Set.traverse c2sReference query0 -- Do the query - dependents0 <- Q.getTransitiveDependentsWithinScope scope' query' + dependents0 <- Q.getTransitiveDependentsWithinScope scope1 query1 -- Convert S -> C dependents1 <- bitraverse (Set.traverse s2cReferenceId) (Set.traverse s2cReferenceId) dependents0 diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 8647a86273..615b39caf0 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -166,6 +166,7 @@ module U.Codebase.Sqlite.Queries getDependencyIdsForDependent, getDependenciesBetweenTerms, getDirectDependenciesOfScope, + getDirectDependentsWithinScope, getTransitiveDependentsWithinScope, -- ** type index @@ -1910,8 +1911,56 @@ getDirectDependenciesOfScope scope = do pure dependencies1 --- | `getTransitiveDependentsWithinScope scope query` returns all of transitive dependents of `query` that are in --- `scope` (not including `query` itself). +-- | `getDirectDependentsWithinScope scope query` returns all direct dependents of `query` that are in `scope` (not +-- including `query` itself). +getDirectDependentsWithinScope :: + Set S.Reference.Id -> + Set S.Reference -> + Transaction (DefnsF Set S.TermReferenceId S.TypeReferenceId) +getDirectDependentsWithinScope scope query = do + -- Populate a temporary table with all of the references in `scope` + let scopeTableName = [sql| dependents_search_scope |] + createTemporaryTableOfReferenceIds scopeTableName scope + + -- Populate a temporary table with all of the references in `query` + let queryTableName = [sql| dependencies_query |] + createTemporaryTableOfReferences queryTableName query + + -- Get their direct dependents (tagged with object type) + dependents0 <- + queryListRow @(S.Reference.Id :. Only ObjectType) + [sql| + SELECT s.object_id, s.component_index, o.type_id + FROM $queryTableName q + JOIN dependents_index d + ON q.builtin IS d.dependency_builtin + AND q.object_id IS d.dependency_object_id + AND q.component_index IS d.dependency_component_index + JOIN $scopeTableName s + ON d.dependent_object_id = s.object_id + AND d.dependent_component_index = s.component_index + JOIN object o ON s.object_id = o.id + |] + + -- Drop the temporary tables + execute [sql| DROP TABLE $scopeTableName |] + execute [sql| DROP TABLE $queryTableName |] + + -- Post-process the query result + let dependents1 = + List.foldl' + ( \deps -> \case + dep :. Only TermComponent -> Defns (Set.insert dep deps.terms) deps.types + dep :. Only DeclComponent -> Defns deps.terms (Set.insert dep deps.types) + _ -> deps -- impossible; could error here + ) + (Defns Set.empty Set.empty) + dependents0 + + pure dependents1 + +-- | `getTransitiveDependentsWithinScope scope query` returns all transitive dependents of `query` that are in `scope` +-- (not including `query` itself). getTransitiveDependentsWithinScope :: Set S.Reference.Id -> Set S.Reference -> From 40ef6afda261f7bc3691bb12172f7a71442bce11 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 24 Jun 2024 09:40:54 -0400 Subject: [PATCH 217/631] make `todo` show direct dependents of `todo`, not transitive dependents --- unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index c3b37c7054..1a8ccf64f3 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -38,7 +38,7 @@ handleTodo = do -- All type-and-term dependents of the `todo` builtin, but we know they're all terms. dependentsOfTodo <- - Operations.transitiveDependentsWithinScope + Operations.directDependentsWithinScope (Branch.deepTermReferenceIds currentNamespaceWithoutLibdeps) (Set.singleton todoReference) From d8240cd106450d5767789bb1ed90e12bc6ae8e64 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 24 Jun 2024 09:45:11 -0400 Subject: [PATCH 218/631] add transcripts for showing dependents of `todo` --- unison-src/transcripts/todo.md | 25 ++++++++++++++++ unison-src/transcripts/todo.output.md | 41 +++++++++++++++++++++++++++ 2 files changed, 66 insertions(+) diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md index 8478e4f298..097854dcce 100644 --- a/unison-src/transcripts/todo.md +++ b/unison-src/transcripts/todo.md @@ -2,6 +2,31 @@ The todo command shows conflicted names (not demonstrated here yet because it is not easy to create them for tests, yet). +# Dependents of `todo` + +The `todo` command shows local (outside `lib`) terms that directly call `todo`. + +```ucm:hide +project/main> builtins.mergeio lib.builtins +``` + +```unison +foo : Nat +foo = todo "implement foo" + +bar : Nat +bar = foo + foo +``` + +```ucm +project/main> add +project/main> todo +``` + +```ucm:hide +project/main> delete.project project +``` + # Direct dependencies without names The `todo` command shows hashes of direct dependencies of local (outside `lib`) definitions that don't have names in diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index 7f3affeb12..a491922c7a 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -2,6 +2,47 @@ The todo command shows conflicted names (not demonstrated here yet because it is not easy to create them for tests, yet). +# Dependents of `todo` + +The `todo` command shows local (outside `lib`) terms that directly call `todo`. + +```unison +foo : Nat +foo = todo "implement foo" + +bar : Nat +bar = foo + foo +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bar : Nat + foo : Nat + +``` +```ucm +project/main> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat + +project/main> todo + + These terms call `todo`: + + 1. foo + +``` # Direct dependencies without names The `todo` command shows hashes of direct dependencies of local (outside `lib`) definitions that don't have names in From c3b7091784b9b029383beae8031919b1de1ae16c Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 24 Jun 2024 09:52:47 -0400 Subject: [PATCH 219/631] move ls handler into its own module --- .../src/Unison/Codebase/Editor/HandleInput.hs | 17 ++-------- .../Unison/Codebase/Editor/HandleInput/Ls.hs | 33 +++++++++++++++++++ unison-cli/unison-cli.cabal | 3 +- 3 files changed, 37 insertions(+), 16 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/Ls.hs diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 2176418e54..d8b1e92ced 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -68,6 +68,7 @@ import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, 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.Ls (handleLs) import Unison.Codebase.Editor.HandleInput.Merge2 (handleMerge) import Unison.Codebase.Editor.HandleInput.MoveAll (handleMoveAll) import Unison.Codebase.Editor.HandleInput.MoveBranch (doMoveBranch) @@ -692,21 +693,7 @@ loop e = do traverse_ (displayI outputLoc) namesToDisplay ShowDefinitionI outputLoc showDefinitionScope query -> handleShowDefinition outputLoc showDefinitionScope query EditNamespaceI paths -> handleEditNamespace LatestFileLocation paths - FindShallowI pathArg -> do - Cli.Env {codebase} <- ask - - pathArgAbs <- Cli.resolvePath' pathArg - entries <- liftIO (Backend.lsAtPath codebase Nothing pathArgAbs) - Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArg) entries - pped <- Cli.currentPrettyPrintEnvDecl - let suffixifiedPPE = PPED.suffixifiedPPE pped - -- This used to be a delayed action which only forced the loading of the root - -- branch when it was necessary for printing the results, but that got wiped out - -- when we ported to the new Cli monad. - -- It would be nice to restore it, but it's pretty rare that it actually results - -- in an improvement, so perhaps it's not worth the effort. - let buildPPE = pure suffixifiedPPE - Cli.respond $ ListShallow buildPPE entries + FindShallowI pathArg -> handleLs pathArg FindI isVerbose fscope ws -> handleFindI isVerbose fscope ws input StructuredFindI _fscope ws -> handleStructuredFindI ws StructuredFindReplaceI ws -> handleStructuredFindReplaceI ws diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Ls.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Ls.hs new file mode 100644 index 0000000000..3fd6e43f4f --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Ls.hs @@ -0,0 +1,33 @@ +module Unison.Codebase.Editor.HandleInput.Ls + ( handleLs, + ) +where + +import Control.Monad.Reader (ask) +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.PrettyPrintUtils qualified as Cli +import Unison.Codebase.Editor.Output +import Unison.Codebase.Editor.StructuredArgument qualified as SA +import Unison.Codebase.Path (Path') +import Unison.Prelude +import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.Server.Backend qualified as Backend + +handleLs :: Path' -> Cli () +handleLs pathArg = do + Cli.Env {codebase} <- ask + + pathArgAbs <- Cli.resolvePath' pathArg + entries <- liftIO (Backend.lsAtPath codebase Nothing pathArgAbs) + Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArg) entries + pped <- Cli.currentPrettyPrintEnvDecl + let suffixifiedPPE = PPED.suffixifiedPPE pped + -- This used to be a delayed action which only forced the loading of the root + -- branch when it was necessary for printing the results, but that got wiped out + -- when we ported to the new Cli monad. + -- It would be nice to restore it, but it's pretty rare that it actually results + -- in an improvement, so perhaps it's not worth the effort. + let buildPPE = pure suffixifiedPPE + Cli.respond $ ListShallow buildPPE entries diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index d530ed68b2..a80454156d 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -66,6 +66,7 @@ library Unison.Codebase.Editor.HandleInput.FormatFile Unison.Codebase.Editor.HandleInput.InstallLib Unison.Codebase.Editor.HandleInput.Load + Unison.Codebase.Editor.HandleInput.Ls Unison.Codebase.Editor.HandleInput.Merge2 Unison.Codebase.Editor.HandleInput.MoveAll Unison.Codebase.Editor.HandleInput.MoveBranch From 35e2dfb8e5f81976286f5340d1c9ff025571e225 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 24 Jun 2024 09:57:17 -0400 Subject: [PATCH 220/631] delete patches from ls output --- unison-share-api/src/Unison/Server/Backend.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs index c2e2ceffb0..fe54c93d15 100644 --- a/unison-share-api/src/Unison/Server/Backend.hs +++ b/unison-share-api/src/Unison/Server/Backend.hs @@ -579,14 +579,10 @@ lsBranch codebase b0 = do (ns, (h, stats)) <- Map.toList $ childrenWithStats guard $ V2Branch.hasDefinitions stats pure $ ShallowBranchEntry ns (V2Causal.causalHash h) stats - patchEntries :: [ShallowListEntry Symbol Ann] = do - (ns, _h) <- Map.toList $ V2Branch.patches b0 - pure $ ShallowPatchEntry ns pure . List.sortOn listEntryName $ termEntries ++ typeEntries ++ branchEntries - ++ patchEntries -- Any absolute names in the input which have `root` as a prefix -- are converted to names relative to current path. All other names are From 60f99c218a66af32ffd47f733c63ae78a48a6960 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 24 Jun 2024 12:50:38 -0700 Subject: [PATCH 221/631] Insert scratch branch after adding the causal hash table --- codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs | 2 +- .../src/Unison/Codebase/SqliteCodebase/Operations.hs | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 873f43f7b3..d65c720a0e 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3755,7 +3755,7 @@ loadProjectAndBranchNames projectId branchId = |] -- | Insert a project branch. -insertProjectBranch :: Text -> CausalHashId -> ProjectBranch -> Transaction () +insertProjectBranch :: HasCallStack => Text -> CausalHashId -> ProjectBranch -> Transaction () insertProjectBranch description causalHashId (ProjectBranch projectId branchId branchName maybeParentBranchId) = do -- Ensure we never point at a causal we don't have the branch for. _ <- expectBranchObjectIdByCausalHashId causalHashId diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index 6c2850d6f9..fa3544cefd 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -93,9 +93,10 @@ createSchema = do Q.addMostRecentNamespaceTable Sqlite.execute insertSchemaVersionSql Q.addSquashResultTable - (_, emptyCausalHashId) <- emptyCausalHash - void $ insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId Q.addProjectBranchCausalHashIdColumn + (_, emptyCausalHashId) <- emptyCausalHash + (_, ProjectBranch {projectId, branchId}) <- insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId + Q.setCurrentProjectPath projectId branchId [] Q.addProjectBranchReflogTable Q.addProjectBranchCausalHashIdColumn where From 42619024de3d73dad89ec7a989c41d3f92ed4445 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 24 Jun 2024 13:00:01 -0700 Subject: [PATCH 222/631] Fix order of operations on codebase creation --- .../src/Unison/Codebase/SqliteCodebase/Operations.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index fa3544cefd..050d7f5fda 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -93,12 +93,12 @@ createSchema = do Q.addMostRecentNamespaceTable Sqlite.execute insertSchemaVersionSql Q.addSquashResultTable + Q.addCurrentProjectPathTable + Q.addProjectBranchReflogTable Q.addProjectBranchCausalHashIdColumn (_, emptyCausalHashId) <- emptyCausalHash (_, ProjectBranch {projectId, branchId}) <- insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId Q.setCurrentProjectPath projectId branchId [] - Q.addProjectBranchReflogTable - Q.addProjectBranchCausalHashIdColumn where scratchProjectName = UnsafeProjectName "scratch" scratchBranchName = UnsafeProjectBranchName "main" From 4fb007799d11bd2c6e7b17d2866783a687f4235e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 24 Jun 2024 13:05:51 -0700 Subject: [PATCH 223/631] Don't create new projects on each transcript, just use the current project (usually scratch/main) --- unison-cli/src/Unison/Codebase/TranscriptParser.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/TranscriptParser.hs index 95978c14db..f59169efdd 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/unison-cli/src/Unison/Codebase/TranscriptParser.hs @@ -56,10 +56,8 @@ import Unison.Codebase.Editor.HandleInput qualified as HandleInput import Unison.Codebase.Editor.Input (Event (UnisonFileChanged), Input (..)) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Editor.UCMVersion (UCMVersion) -import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Runtime -import Unison.Codebase.SqliteCodebase.Operations qualified as Ops import Unison.Codebase.Verbosity (Verbosity, isSilent) import Unison.Codebase.Verbosity qualified as Verbosity import Unison.CommandLine @@ -67,7 +65,7 @@ import Unison.CommandLine.InputPattern (InputPattern (aliases, patternName)) import Unison.CommandLine.InputPatterns (validInputs) import Unison.CommandLine.OutputMessages (notifyNumbered, notifyUser) import Unison.CommandLine.Welcome (asciiartUnison) -import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName), ProjectName (..)) +import Unison.Core.Project (ProjectBranchName, ProjectName (..)) import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyTerminal @@ -249,8 +247,8 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion httpManager <- HTTP.newManager HTTP.defaultManagerSettings (initialPP, emptyCausalHashId) <- Codebase.runTransaction codebase do (_, emptyCausalHashId) <- Codebase.emptyCausalHash - (proj, branch) <- Ops.insertProjectAndBranch (UnsafeProjectName "scratch") (UnsafeProjectBranchName "main") emptyCausalHashId - pure (PP.ProjectPath proj.projectId branch.branchId Path.absoluteEmpty, emptyCausalHashId) + initialPP <- Codebase.expectCurrentProjectPath + pure (initialPP, emptyCausalHashId) projectRootVar <- newTMVarIO Branch.empty unless (isSilent verbosity) . putPrettyLn $ @@ -574,7 +572,7 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion texts <- readIORef out pure $ Text.concat (Text.pack <$> toList (texts :: Seq String)) - loop (Cli.loopState0 projectRootVar initialPP) + loop (Cli.loopState0 projectRootVar (PP.toIds initialPP)) transcriptFailure :: IORef (Seq String) -> Text -> IO b transcriptFailure out msg = do From 5a6fe2084e9724a04ddac9ac4a9f6f6303203d74 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 24 Jun 2024 13:15:56 -0700 Subject: [PATCH 224/631] Migrate loose code into legacy project --- .../Migrations/MigrateSchema16To17.hs | 55 +++++++++++++++++-- 1 file changed, 49 insertions(+), 6 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs index 3feba3768a..532b6767f5 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs @@ -10,11 +10,14 @@ import Data.UUID (UUID) import Data.UUID qualified as UUID import U.Codebase.Branch.Type qualified as V2Branch import U.Codebase.Causal qualified as V2Causal -import U.Codebase.Sqlite.DbId (ProjectBranchId (..), ProjectId (..)) +import U.Codebase.Sqlite.DbId (CausalHashId, ProjectBranchId (..), ProjectId (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Path qualified as Path +import Unison.Codebase.SqliteCodebase.Branch.Cache qualified as BranchCache +import Unison.Codebase.SqliteCodebase.Operations qualified as CodebaseOps import Unison.Codebase.SqliteCodebase.Operations qualified as Ops import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName), ProjectName (UnsafeProjectName)) import Unison.Debug qualified as Debug @@ -42,6 +45,8 @@ migrateSchema16To17 conn = withDisabledForeignKeys $ do Q.addProjectBranchReflogTable Debug.debugLogM Debug.Migration "Adding causal hashes to project branches table." addCausalHashesToProjectBranches + Debug.debugLogM Debug.Migration "Making legacy project from loose code." + makeLegacyProjectFromLooseCode Debug.debugLogM Debug.Migration "Adding scratch project" scratchMain <- Q.loadProjectBranchByNames scratchProjectName scratchBranchName >>= \case @@ -66,11 +71,12 @@ migrateSchema16To17 conn = withDisabledForeignKeys $ do let action = Sqlite.runWriteTransaction conn \run -> run $ m UnsafeIO.bracket disable (const enable) (const action) -newtype ForeignKeyFailureException +data ForeignKeyFailureException = ForeignKeyFailureException -- We leave the data as raw as possible to ensure we can display it properly rather than get decoding errors while -- trying to display some other error. [[Sqlite.SQLData]] + | MissingRootBranch deriving stock (Show) deriving anyclass (Exception) @@ -94,14 +100,14 @@ without rowid; |] rootCausalHashId <- Q.expectNamespaceRoot rootCh <- Q.expectCausalHash rootCausalHashId - projectsRoot <- Codebase.getShallowCausalAtPathFromRootHash rootCh (Path.singleton $ NameSegment.unsafeParseText "__projects") >>= V2Causal.value + projectsRoot <- Codebase.getShallowCausalAtPathFromRootHash rootCh (Path.singleton $ projectsNameSegment) >>= V2Causal.value ifor_ (V2Branch.children projectsRoot) \projectIdNS projectsCausal -> do projectId <- case projectIdNS of UUIDNameSegment projectIdUUID -> pure $ ProjectId projectIdUUID _ -> error $ "Invalid Project Id NameSegment:" <> show projectIdNS Debug.debugM Debug.Migration "Migrating project" projectId projectsBranch <- V2Causal.value projectsCausal - case (Map.lookup (NameSegment.unsafeParseText "branches") $ V2Branch.children projectsBranch) of + case (Map.lookup branchesNameSegment $ V2Branch.children projectsBranch) of Nothing -> pure () Just branchesCausal -> do branchesBranch <- V2Causal.value branchesCausal @@ -154,8 +160,39 @@ without rowid; foreignKeyErrs <- Sqlite.queryListRow [Sqlite.sql| PRAGMA foreign_key_check |] when (not . null $ foreignKeyErrs) . Sqlite.unsafeIO . UnliftIO.throwIO $ ForeignKeyFailureException foreignKeyErrs --- migrateLooseCodeIntoLegacyProject :: Sqlite.Transaction () --- migrateLooseCodeIntoLegacyProject = do () +makeLegacyProjectFromLooseCode :: Sqlite.Transaction () +makeLegacyProjectFromLooseCode = do + rootChId <- + Sqlite.queryOneCol @CausalHashId + [Sqlite.sql| + SELECT causal_id + FROM namespace_root + |] + rootCh <- Q.expectCausalHash rootChId + branchCache <- Sqlite.unsafeIO BranchCache.newBranchCache + getDeclType <- Sqlite.unsafeIO $ CodebaseOps.makeCachedTransaction 2048 CodebaseOps.getDeclType + rootBranch <- + CodebaseOps.getBranchForHash branchCache getDeclType rootCh `whenNothingM` do + Sqlite.unsafeIO . UnliftIO.throwIO $ MissingRootBranch + -- Remove the hidden projects root if one existed. + let rootWithoutProjects = rootBranch & over (Branch.head_ . Branch.children) (Map.delete projectsNameSegment) + CodebaseOps.putBranch rootWithoutProjects + let legacyBranchRootHash = Branch.headHash rootWithoutProjects + legacyBranchRootHashId <- Q.expectCausalHashIdByCausalHash legacyBranchRootHash + + let findLegacyName :: Maybe Int -> Sqlite.Transaction ProjectName + findLegacyName mayN = do + let tryProjName = case mayN of + Nothing -> UnsafeProjectName "legacy" + Just n -> UnsafeProjectName $ "legacy" <> Text.pack (show n) + Q.loadProjectBranchByNames tryProjName legacyBranchName >>= \case + Nothing -> pure tryProjName + Just _ -> findLegacyName . Just $ maybe 1 succ mayN + legacyProjName <- findLegacyName Nothing + void $ Ops.insertProjectAndBranch legacyProjName legacyBranchName legacyBranchRootHashId + pure () + where + legacyBranchName = UnsafeProjectBranchName "main" pattern UUIDNameSegment :: UUID -> NameSegment pattern UUIDNameSegment uuid <- @@ -165,3 +202,9 @@ pattern UUIDNameSegment uuid <- where UUIDNameSegment uuid = NameSegment (Text.cons '_' (Text.map (\c -> if c == '-' then '_' else c) (UUID.toText uuid))) + +projectsNameSegment :: NameSegment +projectsNameSegment = NameSegment.unsafeParseText "__projects" + +branchesNameSegment :: NameSegment +branchesNameSegment = NameSegment.unsafeParseText "branches" From 8c2b6cfa99e715c03ea4c1d7589a30f86b1ca32c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 24 Jun 2024 14:12:25 -0700 Subject: [PATCH 225/631] Remove now unused namespaceRoot combinators --- .../U/Codebase/Sqlite/Operations.hs | 28 +++++++--------- .../U/Codebase/Sqlite/Queries.hs | 32 ------------------- .../Migrations/MigrateSchema16To17.hs | 13 +++++++- .../Migrations/MigrateSchema1To2.hs | 22 +++++++++++-- .../Migrations/MigrateSchema3To4.hs | 13 +++++++- .../src/Unison/Cli/UniqueTypeGuidLookup.hs | 8 +++-- 6 files changed, 61 insertions(+), 55 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index 241b3e7034..b25e320d4b 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -239,8 +239,8 @@ expectValueHashByCausalHashId = loadValueHashById <=< Q.expectCausalValueHashId -- | Load the causal hash at the given path from the provided root, if Nothing, use the -- codebase root. -loadCausalHashAtPath :: Maybe CausalHash -> [NameSegment] -> Transaction (Maybe CausalHash) -loadCausalHashAtPath mayRootCausalHash = +loadCausalHashAtPath :: CausalHash -> [NameSegment] -> Transaction (Maybe CausalHash) +loadCausalHashAtPath rootCausalHash = let go :: Db.CausalHashId -> [NameSegment] -> MaybeT Transaction CausalHash go hashId = \case [] -> lift (Q.expectCausalHash hashId) @@ -250,15 +250,13 @@ loadCausalHashAtPath mayRootCausalHash = (_, hashId') <- MaybeT (pure (Map.lookup tid children)) go hashId' ts in \path -> do - hashId <- case mayRootCausalHash of - Nothing -> Q.expectNamespaceRoot - Just rootCH -> Q.expectCausalHashIdByCausalHash rootCH + hashId <- Q.expectCausalHashIdByCausalHash rootCausalHash runMaybeT (go hashId path) -- | Expect the causal hash at the given path from the provided root, if Nothing, use the -- codebase root. -expectCausalHashAtPath :: Maybe CausalHash -> [NameSegment] -> Transaction CausalHash -expectCausalHashAtPath mayRootCausalHash = +expectCausalHashAtPath :: CausalHash -> [NameSegment] -> Transaction CausalHash +expectCausalHashAtPath rootCausalHash = let go :: Db.CausalHashId -> [NameSegment] -> Transaction CausalHash go hashId = \case [] -> Q.expectCausalHash hashId @@ -268,23 +266,21 @@ expectCausalHashAtPath mayRootCausalHash = let (_, hashId') = children Map.! tid go hashId' ts in \path -> do - hashId <- case mayRootCausalHash of - Nothing -> Q.expectNamespaceRoot - Just rootCH -> Q.expectCausalHashIdByCausalHash rootCH + hashId <- Q.expectCausalHashIdByCausalHash rootCausalHash go hashId path loadCausalBranchAtPath :: - Maybe CausalHash -> + CausalHash -> [NameSegment] -> Transaction (Maybe (C.Branch.CausalBranch Transaction)) -loadCausalBranchAtPath maybeRootCausalHash path = - loadCausalHashAtPath maybeRootCausalHash path >>= \case +loadCausalBranchAtPath rootCausalHash path = + loadCausalHashAtPath rootCausalHash path >>= \case Nothing -> pure Nothing Just causalHash -> Just <$> expectCausalBranchByCausalHash causalHash -loadBranchAtPath :: Maybe CausalHash -> [NameSegment] -> Transaction (Maybe (C.Branch.Branch Transaction)) -loadBranchAtPath maybeRootCausalHash path = - loadCausalBranchAtPath maybeRootCausalHash path >>= \case +loadBranchAtPath :: CausalHash -> [NameSegment] -> Transaction (Maybe (C.Branch.Branch Transaction)) +loadBranchAtPath rootCausalHash path = + loadCausalBranchAtPath rootCausalHash path >>= \case Nothing -> pure Nothing Just causal -> Just <$> C.Causal.value causal diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index d65c720a0e..61e1cb1ddb 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -66,12 +66,6 @@ module U.Codebase.Sqlite.Queries loadTermObject, expectTermObject, - -- * namespace_root table - loadNamespaceRoot, - setNamespaceRoot, - expectNamespaceRoot, - expectNamespaceRootBranchHashId, - -- * namespace_statistics table saveNamespaceStats, loadNamespaceStatsByHashId, @@ -1344,32 +1338,6 @@ loadCausalParentsByHash hash = WHERE h1.base32 = :hash COLLATE NOCASE |] -expectNamespaceRootBranchHashId :: Transaction BranchHashId -expectNamespaceRootBranchHashId = do - chId <- expectNamespaceRoot - expectCausalValueHashId chId - -expectNamespaceRoot :: Transaction CausalHashId -expectNamespaceRoot = - queryOneCol loadNamespaceRootSql - -loadNamespaceRoot :: Transaction (Maybe CausalHashId) -loadNamespaceRoot = - queryMaybeCol loadNamespaceRootSql - -loadNamespaceRootSql :: Sql -loadNamespaceRootSql = - [sql| - SELECT causal_id - FROM namespace_root - |] - -setNamespaceRoot :: CausalHashId -> Transaction () -setNamespaceRoot id = - queryOneCol [sql| SELECT EXISTS (SELECT 1 FROM namespace_root) |] >>= \case - False -> execute [sql| INSERT INTO namespace_root VALUES (:id) |] - True -> execute [sql| UPDATE namespace_root SET causal_id = :id |] - saveWatch :: WatchKind -> S.Reference.IdH -> ByteString -> Transaction () saveWatch k r blob = do execute diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs index 532b6767f5..48e711d13a 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs @@ -98,7 +98,7 @@ CREATE TABLE new_project_branch ( ) without rowid; |] - rootCausalHashId <- Q.expectNamespaceRoot + rootCausalHashId <- expectNamespaceRoot rootCh <- Q.expectCausalHash rootCausalHashId projectsRoot <- Codebase.getShallowCausalAtPathFromRootHash rootCh (Path.singleton $ projectsNameSegment) >>= V2Causal.value ifor_ (V2Branch.children projectsRoot) \projectIdNS projectsCausal -> do @@ -194,6 +194,17 @@ makeLegacyProjectFromLooseCode = do where legacyBranchName = UnsafeProjectBranchName "main" +expectNamespaceRoot :: Sqlite.Transaction CausalHashId +expectNamespaceRoot = + Sqlite.queryOneCol loadNamespaceRootSql + +loadNamespaceRootSql :: Sqlite.Sql +loadNamespaceRootSql = + [Sqlite.sql| + SELECT causal_id + FROM namespace_root + |] + pattern UUIDNameSegment :: UUID -> NameSegment pattern UUIDNameSegment uuid <- ( NameSegment.toUnescapedText -> diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs index 475e19d338..76e7a67121 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs @@ -1,5 +1,6 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2 @@ -103,7 +104,7 @@ migrateSchema1To2 getDeclType termBuffer declBuffer = do log "I'll go ahead with the migration, but will replace any corrupted namespaces with empty ones." log "Updating Namespace Root..." - rootCausalHashId <- Q.expectNamespaceRoot + rootCausalHashId <- expectNamespaceRoot numEntitiesToMigrate <- sum <$> sequenceA [Q.countObjects, Q.countCausals, Q.countWatches] v2EmptyBranchHashInfo <- saveV2EmptyBranch watches <- @@ -115,7 +116,7 @@ migrateSchema1To2 getDeclType termBuffer declBuffer = do `execStateT` MigrationState Map.empty Map.empty Map.empty Set.empty 0 v2EmptyBranchHashInfo let (_, newRootCausalHashId) = causalMapping migrationState ^?! ix rootCausalHashId log "Updating Namespace Root..." - Q.setNamespaceRoot newRootCausalHashId + setNamespaceRoot newRootCausalHashId log "Rewriting old object IDs..." ifor_ (objLookup migrationState) \oldObjId (newObjId, _, _, _) -> do Q.recordObjectRehash oldObjId newObjId @@ -149,6 +150,23 @@ migrateSchema1To2 getDeclType termBuffer declBuffer = do allDone = lift $ log $ "\nFinished migrating, initiating cleanup." in Sync.Progress {need, done, error = errorHandler, allDone} +expectNamespaceRoot :: Sqlite.Transaction CausalHashId +expectNamespaceRoot = + Sqlite.queryOneCol loadNamespaceRootSql + +loadNamespaceRootSql :: Sqlite.Sql +loadNamespaceRootSql = + [Sqlite.sql| + SELECT causal_id + FROM namespace_root + |] + +setNamespaceRoot :: CausalHashId -> Sqlite.Transaction () +setNamespaceRoot id = + Sqlite.queryOneCol [Sqlite.sql| SELECT EXISTS (SELECT 1 FROM namespace_root) |] >>= \case + False -> Sqlite.execute [Sqlite.sql| INSERT INTO namespace_root VALUES (:id) |] + True -> Sqlite.execute [Sqlite.sql| UPDATE namespace_root SET causal_id = :id |] + log :: String -> Sqlite.Transaction () log = Sqlite.unsafeIO . putStrLn diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema3To4.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema3To4.hs index 57dbdea27b..b68ee1541e 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema3To4.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema3To4.hs @@ -81,7 +81,7 @@ numMigrated = migrateSchema3To4 :: Sqlite.Transaction () migrateSchema3To4 = do Q.expectSchemaVersion 3 - rootCausalHashId <- Q.expectNamespaceRoot + rootCausalHashId <- expectNamespaceRoot totalCausals <- causalCount migrationState <- flip execStateT (MigrationState mempty mempty 0) $ Sync.sync migrationSync (migrationProgress totalCausals) [rootCausalHashId] let MigrationState {_canonicalBranchForCausalHashId = mapping} = migrationState @@ -98,6 +98,17 @@ migrateSchema3To4 = do SELECT count(*) FROM causal; |] +expectNamespaceRoot :: Sqlite.Transaction DB.CausalHashId +expectNamespaceRoot = + Sqlite.queryOneCol loadNamespaceRootSql + +loadNamespaceRootSql :: Sqlite.Sql +loadNamespaceRootSql = + [Sqlite.sql| + SELECT causal_id + FROM namespace_root + |] + migrationProgress :: Int -> Sync.Progress (StateT MigrationState Sqlite.Transaction) DB.CausalHashId migrationProgress totalCausals = Sync.Progress {Sync.need, Sync.done, Sync.error, Sync.allDone} diff --git a/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs b/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs index 21aa566256..457b261e46 100644 --- a/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs +++ b/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs @@ -9,15 +9,16 @@ import Control.Lens (unsnoc) import Data.Foldable qualified as Foldable import Data.Maybe (fromJust) import U.Codebase.Branch qualified as Codebase.Branch -import U.Codebase.Sqlite.Operations qualified as Operations +import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.UniqueTypeGuidLookup qualified as Codebase import Unison.Name (Name) import Unison.NameSegment (NameSegment) import Unison.Prelude import Unison.Sqlite qualified as Sqlite -loadUniqueTypeGuid :: Path.Absolute -> Name -> Sqlite.Transaction (Maybe Text) +loadUniqueTypeGuid :: ProjectPath -> Name -> Sqlite.Transaction (Maybe Text) loadUniqueTypeGuid currentPath name0 = do -- First, resolve the current path and the (probably/hopefully relative) name of the unique type to the full path -- to the unique type, plus its final distinguished name segment. @@ -36,6 +37,7 @@ loadUniqueTypeGuid currentPath name0 = do -- This ought to probably lean somewhat on a cache (so long as the caller is aware of the cache, and discrads it at -- an appropriate time, such as after the current unison file finishes parsing). let loadBranchAtPath :: [NameSegment] -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction)) - loadBranchAtPath = Operations.loadBranchAtPath Nothing + loadBranchAtPath = + Codebase.getShallowBranchAtProjectPath Codebase.loadUniqueTypeGuid loadBranchAtPath (Foldable.toList @Seq branchPath) name From d745d241140a4c61440cd38c95c1b83bd322326e Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Tue, 18 Jun 2024 23:45:30 +0100 Subject: [PATCH 226/631] Trivial fixes * trivial additions of functor * limit imports to just used functions * remove unnecesary imports --- codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalIds.hs | 2 +- .../codebase-sqlite/U/Codebase/Sqlite/Patch/TypeEdit.hs | 2 +- codebase2/codebase/U/Codebase/Referent.hs | 2 +- codebase2/codebase/U/Codebase/Reflog.hs | 1 + codebase2/core/U/Codebase/Reference.hs | 2 +- codebase2/core/Unison/Core/Project.hs | 2 +- lib/unison-util-nametree/src/Unison/Util/Defns.hs | 2 +- parser-typechecker/src/Unison/Codebase/Execute.hs | 3 ++- .../SqliteCodebase/Migrations/MigrateSchema6To7.hs | 1 - .../src/Unison/KindInference/Solve/Monad.hs | 3 ++- unison-cli/src/Unison/LSP/CodeLens.hs | 1 - unison-cli/src/Unison/LSP/UCMWorker.hs | 5 ++++- .../src/Unison/Server/Local/Endpoints/Current.hs | 1 - .../src/Unison/Server/Local/Endpoints/FuzzyFind.hs | 1 - .../src/Unison/Server/Local/Endpoints/NamespaceDetails.hs | 1 - .../src/Unison/Server/Local/Endpoints/NamespaceListing.hs | 1 - unison-share-api/src/Unison/Server/Types.hs | 2 +- unison-share-api/src/Unison/Sync/Types.hs | 8 ++++---- 18 files changed, 20 insertions(+), 20 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalIds.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalIds.hs index 1cfd697365..d8645b81ae 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalIds.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalIds.hs @@ -15,7 +15,7 @@ data LocalIds' t h = LocalIds { textLookup :: Vector t, defnLookup :: Vector h } - deriving (Show) + deriving (Functor, Show) type LocalIds = LocalIds' TextId ObjectId diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TypeEdit.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TypeEdit.hs index 6b8d3ea48c..ae0816b6b9 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TypeEdit.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TypeEdit.hs @@ -17,7 +17,7 @@ type TypeEdit = TypeEdit' Db.TextId Db.ObjectId type HashTypeEdit = TypeEdit' Text ComponentHash data TypeEdit' t h = Replace (Reference' t h) | Deprecate - deriving (Eq, Ord, Show) + deriving (Eq, Functor, Ord, Show) _Replace :: Prism (TypeEdit' t h) (TypeEdit' t' h') (Reference' t h) (Reference' t' h') _Replace = prism Replace project diff --git a/codebase2/codebase/U/Codebase/Referent.hs b/codebase2/codebase/U/Codebase/Referent.hs index 7eeeccba85..93aec093a8 100644 --- a/codebase2/codebase/U/Codebase/Referent.hs +++ b/codebase2/codebase/U/Codebase/Referent.hs @@ -63,7 +63,7 @@ type Id = Id' Hash Hash data Id' hTm hTp = RefId (Reference.Id' hTm) | ConId (Reference.Id' hTp) ConstructorId - deriving (Eq, Ord, Show) + deriving (Eq, Functor, Ord, Show) instance Bifunctor Referent' where bimap f g = \case diff --git a/codebase2/codebase/U/Codebase/Reflog.hs b/codebase2/codebase/U/Codebase/Reflog.hs index 971bc48395..27cc5ea59d 100644 --- a/codebase2/codebase/U/Codebase/Reflog.hs +++ b/codebase2/codebase/U/Codebase/Reflog.hs @@ -13,6 +13,7 @@ data Entry causal text = Entry toRootCausalHash :: causal, reason :: text } + deriving (Functor) instance Bifunctor Entry where bimap = bimapDefault diff --git a/codebase2/core/U/Codebase/Reference.hs b/codebase2/core/U/Codebase/Reference.hs index 1146ca8aa1..e40ce2ac37 100644 --- a/codebase2/core/U/Codebase/Reference.hs +++ b/codebase2/core/U/Codebase/Reference.hs @@ -74,7 +74,7 @@ data ReferenceType = RtTerm | RtType deriving (Eq, Ord, Show) data Reference' t h = ReferenceBuiltin t | ReferenceDerived (Id' h) - deriving stock (Eq, Generic, Ord, Show) + deriving stock (Eq, Generic, Functor, Ord, Show) -- | A type declaration reference. type TermReference' t h = Reference' t h diff --git a/codebase2/core/Unison/Core/Project.hs b/codebase2/core/Unison/Core/Project.hs index 632f9702ec..8f5e05eca6 100644 --- a/codebase2/core/Unison/Core/Project.hs +++ b/codebase2/core/Unison/Core/Project.hs @@ -29,7 +29,7 @@ data ProjectAndBranch a b = ProjectAndBranch { project :: a, branch :: b } - deriving stock (Eq, Generic, Show) + deriving stock (Eq, Generic, Show, Functor) instance Bifunctor ProjectAndBranch where bimap f g (ProjectAndBranch a b) = ProjectAndBranch (f a) (g b) diff --git a/lib/unison-util-nametree/src/Unison/Util/Defns.hs b/lib/unison-util-nametree/src/Unison/Util/Defns.hs index 9dde575531..34e17de7e7 100644 --- a/lib/unison-util-nametree/src/Unison/Util/Defns.hs +++ b/lib/unison-util-nametree/src/Unison/Util/Defns.hs @@ -28,7 +28,7 @@ data Defns terms types = Defns { terms :: terms, types :: types } - deriving stock (Generic, Show) + deriving stock (Generic, Functor, Show) deriving (Monoid, Semigroup) via GenericSemigroupMonoid (Defns terms types) instance Bifoldable Defns where diff --git a/parser-typechecker/src/Unison/Codebase/Execute.hs b/parser-typechecker/src/Unison/Codebase/Execute.hs index e7f1ef0762..7d16261821 100644 --- a/parser-typechecker/src/Unison/Codebase/Execute.hs +++ b/parser-typechecker/src/Unison/Codebase/Execute.hs @@ -6,7 +6,8 @@ module Unison.Codebase.Execute where import Control.Exception (finally) -import Control.Monad.Except +import Control.Monad.Except (throwError, runExceptT) +import Control.Monad.IO.Class (liftIO) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema6To7.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema6To7.hs index b62708f70c..f09ff8559c 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema6To7.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema6To7.hs @@ -4,7 +4,6 @@ module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema6To7 (migrateSchema6To7) where -import Control.Monad.Except import Control.Monad.State import U.Codebase.Branch.Type (NamespaceStats) import U.Codebase.Sqlite.DbId qualified as DB diff --git a/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs b/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs index d0d8fc58fb..82090bf237 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs @@ -14,6 +14,7 @@ module Unison.KindInference.Solve.Monad where import Control.Lens (Lens', (%%~)) +import Control.Monad.Fix (MonadFix (..)) import Control.Monad.Reader qualified as M import Control.Monad.State.Strict qualified as M import Data.Functor.Identity @@ -64,7 +65,7 @@ newtype Solve v loc a = Solve {unSolve :: Env -> SolveState v loc -> (a, SolveSt ( Functor, Applicative, Monad, - M.MonadFix, + MonadFix, M.MonadReader Env, M.MonadState (SolveState v loc) ) diff --git a/unison-cli/src/Unison/LSP/CodeLens.hs b/unison-cli/src/Unison/LSP/CodeLens.hs index 38df42a72e..a5017ee99d 100644 --- a/unison-cli/src/Unison/LSP/CodeLens.hs +++ b/unison-cli/src/Unison/LSP/CodeLens.hs @@ -6,7 +6,6 @@ module Unison.LSP.CodeLens where import Control.Lens hiding (List) -import Control.Monad.Except import Data.Aeson qualified as Aeson import Data.Map qualified as Map import Data.Text qualified as Text diff --git a/unison-cli/src/Unison/LSP/UCMWorker.hs b/unison-cli/src/Unison/LSP/UCMWorker.hs index 2f28955021..d404bc6d19 100644 --- a/unison-cli/src/Unison/LSP/UCMWorker.hs +++ b/unison-cli/src/Unison/LSP/UCMWorker.hs @@ -1,6 +1,9 @@ module Unison.LSP.UCMWorker where -import Control.Monad.Reader +import Control.Monad (guard) +import Control.Monad.State (liftIO) +import Control.Monad.Reader.Class (ask) +import Data.Functor (void) import U.Codebase.HashTags import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs index 5cc218b7eb..15972297f1 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs @@ -3,7 +3,6 @@ module Unison.Server.Local.Endpoints.Current where -import Control.Monad.Except import Data.Aeson import Data.OpenApi (ToSchema (..)) import Servant ((:>)) diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs index 5aaa434463..6b6cc031ca 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs @@ -4,7 +4,6 @@ module Unison.Server.Local.Endpoints.FuzzyFind where -import Control.Monad.Except import Data.Aeson import Data.OpenApi (ToSchema) import Servant diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs index bcb6ca5fa1..1ea65e553b 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs @@ -4,7 +4,6 @@ module Unison.Server.Local.Endpoints.NamespaceDetails where -import Control.Monad.Except import Data.Set qualified as Set import Servant (Capture, QueryParam, (:>)) import Servant.Docs (DocCapture (..), ToCapture (..)) diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs index fe5e5ee06a..b683131f40 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs @@ -4,7 +4,6 @@ module Unison.Server.Local.Endpoints.NamespaceListing (serve, NamespaceListingAPI, NamespaceListing (..), NamespaceObject (..), NamedNamespace (..), NamedPatch (..), KindExpression (..)) where -import Control.Monad.Except import Data.Aeson import Data.OpenApi (ToSchema) import Servant diff --git a/unison-share-api/src/Unison/Server/Types.hs b/unison-share-api/src/Unison/Server/Types.hs index 48f9ace2bc..6a3421709d 100644 --- a/unison-share-api/src/Unison/Server/Types.hs +++ b/unison-share-api/src/Unison/Server/Types.hs @@ -104,7 +104,7 @@ data ExactName name ref = ExactName { name :: name, ref :: ref } - deriving stock (Show, Eq, Ord) + deriving stock (Show, Eq, Functor, Ord) instance ToParamSchema (ExactName Name ShortHash) where toParamSchema _ = diff --git a/unison-share-api/src/Unison/Sync/Types.hs b/unison-share-api/src/Unison/Sync/Types.hs index ccd680135f..45da44748d 100644 --- a/unison-share-api/src/Unison/Sync/Types.hs +++ b/unison-share-api/src/Unison/Sync/Types.hs @@ -203,7 +203,7 @@ entityDependencies = \case C Causal {namespaceHash, parents} -> Set.insert namespaceHash parents data TermComponent text hash = TermComponent [(LocalIds text hash, ByteString)] - deriving stock (Show, Eq, Ord) + deriving stock (Show, Eq, Functor, Ord) instance Bifoldable TermComponent where bifoldMap = bifoldMapDefault @@ -252,7 +252,7 @@ decodeComponentPiece = Aeson.withObject "Component Piece" \obj -> do pure (localIDs, bytes) data DeclComponent text hash = DeclComponent [(LocalIds text hash, ByteString)] - deriving stock (Show, Eq, Ord) + deriving stock (Show, Eq, Functor, Ord) instance Bifoldable DeclComponent where bifoldMap = bifoldMapDefault @@ -280,7 +280,7 @@ data LocalIds text hash = LocalIds { texts :: [text], hashes :: [hash] } - deriving stock (Show, Eq, Ord) + deriving stock (Show, Eq, Functor, Ord) instance Bifoldable LocalIds where bifoldMap = bifoldMapDefault @@ -381,7 +381,7 @@ data Namespace text hash = Namespace childLookup :: [(hash, hash)], -- (namespace hash, causal hash) bytes :: LocalBranchBytes } - deriving stock (Eq, Ord, Show) + deriving stock (Eq, Functor, Ord, Show) instance Bifoldable Namespace where bifoldMap = bifoldMapDefault From 56874a6082f518b05f21d80848aeef0f0e657a5a Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Tue, 18 Jun 2024 23:45:32 +0100 Subject: [PATCH 227/631] s/forall/forAll/ as it will become a restricted keyword -Wforall-identifier --- codebase2/util-term/U/Util/Type.hs | 6 ++--- parser-typechecker/src/Unison/Builtin.hs | 2 +- .../src/Unison/Builtin/Decls.hs | 2 +- .../src/Unison/Codebase/MainTerm.hs | 2 +- .../src/Unison/Syntax/TypeParser.hs | 6 ++--- .../src/Unison/Typechecker/Context.hs | 8 +++--- .../tests/Unison/Test/DataDeclaration.hs | 8 +++--- parser-typechecker/tests/Unison/Test/Term.hs | 4 +-- .../tests/Unison/Test/Typechecker.hs | 4 +-- unison-core/src/Unison/Term.hs | 2 +- unison-core/src/Unison/Type.hs | 26 +++++++++---------- .../src/Unison/Hashing/V2/Type.hs | 6 ++--- 12 files changed, 38 insertions(+), 38 deletions(-) diff --git a/codebase2/util-term/U/Util/Type.hs b/codebase2/util-term/U/Util/Type.hs index 7acf6a4c14..a8eccccf05 100644 --- a/codebase2/util-term/U/Util/Type.hs +++ b/codebase2/util-term/U/Util/Type.hs @@ -61,7 +61,7 @@ flattenEffects es = [es] generalize :: (Ord v) => [v] -> TypeR r v -> TypeR r v generalize vs t = foldr f t vs where - f v t = if Set.member v (ABT.freeVars t) then forall v t else t + f v t = if Set.member v (ABT.freeVars t) then forAll v t else t -- * Patterns @@ -80,8 +80,8 @@ pattern Effect1' e t <- ABT.Tm' (Effect e t) pattern Ref' :: r -> TypeR r v pattern Ref' r <- ABT.Tm' (Ref r) -forall :: (Ord v) => v -> TypeR r v -> TypeR r v -forall v body = ABT.tm () (Forall (ABT.abs () v body)) +forAll :: (Ord v) => v -> TypeR r v -> TypeR r v +forAll v body = ABT.tm () (Forall (ABT.abs () v body)) unforall' :: TypeR r v -> ([v], TypeR r v) unforall' (ForallsNamed' vs t) = (vs, t) diff --git a/parser-typechecker/src/Unison/Builtin.hs b/parser-typechecker/src/Unison/Builtin.hs index 0c7e0514bf..1a9477fa63 100644 --- a/parser-typechecker/src/Unison/Builtin.hs +++ b/parser-typechecker/src/Unison/Builtin.hs @@ -985,7 +985,7 @@ refPromiseBuiltins = forall1 :: Text -> (Type -> Type) -> Type forall1 name body = let a = Var.named name - in Type.forall () a (body $ Type.var () a) + in Type.forAll () a (body $ Type.var () a) forall2 :: Text -> Text -> (Type -> Type -> Type) -> Type diff --git a/parser-typechecker/src/Unison/Builtin/Decls.hs b/parser-typechecker/src/Unison/Builtin/Decls.hs index b48bc44830..9a30893513 100644 --- a/parser-typechecker/src/Unison/Builtin/Decls.hs +++ b/parser-typechecker/src/Unison/Builtin/Decls.hs @@ -596,7 +596,7 @@ builtinEffectDecls = Structural () [] - [ ((), v "Exception.raise", Type.forall () (v "x") (failureType () `arr` self (var "x"))) + [ ((), v "Exception.raise", Type.forAll () (v "x") (failureType () `arr` self (var "x"))) ] pattern UnitRef :: Reference diff --git a/parser-typechecker/src/Unison/Codebase/MainTerm.hs b/parser-typechecker/src/Unison/Codebase/MainTerm.hs index 9f99ae5599..4c48a8a95b 100644 --- a/parser-typechecker/src/Unison/Codebase/MainTerm.hs +++ b/parser-typechecker/src/Unison/Codebase/MainTerm.hs @@ -57,7 +57,7 @@ getMainTerm loadTypeOfTerm parseNames mainName mainType = do builtinMain :: (Var v) => a -> Type.Type v a builtinMain a = let result = Var.named "result" - in Type.forall a result (builtinMainWithResultType a (Type.var a result)) + in Type.forAll a result (builtinMainWithResultType a (Type.var a result)) -- '{io2.IO, Exception} res builtinMainWithResultType :: (Var v) => a -> Type.Type v a -> Type.Type v a diff --git a/parser-typechecker/src/Unison/Syntax/TypeParser.hs b/parser-typechecker/src/Unison/Syntax/TypeParser.hs index ff84f94cbe..7a143c7877 100644 --- a/parser-typechecker/src/Unison/Syntax/TypeParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TypeParser.hs @@ -31,7 +31,7 @@ type TypeP v m = P v m (Type v Ann) -- the right of a function arrow: -- valueType ::= Int | Text | App valueType valueType | Arrow valueType computationType valueType :: (Monad m, Var v) => TypeP v m -valueType = forall type1 <|> type1 +valueType = forAll type1 <|> type1 -- Computation -- computationType ::= [{effect*}] valueType @@ -119,8 +119,8 @@ arrow rec = in chainr1 (effect <|> rec) (reserved "->" *> eff) -- "forall a b . List a -> List b -> Maybe Text" -forall :: (Var v) => TypeP v m -> TypeP v m -forall rec = do +forAll :: (Var v) => TypeP v m -> TypeP v m +forAll rec = do kw <- reserved "forall" <|> reserved "∀" vars <- fmap (fmap L.payload) . some $ prefixDefinitionName _ <- reserved "." diff --git a/parser-typechecker/src/Unison/Typechecker/Context.hs b/parser-typechecker/src/Unison/Typechecker/Context.hs index 11279cf898..f4932cd383 100644 --- a/parser-typechecker/src/Unison/Typechecker/Context.hs +++ b/parser-typechecker/src/Unison/Typechecker/Context.hs @@ -963,7 +963,7 @@ apply' solvedExistentials t = go t Type.Ann' v k -> Type.ann a (go v) k Type.Effect1' e t -> Type.effect1 a (go e) (go t) Type.Effects' es -> Type.effects a (map go es) - Type.ForallNamed' v t' -> Type.forall a v (go t') + Type.ForallNamed' v t' -> Type.forAll a v (go t') Type.IntroOuterNamed' v t' -> Type.introOuter a v (go t') _ -> error $ "Match error in Context.apply': " ++ show t where @@ -1059,7 +1059,7 @@ vectorConstructorOfArity loc arity = do let elementVar = Var.named "elem" args = replicate arity (loc, Type.var loc elementVar) resultType = Type.app loc (Type.list loc) (Type.var loc elementVar) - vt = Type.forall loc elementVar (Type.arrows args resultType) + vt = Type.forAll loc elementVar (Type.arrows args resultType) pure vt generalizeAndUnTypeVar :: (Var v) => Type v a -> Type.Type v a @@ -1984,7 +1984,7 @@ tweakEffects v0 t0 rewrite p ty | Type.ForallNamed' v t <- ty, v0 /= v = - second (Type.forall a v) <$> rewrite p t + second (Type.forAll a v) <$> rewrite p t | Type.Arrow' i o <- ty = do (vis, i) <- rewrite (not <$> p) i (vos, o) <- rewrite p o @@ -2097,7 +2097,7 @@ generalizeP p ctx0 ty = foldr gen (applyCtx ctx0 ty) ctx -- location of the forall is just the location of the input type -- and the location of each quantified variable is just inherited -- from its source location - Type.forall + Type.forAll (loc t) (TypeVar.Universal v) (ABT.substInheritAnnotation tv (universal' () v) t) diff --git a/parser-typechecker/tests/Unison/Test/DataDeclaration.hs b/parser-typechecker/tests/Unison/Test/DataDeclaration.hs index f7e66a7ada..425d9bd267 100644 --- a/parser-typechecker/tests/Unison/Test/DataDeclaration.hs +++ b/parser-typechecker/tests/Unison/Test/DataDeclaration.hs @@ -88,7 +88,7 @@ unhashComponentTest = inventedVarsFreshnessTest = let var = Type.var () app = Type.app () - forall = Type.forall () + forAll = Type.forAll () (-->) = Type.arrow () h = Hash.fromByteString (encodeUtf8 "abcd") ref = R.Id h 0 @@ -104,8 +104,8 @@ unhashComponentTest = annotation = (), bound = [], constructors' = - [ ((), nil, forall a (listType `app` var a)), - ((), cons, forall b (var b --> listType `app` var b --> listType `app` var b)) + [ ((), nil, forAll a (listType `app` var a)), + ((), cons, forAll b (var b --> listType `app` var b --> listType `app` var b)) ] } component :: Map R.Id (Decl Symbol ()) @@ -120,7 +120,7 @@ unhashComponentTest = in tests [ -- check that `nil` constructor's type did not collapse to `forall a. a a`, -- which would happen if the var invented for `listRef` was simply `Var.refNamed listRef` - expectEqual (forall z (listType' `app` var z)) nilType', + expectEqual (forAll z (listType' `app` var z)) nilType', -- check that the variable assigned to `listRef` is different from `cons`, -- which would happen if the var invented for `listRef` was simply `Var.refNamed listRef` expectNotEqual cons listVar diff --git a/parser-typechecker/tests/Unison/Test/Term.hs b/parser-typechecker/tests/Unison/Test/Term.hs index ae75589ac6..31122f5aac 100644 --- a/parser-typechecker/tests/Unison/Test/Term.hs +++ b/parser-typechecker/tests/Unison/Test/Term.hs @@ -33,7 +33,7 @@ test = Type.arrow () (tv "a") (tv "x") ) ) - (Type.forall () (v "a") (tv "a")) + (Type.forAll () (v "a") (tv "a")) tm' = Term.substTypeVar (v "x") (tv "a") tm expected = Term.ann @@ -45,7 +45,7 @@ test = Type.arrow () (Type.var () $ v1 "a") (tv "a") ) ) - (Type.forall () (v1 "a") (Type.var () $ v1 "a")) + (Type.forAll () (v1 "a") (Type.var () $ v1 "a")) note $ show tm' note $ show expected expect $ tm == tm diff --git a/parser-typechecker/tests/Unison/Test/Typechecker.hs b/parser-typechecker/tests/Unison/Test/Typechecker.hs index 6fe94b59be..ce39af19c2 100644 --- a/parser-typechecker/tests/Unison/Test/Typechecker.hs +++ b/parser-typechecker/tests/Unison/Test/Typechecker.hs @@ -18,12 +18,12 @@ test = isSubtypeTest :: Test () isSubtypeTest = let symbol i n = Symbol i (Var.User n) - forall v t = Type.forall () v t + forAll v t = Type.forAll () v t var v = Type.var () v a = symbol 0 "a" a_ i = symbol i "a" - lhs = forall a (var a) -- ∀a. a + lhs = forAll a (var a) -- ∀a. a rhs_ i = var (a_ i) -- a_i in -- check that `∀a. a <: a_i` (used to fail for i = 2, 3) tests [expectSubtype lhs (rhs_ i) | i <- [0 .. 5]] diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index 73df6fc3ae..c5f6193e1d 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -397,7 +397,7 @@ substTypeVar vt ty = go Set.empty t2 = ABT.bindInheritAnnotation body (Type.var () v2) in uncapture ((ABT.annotation t, v2) : vs) (renameTypeVar v v2 e) t2 uncapture vs e t0 = - let t = foldl (\body (loc, v) -> Type.forall loc v body) t0 vs + let t = foldl (\body (loc, v) -> Type.forAll loc v body) t0 vs bound' = case Type.unForalls (Type.stripIntroOuters t) of Nothing -> bound Just (vs, _) -> bound <> Set.fromList vs diff --git a/unison-core/src/Unison/Type.hs b/unison-core/src/Unison/Type.hs index 4e571ff761..d779aa7ce1 100644 --- a/unison-core/src/Unison/Type.hs +++ b/unison-core/src/Unison/Type.hs @@ -451,28 +451,28 @@ arrow' i o = arrow (ABT.annotation i <> ABT.annotation o) i o ann :: (Ord v) => a -> Type v a -> K.Kind -> Type v a ann a e t = ABT.tm' a (Ann e t) -forall :: (Ord v) => a -> v -> Type v a -> Type v a -forall a v body = ABT.tm' a (Forall (ABT.abs' a v body)) +forAll :: (Ord v) => a -> v -> Type v a -> Type v a +forAll a v body = ABT.tm' a (Forall (ABT.abs' a v body)) introOuter :: (Ord v) => a -> v -> Type v a -> Type v a introOuter a v body = ABT.tm' a (IntroOuter (ABT.abs' a v body)) iff :: (Var v) => Type v () -iff = forall () aa $ arrows (f <$> [boolean (), a, a]) a +iff = forAll () aa $ arrows (f <$> [boolean (), a, a]) a where aa = Var.named "a" a = var () aa f x = ((), x) iff' :: (Var v) => a -> Type v a -iff' loc = forall loc aa $ arrows (f <$> [boolean loc, a, a]) a +iff' loc = forAll loc aa $ arrows (f <$> [boolean loc, a, a]) a where aa = Var.named "a" a = var loc aa f x = (loc, x) iff2 :: (Var v) => a -> Type v a -iff2 loc = forall loc aa $ arrows (f <$> [a, a]) a +iff2 loc = forAll loc aa $ arrows (f <$> [a, a]) a where aa = Var.named "a" a = var loc aa @@ -498,11 +498,11 @@ v' s = ABT.var (Var.named s) av' :: (Var v) => a -> Text -> Type v a av' a s = ABT.annotatedVar a (Var.named s) -forall' :: (Var v) => a -> [Text] -> Type v a -> Type v a -forall' a vs body = foldr (forall a) body (Var.named <$> vs) +forAll' :: (Var v) => a -> [Text] -> Type v a -> Type v a +forAll' a vs body = foldr (forAll a) body (Var.named <$> vs) foralls :: (Ord v) => a -> [v] -> Type v a -> Type v a -foralls a vs body = foldr (forall a) body vs +foralls a vs body = foldr (forAll a) body vs -- Note: `a -> b -> c` parses as `a -> (b -> c)` -- the annotation associated with `b` will be the annotation for the `b -> c` @@ -545,7 +545,7 @@ stripEffect t = ([], t) -- The type of the flipped function application operator: -- `(a -> (a -> b) -> b)` flipApply :: (Var v) => Type v () -> Type v () -flipApply t = forall () b $ arrow () (arrow () t (var () b)) (var () b) +flipApply t = forAll () b $ arrow () (arrow () t (var () b)) (var () b) where b = ABT.fresh t (Var.named "b") @@ -554,12 +554,12 @@ generalize' k t = generalize vsk t where vsk = [v | v <- Set.toList (freeVars t), Var.typeOf v == k] --- | Bind the given variables with an outer `forall`, if they are used in `t`. +-- | Bind the given variables with an outer `forAll`, if they are used in `t`. generalize :: (Ord v) => [v] -> Type v a -> Type v a generalize vs t = foldr f t vs where f v t = - if Set.member v (ABT.freeVars t) then forall (ABT.annotation t) v t else t + if Set.member v (ABT.freeVars t) then forAll (ABT.annotation t) v t else t unforall :: Type v a -> Type v a unforall (ForallsNamed' _ t) = t @@ -755,7 +755,7 @@ functionResult = go False -- `.foo -> .foo` becomes `.foo -> .foo` (not changed) -- `.foo.bar -> blarrg.woot` becomes `.foo.bar -> blarrg.woot` (unchanged) generalizeLowercase :: (Var v) => Set v -> Type v a -> Type v a -generalizeLowercase except t = foldr (forall (ABT.annotation t)) t vars +generalizeLowercase except t = foldr (forAll (ABT.annotation t)) t vars where vars = [v | v <- Set.toList (ABT.freeVars t `Set.difference` except), Var.universallyQuantifyIfFree v] @@ -774,7 +774,7 @@ normalizeForallOrder tm0 = where step :: (a, v) -> Type v a -> Type v a step (a, v) body - | Set.member v (ABT.freeVars body) = forall a v body + | Set.member v (ABT.freeVars body) = forAll a v body | otherwise = body (body, vs0) = extract tm0 vs = sortOn (\(_, v) -> Map.lookup v ind) vs0 diff --git a/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs b/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs index 25a042e50c..14a5e0e809 100644 --- a/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs +++ b/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs @@ -103,15 +103,15 @@ charRef = ReferenceBuiltin "Char" listRef = ReferenceBuiltin "Sequence" effectRef = ReferenceBuiltin "Effect" -forall :: (Ord v) => a -> v -> Type v a -> Type v a -forall a v body = ABT.tm' a (TypeForall (ABT.abs' a v body)) +forAll :: (Ord v) => a -> v -> Type v a -> Type v a +forAll a v body = ABT.tm' a (TypeForall (ABT.abs' a v body)) -- | Bind the given variables with an outer `forall`, if they are used in `t`. generalize :: (Ord v) => [v] -> Type v a -> Type v a generalize vs t = foldr f t vs where f v t = - if Set.member v (ABT.freeVars t) then forall (ABT.annotation t) v t else t + if Set.member v (ABT.freeVars t) then forAll (ABT.annotation t) v t else t unforall' :: Type v a -> ([v], Type v a) unforall' (ForallsNamed' vs t) = (vs, t) From fff10977ec5ca9832a93ee9dbb01f19ee161d4ac Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Tue, 18 Jun 2024 23:45:34 +0100 Subject: [PATCH 228/631] move let block outside of inner function this caused a weird type error --- unison-cli/src/Unison/CommandLine/Completion.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/Completion.hs b/unison-cli/src/Unison/CommandLine/Completion.hs index 28822ea6f8..39e1fd00a3 100644 --- a/unison-cli/src/Unison/CommandLine/Completion.hs +++ b/unison-cli/src/Unison/CommandLine/Completion.hs @@ -196,12 +196,6 @@ completeWithinNamespace compTypes query currentPath = do namesInBranch :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [(CompletionType, Bool, Text)] namesInBranch hashLen b = do nonEmptyChildren <- V2Branch.nonEmptyChildren b - let textifyHQ :: (NameSegment -> r -> HQ'.HashQualified NameSegment) -> Map NameSegment (Map r metadata) -> [(Bool, Text)] - textifyHQ f xs = - xs - & hashQualifyCompletions f - & fmap (HQ'.toTextWith NameSegment.toEscapedText) - & fmap (True,) pure $ concat [ (NamespaceCompletion,False,) <$> (fmap NameSegment.toEscapedText . Map.keys $ nonEmptyChildren), @@ -216,6 +210,12 @@ completeWithinNamespace compTypes query currentPath = do (fmap ((PatchCompletion,True,) . NameSegment.toEscapedText) . Map.keys $ V2Branch.patches b) ] + textifyHQ :: (NameSegment -> r -> HQ'.HashQualified NameSegment) -> Map NameSegment (Map r metadata) -> [(Bool, Text)] + textifyHQ f xs = + xs + & hashQualifyCompletions f + & fmap (HQ'.toTextWith NameSegment.toEscapedText) + & fmap (True,) -- Regrettably there'shqFromNamedV2Referencenot a great spot to combinators for V2 references and shorthashes right now. hqFromNamedV2Referent :: Int -> NameSegment -> Referent.Referent -> HQ'.HashQualified NameSegment hqFromNamedV2Referent hashLen n r = HQ'.HashQualified n (Cv.referent2toshorthash1 (Just hashLen) r) From bbd11c9da76bc1ccd8fd423a3aef3107b01a0ce9 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Tue, 18 Jun 2024 23:45:36 +0100 Subject: [PATCH 229/631] define non-trivial functor --- .../codebase-sqlite/U/Codebase/Sqlite/Patch/TermEdit.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TermEdit.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TermEdit.hs index bc93dd166c..e588dc7540 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TermEdit.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/TermEdit.hs @@ -22,6 +22,12 @@ type Referent' t h = Referent.Referent' (Reference' t h) (Reference' t h) data TermEdit' t h = Replace (Referent' t h) Typing | Deprecate deriving (Eq, Ord, Show) +instance Functor (TermEdit' t) where + fmap :: (a -> b) -> TermEdit' t a -> TermEdit' t b + fmap f (Replace (Referent.Ref termRef) typing) = Replace (Referent.Ref (fmap f termRef)) typing + fmap f (Replace (Referent.Con typeRef consId) typing) = Replace (Referent.Con (fmap f typeRef) consId) typing + fmap _ Deprecate = Deprecate + _Replace :: Prism (TermEdit' t h) (TermEdit' t' h') (Referent' t h, Typing) (Referent' t' h', Typing) _Replace = prism embed project where From 037ac60bf39c924a4c61014497d26b72f21c7b8e Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Tue, 18 Jun 2024 23:45:37 +0100 Subject: [PATCH 230/631] Use TypeOperators --- lib/unison-prelude/src/Unison/Util/Tuple.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/unison-prelude/src/Unison/Util/Tuple.hs b/lib/unison-prelude/src/Unison/Util/Tuple.hs index 613af47a36..2a9fbfb52d 100644 --- a/lib/unison-prelude/src/Unison/Util/Tuple.hs +++ b/lib/unison-prelude/src/Unison/Util/Tuple.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeOperators #-} -- | Tuple utils. module Unison.Util.Tuple From 4453fda57028cb3f2a71dda458f679f2f84ecdc5 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Tue, 25 Jun 2024 09:26:49 +0100 Subject: [PATCH 231/631] fix redundant pattern match warning --- .../src/Unison/PatternMatchCoverage/Solve.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs index 5c10aa36ee..764d99266e 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs @@ -518,12 +518,9 @@ addConstraint con0 nc = do C.PosLit var pmlit -> let updateLiteral pos neg lit | Just lit1 <- pos, - lit1 == lit = case lit1 == lit of - -- we already have this positive constraint - True -> (pure (), Ignore) - -- contradicts positive info - False -> (contradiction, Ignore) - -- the constraint contradicts negative info + lit1 == lit = + (pure (), Ignore) -- we already have this positive constraint + -- the constraint contradicts negative info | Set.member lit neg = (contradiction, Ignore) | otherwise = (pure (), Update (Just lit, neg)) in modifyLiteralC var pmlit updateLiteral nc From 364b7790cad08534c216eb4bbb5bb8262faa48d8 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Tue, 25 Jun 2024 12:29:13 +0100 Subject: [PATCH 232/631] more s/forall/forAll/ --- parser-typechecker/tests/Unison/Test/Type.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/parser-typechecker/tests/Unison/Test/Type.hs b/parser-typechecker/tests/Unison/Test/Type.hs index de22ec80bf..767addedcd 100644 --- a/parser-typechecker/tests/Unison/Test/Type.hs +++ b/parser-typechecker/tests/Unison/Test/Type.hs @@ -28,7 +28,7 @@ test = v2 = Var.named "b" vt = var () v vt2 = var () v2 - x = forall () v (nat () --> effect () [vt, builtin () "eff"] (nat ())) :: Type Symbol () - y = forall () v2 (nat () --> effect () [vt2] (nat ())) :: Type Symbol () + x = forAll () v (nat () --> effect () [vt, builtin () "eff"] (nat ())) :: Type Symbol () + y = forAll () v2 (nat () --> effect () [vt2] (nat ())) :: Type Symbol () expect . not $ Typechecker.isSubtype x y ] From ae54637bae36f8c44a667e26ccfffa881d38d9e8 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 25 Jun 2024 09:40:06 -0400 Subject: [PATCH 233/631] add transcript that demonstrates bug in merge --- unison-src/transcripts/merge.md | 65 ++++++++++ unison-src/transcripts/merge.output.md | 163 +++++++++++++++++++++++++ 2 files changed, 228 insertions(+) diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 9436ae5232..debe548c5b 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -1518,3 +1518,68 @@ project/main> view Foo ```ucm:hide .> project.delete project ``` + +### Dependent that doesn't need to be in the file + +This test demonstrates a bug. + + +```ucm:hide +project/alice> builtins.mergeio lib.builtins +``` + +In the LCA, we have `foo` with dependent `bar`, and `baz`. + +```unison +foo : Nat +foo = 17 + +bar : Nat +bar = foo + foo + +baz : Text +baz = "lca" +``` + +```ucm +project/alice> add +project/alice> branch bob +``` + +On Bob, we update `baz` to "bob". + +```unison +baz : Text +baz = "bob" +``` + +```ucm +project/bob> update +``` + +On Alice, we update `baz` to "alice" (conflict), but also update `foo` (unconflicted), which propagates to `bar`. + +```unison +foo : Nat +foo = 18 + +baz : Text +baz = "alice" +``` + +```ucm +project/alice> update +``` + +When we try to merge Bob into Alice, we should see both versions of `baz`, with Alice's unconflicted `foo` and `bar` in +the underlying namespace. + +```ucm:error +project/alice> merge /bob +``` + +But `bar` was put into the scratch file instead. + +```ucm:hide +.> project.delete project +``` diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 6334b362da..e2b7672de3 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1793,3 +1793,166 @@ project/main> view Foo type Foo = Bar ``` +### Dependent that doesn't need to be in the file + +This test demonstrates a bug. + + +In the LCA, we have `foo` with dependent `bar`, and `baz`. + +```unison +foo : Nat +foo = 17 + +bar : Nat +bar = foo + foo + +baz : Text +baz = "lca" +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bar : Nat + baz : Text + foo : Nat + +``` +```ucm +project/alice> add + + ⍟ I've added these definitions: + + bar : Nat + baz : Text + foo : Nat + +project/alice> branch bob + + Done. I've created the bob branch based off of alice. + + Tip: To merge your work back into the alice branch, first + `switch /alice` then `merge /bob`. + +``` +On Bob, we update `baz` to "bob". + +```unison +baz : Text +baz = "bob" +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These names already exist. You can `update` them to your + new definition: + + baz : Text + +``` +```ucm +project/bob> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +``` +On Alice, we update `baz` to "alice" (conflict), but also update `foo` (unconflicted), which propagates to `bar`. + +```unison +foo : Nat +foo = 18 + +baz : Text +baz = "alice" +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These names already exist. You can `update` them to your + new definition: + + baz : Text + foo : Nat + +``` +```ucm +project/alice> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +``` +When we try to merge Bob into Alice, we should see both versions of `baz`, with Alice's unconflicted `foo` and `bar` in +the underlying namespace. + +```ucm +project/alice> merge /bob + + I couldn't automatically merge project/bob into project/alice. + However, I've added the definitions that need attention to the + top of scratch.u. + + When you're done, you can run + + merge.commit + + to merge your changes back into alice and delete the temporary + branch. Or, if you decide to cancel the merge instead, you can + run + + delete.branch /merge-bob-into-alice + + to delete the temporary branch and switch back to alice. + +``` +```unison:added-by-ucm scratch.u +-- project/alice +baz : Text +baz = "alice" + +-- project/bob +baz : Text +baz = "bob" + +-- The definitions below are not conflicted, but they each depend on one or more +-- conflicted definitions above. + +bar : Nat +bar = + use Nat + + foo + foo + + +``` + +But `bar` was put into the scratch file instead. + From 1cbac288de029beae5af663eeb31e4d8d597e585 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 24 Jun 2024 14:25:56 -0700 Subject: [PATCH 234/631] Fix unique type guid generation Adds getMaybe* versions of shallow branch combinators --- parser-typechecker/src/Unison/Codebase.hs | 32 +++++++++++++++---- .../src/Unison/Codebase/ProjectPath.hs | 5 +++ .../Unison/Codebase/UniqueTypeGuidLookup.hs | 5 +-- .../src/Unison/Cli/UniqueTypeGuidLookup.hs | 27 ++++------------ .../Codebase/Editor/HandleInput/Load.hs | 4 +-- .../Codebase/Editor/HandleInput/Merge2.hs | 4 +-- .../Codebase/Editor/HandleInput/Update2.hs | 7 ++-- .../Codebase/Editor/HandleInput/Upgrade.hs | 4 +-- unison-cli/src/Unison/LSP/FileAnalysis.hs | 3 +- unison-cli/src/Unison/Main.hs | 7 ++-- 10 files changed, 56 insertions(+), 42 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 45fd7c50ce..ee09f07cbd 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -47,12 +47,14 @@ module Unison.Codebase lca, SqliteCodebase.Operations.before, getShallowBranchAtPath, + getMaybeShallowBranchAtPath, getShallowCausalAtPath, Operations.expectCausalBranchByCausalHash, getShallowCausalAtPathFromRootHash, getShallowProjectBranchRoot, expectShallowProjectBranchRoot, getShallowBranchAtProjectPath, + getMaybeShallowBranchAtProjectPath, getShallowProjectRootByNames, expectProjectBranchRoot, getBranchAtProjectPath, @@ -203,24 +205,40 @@ getShallowBranchAtPath :: Path -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) -getShallowBranchAtPath path branch = do +getShallowBranchAtPath path branch = fromMaybe V2Branch.empty <$> getMaybeShallowBranchAtPath path branch + +-- | Recursively descend into causals following the given path, +-- Use the root causal if none is provided. +getMaybeShallowBranchAtPath :: + Path -> + V2Branch.Branch Sqlite.Transaction -> + Sqlite.Transaction (Maybe (V2Branch.Branch Sqlite.Transaction)) +getMaybeShallowBranchAtPath path branch = do case path of - Path.Empty -> pure branch + Path.Empty -> pure $ Just branch ns Path.:< p -> do case V2Branch.childAt ns branch of - Nothing -> pure V2Branch.empty + Nothing -> pure Nothing Just childCausal -> do childBranch <- V2Causal.value childCausal - getShallowBranchAtPath p childBranch + getMaybeShallowBranchAtPath p childBranch -- | Recursively descend into causals following the given path, -- Use the root causal if none is provided. getShallowBranchAtProjectPath :: PP.ProjectPath -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction) -getShallowBranchAtProjectPath (PP.ProjectPath _project projectBranch path) = do - projectRootBranch <- fromMaybe V2Branch.empty <$> getShallowProjectBranchRoot projectBranch - getShallowBranchAtPath (Path.unabsolute path) projectRootBranch +getShallowBranchAtProjectPath pp = fromMaybe V2Branch.empty <$> getMaybeShallowBranchAtProjectPath pp + +-- | Recursively descend into causals following the given path, +-- Use the root causal if none is provided. +getMaybeShallowBranchAtProjectPath :: + PP.ProjectPath -> + Sqlite.Transaction (Maybe (V2Branch.Branch Sqlite.Transaction)) +getMaybeShallowBranchAtProjectPath (PP.ProjectPath _project projectBranch path) = do + getShallowProjectBranchRoot projectBranch >>= \case + Nothing -> pure Nothing + Just projectRootBranch -> getMaybeShallowBranchAtPath (Path.unabsolute path) projectRootBranch getShallowProjectRootByNames :: ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe (V2Branch.CausalBranch Sqlite.Transaction)) getShallowProjectRootByNames (ProjectAndBranch projectName branchName) = runMaybeT do diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index fed28739b2..71706b759d 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -15,6 +15,11 @@ module Unison.Codebase.ProjectPath toNames, projectPathParser, parseProjectPath, + + -- * Re-exports, this also helps with using dot-notation + ProjectAndBranch (..), + Project (..), + ProjectBranch (..), ) where diff --git a/parser-typechecker/src/Unison/Codebase/UniqueTypeGuidLookup.hs b/parser-typechecker/src/Unison/Codebase/UniqueTypeGuidLookup.hs index d2e9aa5bcf..649a629cdc 100644 --- a/parser-typechecker/src/Unison/Codebase/UniqueTypeGuidLookup.hs +++ b/parser-typechecker/src/Unison/Codebase/UniqueTypeGuidLookup.hs @@ -10,6 +10,7 @@ import U.Codebase.Branch qualified as Codebase.Branch import U.Codebase.Decl qualified as Codebase.Decl import U.Codebase.Reference qualified as Codebase.Reference import U.Codebase.Sqlite.Operations qualified as Operations +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.NameSegment (NameSegment) import Unison.Prelude import Unison.Sqlite qualified as Sqlite @@ -21,8 +22,8 @@ import Witherable (witherM) -- For (potential) efficiency, this function accepts an argument that loads a namespace at a path, which may be backed -- by a cache. loadUniqueTypeGuid :: - ([NameSegment] -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction))) -> - [NameSegment] -> + (ProjectPath -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction))) -> + ProjectPath -> NameSegment -> Sqlite.Transaction (Maybe Text) loadUniqueTypeGuid loadNamespaceAtPath path name = diff --git a/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs b/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs index 457b261e46..8ed07da067 100644 --- a/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs +++ b/unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs @@ -5,39 +5,26 @@ module Unison.Cli.UniqueTypeGuidLookup ) where -import Control.Lens (unsnoc) -import Data.Foldable qualified as Foldable -import Data.Maybe (fromJust) import U.Codebase.Branch qualified as Codebase.Branch import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath (ProjectPath) +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.UniqueTypeGuidLookup qualified as Codebase import Unison.Name (Name) -import Unison.NameSegment (NameSegment) import Unison.Prelude import Unison.Sqlite qualified as Sqlite loadUniqueTypeGuid :: ProjectPath -> Name -> Sqlite.Transaction (Maybe Text) -loadUniqueTypeGuid currentPath name0 = do - -- First, resolve the current path and the (probably/hopefully relative) name of the unique type to the full path - -- to the unique type, plus its final distinguished name segment. - let (branchPath, name) = - name0 - & Path.fromName' - & Path.resolve currentPath - & Path.unabsolute - & Path.toSeq - & unsnoc - -- This is safe because we were handed a Name, which can't be empty - & fromJust +loadUniqueTypeGuid pp name0 = do + let (namePath, finalSegment) = Path.splitFromName name0 + let fullPP = pp & over PP.path_ (<> namePath) -- Define an operation to load a branch by its full path from the root namespace. -- -- This ought to probably lean somewhat on a cache (so long as the caller is aware of the cache, and discrads it at -- an appropriate time, such as after the current unison file finishes parsing). - let loadBranchAtPath :: [NameSegment] -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction)) - loadBranchAtPath = - Codebase.getShallowBranchAtProjectPath + let loadBranchAtPath :: ProjectPath -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction)) + loadBranchAtPath = Codebase.getMaybeShallowBranchAtProjectPath - Codebase.loadUniqueTypeGuid loadBranchAtPath (Foldable.toList @Seq branchPath) name + Codebase.loadUniqueTypeGuid loadBranchAtPath fullPP finalSegment diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs index a9259fc969..f050df2086 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs @@ -78,7 +78,7 @@ loadUnisonFile sourceName text = do Text -> Cli (TypecheckedUnisonFile Symbol Ann) withFile names sourceName text = do - currentPath <- Cli.getCurrentPath + pp <- Cli.getCurrentProjectPath State.modify' \loopState -> loopState & #latestFile .~ Just (Text.unpack sourceName, False) @@ -88,7 +88,7 @@ loadUnisonFile sourceName text = do let parsingEnv = Parser.ParsingEnv { uniqueNames = uniqueName, - uniqueTypeGuid = Cli.loadUniqueTypeGuid currentPath, + uniqueTypeGuid = Cli.loadUniqueTypeGuid pp, names } unisonFile <- diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 368a831115..507e34bd9b 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -87,6 +87,7 @@ import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.EitherWayI (EitherWayI (..)) import Unison.Merge.EitherWayI qualified as EitherWayI import Unison.Merge.Libdeps qualified as Merge +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs) import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.Synhashed qualified as Synhashed @@ -140,7 +141,6 @@ import Unison.Util.SyntaxText (SyntaxText') import Unison.Var (Var) import Witch (unsafeFrom) import Prelude hiding (unzip, zip, zipWith) -import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do @@ -399,7 +399,7 @@ doMerge info = do in if thisMergeHasConflicts then pure Nothing else do - currentPath <- Cli.getCurrentPath + currentPath <- Cli.getCurrentProjectPath parsingEnv <- makeParsingEnv currentPath (Branch.toNames stageOneBranch) prettyParseTypecheck2 prettyUnisonFile parsingEnv <&> eitherToMaybe diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index d7ee79afd1..588635e499 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -49,6 +49,7 @@ import Unison.Codebase.Editor.Output (Output) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.Type (Codebase) import Unison.ConstructorReference (GConstructorReference (ConstructorReference)) import Unison.DataDeclaration (DataDeclaration, Decl) @@ -106,7 +107,7 @@ handleUpdate2 = do Cli.Env {codebase, writeSource} <- ask tuf <- Cli.expectLatestTypecheckedFile let termAndDeclNames = getTermAndDeclNames tuf - currentPath <- Cli.getCurrentPath + pp <- Cli.getCurrentProjectPath currentBranch0 <- Cli.getCurrentBranch0 let namesIncludingLibdeps = Branch.toNames currentBranch0 let namesExcludingLibdeps = Branch.toNames (currentBranch0 & over Branch.children (Map.delete NameSegment.libSegment)) @@ -141,7 +142,7 @@ handleUpdate2 = do then pure tuf else do Cli.respond Output.UpdateStartTypechecking - parsingEnv <- makeParsingEnv currentPath namesIncludingLibdeps + parsingEnv <- makeParsingEnv pp namesIncludingLibdeps secondTuf <- prettyParseTypecheck bigUf pped parsingEnv & onLeftM \prettyUf -> do scratchFilePath <- fst <$> Cli.expectLatestFile @@ -185,7 +186,7 @@ prettyParseTypecheck2 prettyUf parsingEnv = do Result.Result _notes Nothing -> Left prettyUf -- @makeParsingEnv path names@ makes a parsing environment with @names@ in scope, which are all relative to @path@. -makeParsingEnv :: Path.Absolute -> Names -> Cli (Parser.ParsingEnv Transaction) +makeParsingEnv :: ProjectPath -> Names -> Cli (Parser.ParsingEnv Transaction) makeParsingEnv path names = do Cli.Env {generateUniqueName} <- ask uniqueName <- liftIO generateUniqueName diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index 06d39abaf7..c0871d0122 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -149,8 +149,8 @@ handleUpgrade oldName newName = do `PPED.addFallback` makeComplicatedPPE hashLength currentDeepNamesSansOld mempty dependents ) - (PP.ProjectPath project projectBranch pathInProject) <- Cli.getCurrentProjectPath - parsingEnv <- makeParsingEnv pathInProject currentDeepNamesSansOld + pp@(PP.ProjectPath project projectBranch _path) <- Cli.getCurrentProjectPath + parsingEnv <- makeParsingEnv pp currentDeepNamesSansOld typecheckedUnisonFile <- prettyParseTypecheck unisonFile printPPE parsingEnv & onLeftM \prettyUnisonFile -> do let getTemporaryBranchName = findTemporaryBranchName (project ^. #projectId) oldName newName diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index 85ad0ba663..a802ea4958 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -27,7 +27,6 @@ import Unison.ABT qualified as ABT import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) import Unison.Cli.UniqueTypeGuidLookup qualified as Cli import Unison.Codebase qualified as Codebase -import Unison.Codebase.ProjectPath qualified as PP import Unison.DataDeclaration qualified as DD import Unison.Debug qualified as Debug import Unison.FileParsers (ShouldUseTndr (..)) @@ -91,7 +90,7 @@ checkFile doc = runMaybeT do let parsingEnv = Parser.ParsingEnv { uniqueNames = uniqueName, - uniqueTypeGuid = Cli.loadUniqueTypeGuid (pp ^. PP.absPath_), + uniqueTypeGuid = Cli.loadUniqueTypeGuid pp, names = parseNames } (notes, parsedFile, typecheckedFile) <- do diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index 1149589063..ddb07d6a03 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -62,6 +62,7 @@ import System.IO.Error (catchIOError) import System.IO.Temp qualified as Temp import System.Path qualified as Path import U.Codebase.HashTags (CausalHash) +import U.Codebase.Sqlite.Operations qualified as SqliteOps import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase, CodebasePath) @@ -311,8 +312,10 @@ main version = do pure $ PP.fromProjectAndBranch pab Path.absoluteEmpty Nothing -> do Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath - rootCausalHash <- Codebase.runTransaction theCodebase (Queries.expectNamespaceRoot >>= Queries.expectCausalHash) - projectRootHashVar <- newTVarIO rootCausalHash + currentProjectRootCH <- Codebase.runTransaction theCodebase do + currentPP <- Codebase.expectCurrentProjectPath + SqliteOps.expectProjectBranchHead (currentPP.project.projectId) (currentPP.branch.branchId) + projectRootHashVar <- newTVarIO currentProjectRootCH projectPathVar <- newTVarIO startingProjectPath let notifyOnRootChanges :: CausalHash -> STM () notifyOnRootChanges b = do From 1f34de9026e8312c162dc2c1e8f6fcd5a7775b8d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 25 Jun 2024 10:10:28 -0700 Subject: [PATCH 235/631] Swap stepAt combinators to use project paths --- .../src/Unison/Codebase/ProjectPath.hs | 5 +++++ unison-cli/src/Unison/Cli/MonadUtils.hs | 15 ++++++--------- .../src/Unison/Codebase/Editor/HandleInput.hs | 11 ++++------- .../Unison/Codebase/Editor/HandleInput/AddRun.hs | 5 ++--- .../Unison/Codebase/Editor/HandleInput/Pull.hs | 6 ++---- .../Unison/Codebase/Editor/HandleInput/Update2.hs | 5 ++--- .../Unison/Codebase/Editor/HandleInput/Upgrade.hs | 3 +-- 7 files changed, 22 insertions(+), 28 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index 71706b759d..ffb7b08505 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -5,6 +5,7 @@ module Unison.Codebase.ProjectPath ProjectPath, fromProjectAndBranch, projectBranchRoot, + toRoot, absPath_, path_, path, @@ -65,6 +66,10 @@ type ProjectPath = ProjectPathG Project ProjectBranch projectBranchRoot :: ProjectAndBranch Project ProjectBranch -> ProjectPath projectBranchRoot (ProjectAndBranch proj branch) = ProjectPath proj branch Path.absoluteEmpty +-- | Discard any path within the project and get the project's root +toRoot :: ProjectPath -> ProjectPath +toRoot (ProjectPath proj branch _) = ProjectPath proj branch Path.absoluteEmpty + fromProjectAndBranch :: ProjectAndBranch Project ProjectBranch -> Path.Absolute -> ProjectPath fromProjectAndBranch (ProjectAndBranch proj branch) path = ProjectPath proj branch path diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 5cd11912d5..287b761f14 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -359,25 +359,22 @@ makeActionsUnabsolute :: Functor f => f (Path.Absolute, x) -> f (Path, x) makeActionsUnabsolute = fmap (first Path.unabsolute) stepAt :: - ProjectBranch -> Text -> - (Path.Absolute, Branch0 IO -> Branch0 IO) -> + (ProjectPath, Branch0 IO -> Branch0 IO) -> Cli () -stepAt pb cause action = stepManyAt pb cause [action] +stepAt cause (pp, action) = stepManyAt pp.branch cause [(pp.absPath, action)] stepAt' :: - ProjectBranch -> Text -> - (Path.Absolute, Branch0 IO -> Cli (Branch0 IO)) -> + (ProjectPath, Branch0 IO -> Cli (Branch0 IO)) -> Cli Bool -stepAt' pb cause action = stepManyAt' pb cause [action] +stepAt' cause (pp, action) = stepManyAt' pp.branch cause [(pp.absPath, action)] stepAtM :: - ProjectBranch -> Text -> - (Path.Absolute, Branch0 IO -> IO (Branch0 IO)) -> + (ProjectPath, Branch0 IO -> IO (Branch0 IO)) -> Cli () -stepAtM pb cause action = stepManyAtM pb cause [action] +stepAtM cause (pp, action) = stepManyAtM pp.branch cause [(pp.absPath, action)] stepManyAt :: ProjectBranch -> diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 908c1d3297..c5b919815e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -426,8 +426,7 @@ loop e = do when (not (Set.null destTerms)) do Cli.returnEarly (TermAlreadyExists dest' destTerms) description <- inputDescription input - pb <- Cli.getCurrentProjectBranch - Cli.stepAt pb description (BranchUtil.makeAddTermName (first PP.absPath dest) srcTerm) + Cli.stepAt description (BranchUtil.makeAddTermName dest srcTerm) Cli.respond Success AliasTypeI src' dest' -> do src <- traverseOf _Right Cli.resolveSplit' src' @@ -450,8 +449,7 @@ loop e = do when (not (Set.null destTypes)) do Cli.returnEarly (TypeAlreadyExists dest' destTypes) description <- inputDescription input - pb <- Cli.getCurrentProjectBranch - Cli.stepAt pb description (BranchUtil.makeAddTypeName (first PP.absPath dest) srcType) + Cli.stepAt description (BranchUtil.makeAddTypeName dest srcType) Cli.respond Success -- this implementation will happily produce name conflicts, @@ -629,13 +627,12 @@ loop e = do let vars = Set.map Name.toVar requestedNames uf <- Cli.expectLatestTypecheckedFile Cli.Env {codebase} <- ask - currentPath <- Cli.getCurrentPath currentNames <- Branch.toNames <$> Cli.getCurrentBranch0 let sr = Slurp.slurpFile uf vars Slurp.AddOp currentNames let adds = SlurpResult.adds sr Cli.runTransaction . Codebase.addDefsToCodebase codebase . SlurpResult.filterUnisonFile sr $ uf - pb <- getCurrentProjectBranch - Cli.stepAt pb description (currentPath, doSlurpAdds adds uf) + pp <- Cli.getCurrentProjectPath + Cli.stepAt description (pp, doSlurpAdds adds uf) pped <- Cli.prettyPrintEnvDeclFromNames $ UF.addNamesFromTypeCheckedUnisonFile uf currentNames let suffixifiedPPE = PPED.suffixifiedPPE pped Cli.respond $ SlurpOutput input suffixifiedPPE sr diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs index 8ef0550a30..ef96ecb983 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs @@ -19,7 +19,6 @@ import Unison.Codebase.Editor.Input (Input) import Unison.Codebase.Editor.Output (Output (NoLastRunResult, SaveTermNameConflict, SlurpOutput)) import Unison.Codebase.Editor.Slurp qualified as Slurp import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult -import Unison.Codebase.ProjectPath qualified as PP import Unison.CommandLine.InputPattern qualified as InputPattern import Unison.CommandLine.InputPatterns qualified as InputPatterns import Unison.Name (Name) @@ -42,8 +41,8 @@ handleAddRun input resultName = do let adds = SlurpResult.adds sr Cli.runTransaction . Codebase.addDefsToCodebase codebase . SlurpResult.filterUnisonFile sr $ uf let description = (Text.pack (InputPattern.patternName InputPatterns.saveExecuteResult) <> " " <> Name.toText resultName) - PP.ProjectPath _proj pb currentPath <- Cli.getCurrentProjectPath - Cli.stepAt pb description (currentPath, doSlurpAdds adds uf) + pp <- Cli.getCurrentProjectPath + Cli.stepAt description (pp, doSlurpAdds adds uf) let namesWithDefinitionsFromFile = UF.addNamesFromTypeCheckedUnisonFile uf currentNames pped <- Cli.prettyPrintEnvDeclFromNames namesWithDefinitionsFromFile let suffixifiedPPE = PPE.suffixifiedPPE pped diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index 7a844bec50..3ff7012220 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -291,10 +291,8 @@ propagatePatch :: PP.ProjectPath -> Cli Bool propagatePatch inputDescription patch scopePath = do - let pb = scopePath ^. #branch Cli.time "propagatePatch" do - rootNames <- Cli.projectBranchNames pb + rootNames <- Cli.projectBranchNames scopePath.branch Cli.stepAt' - pb (inputDescription <> " (applying patch)") - (scopePath ^. PP.absPath_, Propagate.propagateAndApply rootNames patch) + (scopePath, Propagate.propagateAndApply rootNames patch) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 588635e499..faa1e2d7cc 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -201,13 +201,12 @@ makeParsingEnv path names = do saveTuf :: (Name -> Either Output (Maybe [Name])) -> TypecheckedUnisonFile Symbol Ann -> Cli () saveTuf getConstructors tuf = do Cli.Env {codebase} <- ask - currentPath <- Cli.getCurrentPath + pp <- Cli.getCurrentProjectPath branchUpdates <- Cli.runTransactionWithRollback \abort -> do Codebase.addDefsToCodebase codebase tuf typecheckedUnisonFileToBranchUpdates abort getConstructors tuf - pb <- Cli.getCurrentProjectBranch - Cli.stepAt pb "update" (currentPath, Branch.batchUpdates branchUpdates) + Cli.stepAt "update" (pp, Branch.batchUpdates branchUpdates) -- @typecheckedUnisonFileToBranchUpdates getConstructors file@ returns a list of branch updates (suitable for passing -- along to `batchUpdates` or some "step at" combinator) that corresponds to using all of the contents of @file@. diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index c0871d0122..c914ddee6a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -176,9 +176,8 @@ handleUpgrade oldName newName = do (findCtorNamesMaybe Output.UOUUpgrade currentLocalNames currentLocalConstructorNames Nothing) typecheckedUnisonFile Cli.stepAt - projectBranch textualDescriptionOfUpgrade - ( Path.absoluteEmpty, + ( PP.toRoot pp, Branch.deleteLibdep oldName . Branch.batchUpdates branchUpdates ) Cli.respond (Output.UpgradeSuccess oldName newName) From 9d064fdbed71e0977228ea093833f46e7f3d237a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 11 Jun 2024 09:41:47 -0700 Subject: [PATCH 236/631] Move project branch insert into transaction From 0ef189865d5cb1d4762a74f63d2535fcc5209e80 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 11 Jun 2024 11:21:50 -0700 Subject: [PATCH 237/631] Auto-create project branches in transcripts From ae7cf3d0a5584b6113b050dd34c23b73525e4c80 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 11 Jun 2024 15:08:02 -0700 Subject: [PATCH 238/631] Update transcripts to use implicit project creation --- unison-src/transcripts/merge.md | 137 -------------------------------- 1 file changed, 137 deletions(-) diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 9436ae5232..1334df76d8 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -917,143 +917,6 @@ We will resolve this situation automatically in a future version. project/main> builtins.mergeio lib.builtins ``` -```ucm:hide -project/main> branch alice -``` - -Alice's additions: -```unison:hide -unique type Foo = Bar - -alice : Foo -> Nat -alice _ = 18 -``` - -```ucm:hide -project/alice> add -project/main> branch bob -``` - -Bob's additions: -```unison:hide -unique type Foo = Bar - -bob : Foo -> Nat -bob _ = 19 -``` - -```ucm:hide -project/bob> add -``` - -```ucm:error -project/alice> merge bob -``` - -```ucm:hide -.> project.delete project -``` - -## `merge.commit` example (success) - -After merge conflicts are resolved, you can use `merge.commit` rather than `switch` + `merge` + `branch.delete` to -"commit" your changes. - -```ucm:hide -.> project.create-empty project -project/main> builtins.mergeio lib.builtins -``` - -Original branch: -```unison:hide -foo : Text -foo = "old foo" -``` - -```ucm:hide -project/main> add -project/main> branch alice -``` - -Alice's changes: -```unison:hide -foo : Text -foo = "alices foo" -``` - -```ucm:hide -project/alice> update -project/main> branch bob -``` - -Bob's changes: - -```unison:hide -foo : Text -foo = "bobs foo" -``` - -Attempt to merge: - -```ucm:hide -project/bob> update -``` -```ucm:error -project/alice> merge /bob -``` - -Resolve conflicts and commit: - -```unison -foo : Text -foo = "alice and bobs foo" -``` - -```ucm -project/merge-bob-into-alice> update -project/merge-bob-into-alice> merge.commit -project/alice> view foo -project/alice> branches -``` - -```ucm:hide -.> project.delete project -``` - -## `merge.commit` example (failure) - -`merge.commit` can only be run on a "merge branch". - -```ucm:hide -.> project.create-empty project -project/main> builtins.mergeio lib.builtins -``` - -```ucm -project/main> branch topic -``` - -```ucm:error -project/topic> merge.commit -``` - -```ucm:hide -.> project.delete project -``` - - -## Precondition violations - -There are a number of conditions under which we can't perform a merge, and the user will have to fix up the namespace(s) manually before attempting to merge again. - -### Conflicted aliases - -If `foo` and `bar` are aliases in the nearest common ancestor, but not in Alice's branch, then we don't know whether to update Bob's dependents to Alice's `foo` or Alice's `bar` (and vice-versa). - -```ucm:hide -project/main> builtins.mergeio lib.builtins -``` - Original branch: ```unison:hide foo : Nat From 5ca1eb3b8d07d9165d39b99e5be3b583b8d7e49d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 11 Jun 2024 15:22:09 -0700 Subject: [PATCH 239/631] Replace '.' references with scratch/main --- unison-src/builtin-tests/base.md | 6 +- .../builtin-tests/interpreter-tests.tpl.md | 8 +- unison-src/builtin-tests/jit-tests.tpl.md | 12 +- unison-src/transcripts-manual/benchmarks.md | 52 +- .../remote-tab-completion.md | 2 +- unison-src/transcripts-manual/rewrites.md | 48 +- unison-src/transcripts-manual/scheme.md | 10 +- unison-src/transcripts-round-trip/main.md | 26 +- unison-src/transcripts-using-base/_base.md | 12 +- .../transcripts-using-base/_base.output.md | 4 +- .../transcripts-using-base/all-base-hashes.md | 2 +- .../all-base-hashes.output.md | 2 +- .../binary-encoding-nats.md | 4 +- .../binary-encoding-nats.output.md | 4 +- unison-src/transcripts-using-base/codeops.md | 16 +- .../transcripts-using-base/codeops.output.md | 16 +- unison-src/transcripts-using-base/doc.md | 38 +- .../transcripts-using-base/doc.output.md | 36 +- .../transcripts-using-base/failure-tests.md | 6 +- .../failure-tests.output.md | 6 +- .../transcripts-using-base/fix1709.output.md | 5 +- unison-src/transcripts-using-base/fix2358.md | 2 +- .../transcripts-using-base/fix2358.output.md | 2 +- unison-src/transcripts-using-base/fix3939.md | 6 +- .../transcripts-using-base/fix3939.output.md | 6 +- unison-src/transcripts-using-base/hashing.md | 12 +- .../transcripts-using-base/hashing.output.md | 8 +- unison-src/transcripts-using-base/mvar.md | 4 +- .../transcripts-using-base/mvar.output.md | 4 +- .../namespace-dependencies.md | 2 +- .../namespace-dependencies.output.md | 25 +- .../transcripts-using-base/nat-coersion.md | 4 +- .../nat-coersion.output.md | 4 +- unison-src/transcripts-using-base/net.md | 10 +- .../transcripts-using-base/net.output.md | 8 +- .../transcripts-using-base/random-deserial.md | 4 +- .../random-deserial.output.md | 4 +- .../transcripts-using-base/ref-promise.md | 18 +- .../ref-promise.output.md | 18 +- .../transcripts-using-base/serial-test-00.md | 4 +- .../serial-test-00.output.md | 4 +- .../transcripts-using-base/serial-test-01.md | 4 +- .../serial-test-01.output.md | 4 +- .../transcripts-using-base/serial-test-02.md | 4 +- .../serial-test-02.output.md | 4 +- .../transcripts-using-base/serial-test-03.md | 4 +- .../serial-test-03.output.md | 4 +- .../transcripts-using-base/serial-test-04.md | 4 +- .../serial-test-04.output.md | 4 +- unison-src/transcripts-using-base/stm.md | 6 +- .../transcripts-using-base/stm.output.md | 6 +- .../test-watch-dependencies.md | 6 +- .../test-watch-dependencies.output.md | 4 +- unison-src/transcripts-using-base/thread.md | 12 +- .../transcripts-using-base/thread.output.md | 8 +- unison-src/transcripts-using-base/tls.md | 14 +- .../transcripts-using-base/tls.output.md | 12 +- unison-src/transcripts-using-base/utf8.md | 2 +- .../transcripts-using-base/utf8.output.md | 2 +- unison-src/transcripts/abilities.md | 4 +- unison-src/transcripts/abilities.output.md | 2 +- .../ability-order-doesnt-affect-hash.md | 4 +- ...ability-order-doesnt-affect-hash.output.md | 4 +- unison-src/transcripts/add-run.md | 40 +- unison-src/transcripts/add-run.output.md | 44 +- .../transcripts/add-test-watch-roundtrip.md | 6 +- .../add-test-watch-roundtrip.output.md | 4 +- unison-src/transcripts/addupdatemessages.md | 10 +- .../transcripts/addupdatemessages.output.md | 8 +- unison-src/transcripts/alias-many.md | 8 +- unison-src/transcripts/alias-many.output.md | 99 +-- unison-src/transcripts/anf-tests.md | 4 +- unison-src/transcripts/anf-tests.output.md | 2 +- unison-src/transcripts/any-extract.md | 8 +- unison-src/transcripts/any-extract.output.md | 2 +- unison-src/transcripts/api-doc-rendering.md | 6 +- .../transcripts/api-doc-rendering.output.md | 795 +----------------- unison-src/transcripts/api-find.md | 2 +- unison-src/transcripts/api-find.output.md | 34 +- .../transcripts/api-list-projects-branches.md | 6 +- .../api-list-projects-branches.output.md | 3 + .../transcripts/api-namespace-details.md | 4 +- .../api-namespace-details.output.md | 42 +- unison-src/transcripts/api-namespace-list.md | 4 +- .../transcripts/api-namespace-list.output.md | 96 +-- unison-src/transcripts/api-summaries.md | 8 +- .../transcripts/block-on-required-update.md | 6 +- .../block-on-required-update.output.md | 4 +- unison-src/transcripts/blocks.md | 2 +- .../boolean-op-pretty-print-2819.md | 6 +- .../boolean-op-pretty-print-2819.output.md | 4 +- unison-src/transcripts/branch-command.md | 12 +- .../transcripts/branch-command.output.md | 8 +- .../transcripts/branch-relative-path.md | 6 +- unison-src/transcripts/bug-fix-4354.md | 2 +- unison-src/transcripts/bug-strange-closure.md | 18 +- .../transcripts/bug-strange-closure.output.md | 20 +- unison-src/transcripts/builtins.md | 32 +- unison-src/transcripts/builtins.output.md | 8 +- unison-src/transcripts/bytesFromList.md | 2 +- unison-src/transcripts/check763.md | 8 +- unison-src/transcripts/check763.output.md | 6 +- unison-src/transcripts/check873.md | 4 +- unison-src/transcripts/check873.output.md | 2 +- .../child-namespace-history-merge.md | 42 +- .../child-namespace-history-merge.output.md | 36 +- .../constructor-applied-to-unit.md | 4 +- unison-src/transcripts/contrabilities.md | 2 +- unison-src/transcripts/create-author.md | 2 +- unison-src/transcripts/cycle-update-1.md | 8 +- .../transcripts/cycle-update-1.output.md | 6 +- unison-src/transcripts/cycle-update-2.md | 8 +- .../transcripts/cycle-update-2.output.md | 6 +- unison-src/transcripts/cycle-update-3.md | 8 +- .../transcripts/cycle-update-3.output.md | 6 +- unison-src/transcripts/cycle-update-4.md | 8 +- .../transcripts/cycle-update-4.output.md | 6 +- unison-src/transcripts/cycle-update-5.md | 6 +- .../transcripts/cycle-update-5.output.md | 6 +- unison-src/transcripts/debug-definitions.md | 18 +- .../transcripts/debug-definitions.output.md | 16 +- unison-src/transcripts/debug-name-diffs.md | 12 +- .../transcripts/debug-name-diffs.output.md | 12 +- unison-src/transcripts/deep-names.md | 2 +- unison-src/transcripts/deep-names.output.md | 78 +- unison-src/transcripts/delete-namespace.md | 22 +- .../transcripts/delete-namespace.output.md | 18 +- .../transcripts/delete-project-branch.md | 2 +- .../delete-project-branch.output.md | 4 +- unison-src/transcripts/delete-project.md | 8 +- .../transcripts/delete-project.output.md | 14 +- unison-src/transcripts/delete-silent.md | 10 +- .../transcripts/delete-silent.output.md | 10 +- unison-src/transcripts/delete.md | 58 +- unison-src/transcripts/delete.output.md | 383 +-------- .../dependents-dependencies-debugfile.md | 18 +- ...ependents-dependencies-debugfile.output.md | 14 +- unison-src/transcripts/destructuring-binds.md | 14 +- .../transcripts/destructuring-binds.output.md | 12 +- unison-src/transcripts/diff-namespace.md | 48 +- .../transcripts/diff-namespace.output.md | 586 +------------ unison-src/transcripts/doc-formatting.md | 56 +- .../transcripts/doc-formatting.output.md | 28 +- .../transcripts/doc-type-link-keywords.md | 12 +- .../doc-type-link-keywords.output.md | 8 +- unison-src/transcripts/doc1.md | 2 +- unison-src/transcripts/doc1.output.md | 150 +--- unison-src/transcripts/doc2.md | 4 +- unison-src/transcripts/doc2.output.md | 2 +- unison-src/transcripts/doc2markdown.md | 6 +- unison-src/transcripts/doc2markdown.output.md | 2 +- unison-src/transcripts/duplicate-names.md | 6 +- .../transcripts/duplicate-names.output.md | 4 +- .../transcripts/duplicate-term-detection.md | 2 +- unison-src/transcripts/ed25519.md | 2 +- unison-src/transcripts/edit-command.md | 10 +- unison-src/transcripts/edit-command.output.md | 10 +- unison-src/transcripts/empty-namespaces.md | 32 +- .../transcripts/empty-namespaces.output.md | 24 +- unison-src/transcripts/emptyCodebase.md | 2 +- .../transcripts/emptyCodebase.output.md | 2 +- unison-src/transcripts/error-messages.md | 2 +- .../errors/missing-result-typed.md | 2 +- .../transcripts/errors/ucm-hide-all-error.md | 2 +- .../errors/ucm-hide-all-error.output.md | 2 +- unison-src/transcripts/errors/ucm-hide-all.md | 2 +- .../transcripts/errors/ucm-hide-all.output.md | 2 +- .../transcripts/errors/ucm-hide-error.md | 2 +- .../errors/ucm-hide-error.output.md | 2 +- unison-src/transcripts/errors/ucm-hide.md | 2 +- .../transcripts/errors/ucm-hide.output.md | 2 +- unison-src/transcripts/find-by-type.md | 12 +- unison-src/transcripts/find-by-type.output.md | 10 +- unison-src/transcripts/find-command.md | 30 +- unison-src/transcripts/find-command.output.md | 57 +- .../transcripts/fix-1381-excess-propagate.md | 8 +- .../fix-1381-excess-propagate.output.md | 8 +- .../fix-2258-if-as-list-element.md | 2 +- unison-src/transcripts/fix-big-list-crash.md | 2 +- unison-src/transcripts/fix1063.md | 6 +- unison-src/transcripts/fix1063.output.md | 4 +- unison-src/transcripts/fix1334.md | 4 +- unison-src/transcripts/fix1334.output.md | 4 +- unison-src/transcripts/fix1390.md | 6 +- unison-src/transcripts/fix1390.output.md | 6 +- unison-src/transcripts/fix1532.md | 14 +- unison-src/transcripts/fix1532.output.md | 14 +- unison-src/transcripts/fix1578.md | 4 +- unison-src/transcripts/fix1696.md | 2 +- unison-src/transcripts/fix1731.md | 4 +- unison-src/transcripts/fix1800.md | 26 +- unison-src/transcripts/fix1800.output.md | 24 +- unison-src/transcripts/fix1926.md | 2 +- unison-src/transcripts/fix1926.output.md | 2 +- unison-src/transcripts/fix2000.md | 24 +- unison-src/transcripts/fix2000.output.md | 26 +- unison-src/transcripts/fix2004.md | 52 +- unison-src/transcripts/fix2004.output.md | 187 +--- unison-src/transcripts/fix2026.md | 4 +- unison-src/transcripts/fix2026.output.md | 2 +- unison-src/transcripts/fix2027.md | 4 +- unison-src/transcripts/fix2027.output.md | 2 +- unison-src/transcripts/fix2049.md | 6 +- unison-src/transcripts/fix2049.output.md | 4 +- unison-src/transcripts/fix2053.md | 4 +- unison-src/transcripts/fix2053.output.md | 2 +- unison-src/transcripts/fix2156.md | 2 +- unison-src/transcripts/fix2167.md | 2 +- unison-src/transcripts/fix2187.md | 2 +- unison-src/transcripts/fix2231.md | 4 +- unison-src/transcripts/fix2231.output.md | 2 +- unison-src/transcripts/fix2238.md | 4 +- unison-src/transcripts/fix2238.output.md | 2 +- unison-src/transcripts/fix2244.md | 6 +- unison-src/transcripts/fix2244.output.md | 2 +- unison-src/transcripts/fix2254.md | 4 +- unison-src/transcripts/fix2254.output.md | 166 +--- unison-src/transcripts/fix2268.md | 2 +- unison-src/transcripts/fix2334.md | 2 +- unison-src/transcripts/fix2344.md | 2 +- unison-src/transcripts/fix2353.md | 2 +- unison-src/transcripts/fix2354.md | 2 +- unison-src/transcripts/fix2355.md | 2 +- unison-src/transcripts/fix2378.md | 2 +- unison-src/transcripts/fix2423.md | 2 +- unison-src/transcripts/fix2474.md | 2 +- unison-src/transcripts/fix2474.output.md | 2 +- unison-src/transcripts/fix2628.md | 6 +- unison-src/transcripts/fix2628.output.md | 30 +- unison-src/transcripts/fix2663.md | 2 +- unison-src/transcripts/fix2693.md | 4 +- unison-src/transcripts/fix2693.output.md | 2 +- unison-src/transcripts/fix2712.md | 4 +- unison-src/transcripts/fix2712.output.md | 2 +- unison-src/transcripts/fix2795.md | 6 +- unison-src/transcripts/fix2795.output.md | 6 +- unison-src/transcripts/fix2840.md | 6 +- unison-src/transcripts/fix2840.output.md | 4 +- unison-src/transcripts/fix2970.md | 2 +- unison-src/transcripts/fix2970.output.md | 2 +- unison-src/transcripts/fix3037.md | 2 +- unison-src/transcripts/fix3171.md | 2 +- unison-src/transcripts/fix3196.md | 2 +- unison-src/transcripts/fix3215.md | 2 +- unison-src/transcripts/fix3244.md | 2 +- unison-src/transcripts/fix3265.md | 2 +- unison-src/transcripts/fix3634.md | 6 +- unison-src/transcripts/fix3634.output.md | 4 +- unison-src/transcripts/fix3678.md | 2 +- unison-src/transcripts/fix3752.md | 2 +- unison-src/transcripts/fix3759.md | 4 +- unison-src/transcripts/fix3773.md | 2 +- unison-src/transcripts/fix4172.md | 10 +- unison-src/transcripts/fix4172.output.md | 8 +- unison-src/transcripts/fix4280.md | 2 +- unison-src/transcripts/fix4424.md | 6 +- unison-src/transcripts/fix4424.output.md | 4 +- unison-src/transcripts/fix4498.md | 6 +- unison-src/transcripts/fix4498.output.md | 4 +- unison-src/transcripts/fix4556.md | 6 +- unison-src/transcripts/fix4556.output.md | 4 +- unison-src/transcripts/fix4592.md | 2 +- unison-src/transcripts/fix4618.md | 6 +- unison-src/transcripts/fix4618.output.md | 4 +- unison-src/transcripts/fix4722.md | 2 +- unison-src/transcripts/fix4780.md | 2 +- unison-src/transcripts/fix4898.md | 8 +- unison-src/transcripts/fix4898.output.md | 8 +- unison-src/transcripts/fix614.md | 4 +- unison-src/transcripts/fix689.md | 2 +- unison-src/transcripts/fix693.md | 4 +- unison-src/transcripts/fix693.output.md | 2 +- unison-src/transcripts/fix845.md | 4 +- unison-src/transcripts/fix849.md | 2 +- unison-src/transcripts/fix942.md | 12 +- unison-src/transcripts/fix942.output.md | 10 +- unison-src/transcripts/fix987.md | 6 +- unison-src/transcripts/fix987.output.md | 4 +- unison-src/transcripts/formatter.md | 6 +- unison-src/transcripts/formatter.output.md | 4 +- unison-src/transcripts/fuzzy-options.md | 12 +- .../transcripts/fuzzy-options.output.md | 16 +- unison-src/transcripts/hello.md | 8 +- unison-src/transcripts/hello.output.md | 4 +- unison-src/transcripts/higher-rank.md | 6 +- unison-src/transcripts/io-test-command.md | 12 +- .../transcripts/io-test-command.output.md | 8 +- unison-src/transcripts/io.md | 72 +- unison-src/transcripts/io.output.md | 62 +- unison-src/transcripts/kind-inference.md | 2 +- unison-src/transcripts/lambdacase.md | 14 +- unison-src/transcripts/lambdacase.output.md | 10 +- .../transcripts/ls-pretty-print-scope-bug.md | 8 +- .../ls-pretty-print-scope-bug.output.md | 26 +- unison-src/transcripts/lsp-fold-ranges.md | 4 +- .../transcripts/lsp-fold-ranges.output.md | 2 +- unison-src/transcripts/merge.md | 56 +- unison-src/transcripts/mergeloop.md | 6 +- unison-src/transcripts/mergeloop.output.md | 33 +- unison-src/transcripts/merges.md | 34 +- unison-src/transcripts/merges.output.md | 212 +---- unison-src/transcripts/move-all.md | 16 +- unison-src/transcripts/move-all.output.md | 14 +- unison-src/transcripts/move-namespace.md | 24 +- .../transcripts/move-namespace.output.md | 186 +--- unison-src/transcripts/name-segment-escape.md | 8 +- .../transcripts/name-segment-escape.output.md | 8 +- unison-src/transcripts/name-selection.md | 6 +- .../transcripts/name-selection.output.md | 120 +-- unison-src/transcripts/names.md | 2 +- unison-src/transcripts/names.output.md | 59 +- .../namespace-deletion-regression.md | 10 +- .../namespace-deletion-regression.output.md | 21 +- unison-src/transcripts/old-fold-right.md | 2 +- .../transcripts/pattern-match-coverage.md | 8 +- .../pattern-match-coverage.output.md | 6 +- .../transcripts/pattern-pretty-print-2345.md | 32 +- .../pattern-pretty-print-2345.output.md | 30 +- unison-src/transcripts/patternMatchTls.md | 6 +- .../transcripts/patternMatchTls.output.md | 4 +- unison-src/transcripts/patterns.md | 2 +- unison-src/transcripts/project-merge.md | 8 +- .../transcripts/project-merge.output.md | 142 +--- unison-src/transcripts/propagate.md | 2 +- unison-src/transcripts/propagate.output.md | 83 +- unison-src/transcripts/records.md | 28 +- unison-src/transcripts/records.output.md | 12 +- unison-src/transcripts/reflog.md | 14 +- unison-src/transcripts/reflog.output.md | 22 +- unison-src/transcripts/reset.md | 20 +- unison-src/transcripts/reset.output.md | 18 +- unison-src/transcripts/rsa.md | 2 +- unison-src/transcripts/scope-ref.md | 2 +- unison-src/transcripts/squash.md | 50 +- unison-src/transcripts/squash.output.md | 496 +---------- unison-src/transcripts/suffixes.md | 24 +- unison-src/transcripts/suffixes.output.md | 22 +- unison-src/transcripts/switch-command.md | 8 +- .../transcripts/switch-command.output.md | 11 +- unison-src/transcripts/tab-completion.md | 36 +- .../transcripts/tab-completion.output.md | 39 +- unison-src/transcripts/test-command.md | 14 +- unison-src/transcripts/test-command.output.md | 41 +- unison-src/transcripts/text-literals.md | 6 +- .../transcripts/text-literals.output.md | 4 +- unison-src/transcripts/todo-bug-builtins.md | 2 +- unison-src/transcripts/todo.output.md | 12 +- .../transcripts/top-level-exceptions.md | 12 +- .../top-level-exceptions.output.md | 10 +- unison-src/transcripts/type-deps.md | 8 +- unison-src/transcripts/type-deps.output.md | 4 +- .../transcripts/type-modifier-are-optional.md | 2 +- unison-src/transcripts/unique-type-churn.md | 12 +- .../transcripts/unique-type-churn.output.md | 12 +- unison-src/transcripts/unitnamespace.md | 6 +- .../transcripts/unitnamespace.output.md | 36 +- unison-src/transcripts/universal-cmp.md | 6 +- .../transcripts/universal-cmp.output.md | 4 +- unison-src/transcripts/unsafe-coerce.md | 8 +- .../transcripts/unsafe-coerce.output.md | 6 +- .../update-ignores-lib-namespace.md | 8 +- .../update-ignores-lib-namespace.output.md | 6 +- unison-src/transcripts/update-on-conflict.md | 4 +- .../transcripts/update-on-conflict.output.md | 63 +- .../update-term-aliases-in-different-ways.md | 8 +- ...e-term-aliases-in-different-ways.output.md | 8 +- .../update-term-to-different-type.md | 8 +- .../update-term-to-different-type.output.md | 8 +- .../transcripts/update-term-with-alias.md | 8 +- .../update-term-with-alias.output.md | 8 +- ...e-term-with-dependent-to-different-type.md | 6 +- ...with-dependent-to-different-type.output.md | 6 +- .../transcripts/update-term-with-dependent.md | 8 +- .../update-term-with-dependent.output.md | 8 +- unison-src/transcripts/update-term.md | 8 +- unison-src/transcripts/update-term.output.md | 8 +- .../transcripts/update-test-to-non-test.md | 10 +- .../update-test-to-non-test.output.md | 10 +- .../update-test-watch-roundtrip.md | 6 +- .../update-test-watch-roundtrip.output.md | 4 +- .../update-type-add-constructor.md | 10 +- .../update-type-add-constructor.output.md | 8 +- .../transcripts/update-type-add-field.md | 10 +- .../update-type-add-field.output.md | 8 +- .../transcripts/update-type-add-new-record.md | 4 +- .../update-type-add-new-record.output.md | 6 +- .../update-type-add-record-field.md | 10 +- .../update-type-add-record-field.output.md | 8 +- .../update-type-constructor-alias.md | 10 +- .../update-type-constructor-alias.output.md | 8 +- ...-type-delete-constructor-with-dependent.md | 6 +- ...elete-constructor-with-dependent.output.md | 4 +- .../update-type-delete-constructor.md | 10 +- .../update-type-delete-constructor.output.md | 8 +- .../update-type-delete-record-field.md | 10 +- .../update-type-delete-record-field.output.md | 8 +- .../update-type-missing-constructor.md | 10 +- .../update-type-missing-constructor.output.md | 8 +- .../update-type-nested-decl-aliases.md | 6 +- .../update-type-nested-decl-aliases.output.md | 4 +- .../transcripts/update-type-no-op-record.md | 6 +- .../update-type-no-op-record.output.md | 4 +- .../update-type-stray-constructor-alias.md | 10 +- ...ate-type-stray-constructor-alias.output.md | 8 +- .../update-type-stray-constructor.md | 10 +- .../update-type-stray-constructor.output.md | 8 +- ...turn-constructor-into-smart-constructor.md | 10 +- ...nstructor-into-smart-constructor.output.md | 8 +- ...update-type-turn-non-record-into-record.md | 10 +- ...type-turn-non-record-into-record.output.md | 8 +- .../update-type-with-dependent-term.md | 6 +- .../update-type-with-dependent-term.output.md | 4 +- ...e-with-dependent-type-to-different-kind.md | 6 +- ...dependent-type-to-different-kind.output.md | 4 +- .../update-type-with-dependent-type.md | 12 +- .../update-type-with-dependent-type.output.md | 10 +- unison-src/transcripts/update-watch.md | 2 +- unison-src/transcripts/update-watch.output.md | 2 +- unison-src/transcripts/view.md | 6 +- unison-src/transcripts/view.output.md | 35 +- unison-src/transcripts/watch-expressions.md | 8 +- .../transcripts/watch-expressions.output.md | 8 +- 422 files changed, 2188 insertions(+), 5669 deletions(-) diff --git a/unison-src/builtin-tests/base.md b/unison-src/builtin-tests/base.md index d4717fdcc1..70443ad0f7 100644 --- a/unison-src/builtin-tests/base.md +++ b/unison-src/builtin-tests/base.md @@ -5,7 +5,7 @@ Thus, make sure the contents of this file define the contents of the cache (e.g. don't pull `latest`.) ```ucm -.> pull @unison/base/releases/2.5.0 .base -.> builtins.mergeio -.> undo +scratch/main> pull @unison/base/releases/2.5.0 .base +scratch/main> builtins.mergeio +scratch/main> undo ``` diff --git a/unison-src/builtin-tests/interpreter-tests.tpl.md b/unison-src/builtin-tests/interpreter-tests.tpl.md index 2d09efdc0e..9e34968a78 100644 --- a/unison-src/builtin-tests/interpreter-tests.tpl.md +++ b/unison-src/builtin-tests/interpreter-tests.tpl.md @@ -5,12 +5,12 @@ If you want to add or update tests, you can create a branch of that project, and Before merging the PR on Github, we'll merge your branch on Share and restore `runtime_tests_version` to /main or maybe a release. ```ucm:hide:error -.> this is a hack to trigger an error, in order to swallow any error on the next line. -.> we delete the project to avoid any merge conflicts or complaints from ucm. -.> delete.project runtime-tests +scratch/main> this is a hack to trigger an error, in order to swallow any error on the next line. +scratch/main> we delete the project to avoid any merge conflicts or complaints from ucm. +scratch/main> delete.project runtime-tests ``` ```ucm:hide -.> clone ${runtime_tests_version} runtime-tests/selected +scratch/main> clone ${runtime_tests_version} runtime-tests/selected ``` ```ucm diff --git a/unison-src/builtin-tests/jit-tests.tpl.md b/unison-src/builtin-tests/jit-tests.tpl.md index b24a7c7c7c..ea4a65793d 100644 --- a/unison-src/builtin-tests/jit-tests.tpl.md +++ b/unison-src/builtin-tests/jit-tests.tpl.md @@ -5,12 +5,12 @@ If you want to add or update tests, you can create a branch of that project, and Before merging the PR on Github, we'll merge your branch on Share and restore `runtime_tests_version` to /main or maybe a release. ```ucm:hide:error -.> this is a hack to trigger an error, in order to swallow any error on the next line. -.> we delete the project to avoid any merge conflicts or complaints from ucm. -.> delete.project runtime-tests +scratch/main> this is a hack to trigger an error, in order to swallow any error on the next line. +scratch/main> we delete the project to avoid any merge conflicts or complaints from ucm. +scratch/main> delete.project runtime-tests ``` ```ucm:hide -.> clone ${runtime_tests_version} runtime-tests/selected +scratch/main> clone ${runtime_tests_version} runtime-tests/selected ``` ```ucm @@ -31,8 +31,8 @@ foo = do ``` ```ucm -.> run.native foo -.> run.native foo +scratch/main> run.native foo +scratch/main> run.native foo ``` This can also only be tested by separately running this test, because diff --git a/unison-src/transcripts-manual/benchmarks.md b/unison-src/transcripts-manual/benchmarks.md index 0a8ff9358c..2a3fe38a66 100644 --- a/unison-src/transcripts-manual/benchmarks.md +++ b/unison-src/transcripts-manual/benchmarks.md @@ -1,6 +1,6 @@ ```ucm:hide -.> pull unison.public.base.releases.M4d base -.> pull runarorama.public.sort.data sort +scratch/main> pull unison.public.base.releases.M4d base +scratch/main> pull runarorama.public.sort.data sort ``` ```unison:hide @@ -34,63 +34,63 @@ prepare = do ``` ```ucm:hide -.> add -.> run prepare +scratch/main> add +scratch/main> run prepare ``` ## Benchmarks ```ucm -.> load unison-src/transcripts-manual/benchmarks/each.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/each.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/listmap.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/listmap.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/listfilter.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/listfilter.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/random.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/random.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/simpleloop.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/simpleloop.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/fibonacci.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/fibonacci.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/map.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/map.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/natmap.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/natmap.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/stm.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/stm.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/tmap.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/tmap.u +scratch/main> run main ``` ```ucm -.> load unison-src/transcripts-manual/benchmarks/array-sort.u -.> run main +scratch/main> load unison-src/transcripts-manual/benchmarks/array-sort.u +scratch/main> run main ``` \ No newline at end of file diff --git a/unison-src/transcripts-manual/remote-tab-completion.md b/unison-src/transcripts-manual/remote-tab-completion.md index da783b9de7..55b4adeec1 100644 --- a/unison-src/transcripts-manual/remote-tab-completion.md +++ b/unison-src/transcripts-manual/remote-tab-completion.md @@ -3,5 +3,5 @@ Note: this makes a network call to share to get completions ```ucm -.> debug.tab-complete pull unison.pub +scratch/main> debug.tab-complete pull unison.pub ``` diff --git a/unison-src/transcripts-manual/rewrites.md b/unison-src/transcripts-manual/rewrites.md index 15a5a06387..891cf53bd1 100644 --- a/unison-src/transcripts-manual/rewrites.md +++ b/unison-src/transcripts-manual/rewrites.md @@ -1,8 +1,8 @@ ```ucm:hide -.> builtins.mergeio -.> load unison-src/transcripts-using-base/base.u -.> add +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts-using-base/base.u +scratch/main> add ``` ## Structural find and replace @@ -37,19 +37,19 @@ rule2 x = @rewrite signature Optional ==> Optional2 Let's rewrite these: ```ucm -.> rewrite rule1 -.> rewrite eitherToOptional +scratch/main> rewrite rule1 +scratch/main> rewrite eitherToOptional ``` ```ucm:hide -.> load -.> add +scratch/main> load +scratch/main> add ``` After adding to the codebase, here's the rewritten source: ```ucm -.> view ex1 Either.mapRight rule1 +scratch/main> view ex1 Either.mapRight rule1 ``` Another example, showing that we can rewrite to definitions that only exist in the file: @@ -75,18 +75,18 @@ blah2 = 456 Let's apply the rewrite `woot1to2`: ```ucm -.> rewrite woot1to2 +scratch/main> rewrite woot1to2 ``` ```ucm:hide -.> load -.> add +scratch/main> load +scratch/main> add ``` After adding the rewritten form to the codebase, here's the rewritten `Woot1` to `Woot2`: ```ucm -.> view wootEx +scratch/main> view wootEx ``` This example shows that rewrite rules can to refer to term definitions that only exist in the file: @@ -111,15 +111,15 @@ sameFileEx = ``` ```ucm:hide -.> rewrite rule -.> load -.> add +scratch/main> rewrite rule +scratch/main> load +scratch/main> add ``` After adding the rewritten form to the codebase, here's the rewritten definitions: ```ucm -.> view foo1 foo2 sameFileEx +scratch/main> view foo1 foo2 sameFileEx ``` ## Capture avoidance @@ -145,13 +145,13 @@ sameFileEx = In the above example, `bar2` is locally bound by the rule, so when applied, it should not refer to the `bar2` top level binding. ```ucm -.> rewrite rule +scratch/main> rewrite rule ``` Instead, it should be an unbound free variable, which doesn't typecheck: ```ucm:error -.> load +scratch/main> load ``` In this example, the `a` is locally bound by the rule, so it shouldn't capture the `a = 39494` binding which is in scope at the point of the replacement: @@ -167,13 +167,13 @@ rule a = @rewrite ``` ```ucm -.> rewrite rule +scratch/main> rewrite rule ``` The `a` introduced will be freshened to not capture the `a` in scope, so it remains as an unbound variable and is a type error: ```ucm:error -.> load +scratch/main> load ``` ## Structural find @@ -183,7 +183,7 @@ eitherEx = Left ("hello", "there") ``` ```ucm:hide -.> add +scratch/main> add ``` ```unison:hide @@ -192,7 +192,7 @@ findEitherFailure = @rewrite signature a . Either Failure a ==> () ``` ```ucm -.> sfind findEitherEx -.> sfind findEitherFailure -.> find 1-5 +scratch/main> sfind findEitherEx +scratch/main> sfind findEitherFailure +scratch/main> find 1-5 ``` diff --git a/unison-src/transcripts-manual/scheme.md b/unison-src/transcripts-manual/scheme.md index 1c1427280f..35aae31b26 100644 --- a/unison-src/transcripts-manual/scheme.md +++ b/unison-src/transcripts-manual/scheme.md @@ -2,8 +2,8 @@ This transcript executes very slowly, because the compiler has an entire copy of base (and other stuff) within it. ```ucm:hide -.> builtins.merge -.> pull.without-history unison.public.base.trunk base +scratch/main> builtins.merge +scratch/main> pull.without-history unison.public.base.trunk base ``` ```unison @@ -55,7 +55,7 @@ multiAddUp = repeat 35 '(printAddUp 3000000) ``` ```ucm -.> add -.> run singleAddUp -.> run.native multiAddUp +scratch/main> add +scratch/main> run singleAddUp +scratch/main> run.native multiAddUp ``` diff --git a/unison-src/transcripts-round-trip/main.md b/unison-src/transcripts-round-trip/main.md index 7287a7ddba..a7479d758a 100644 --- a/unison-src/transcripts-round-trip/main.md +++ b/unison-src/transcripts-round-trip/main.md @@ -1,13 +1,13 @@ This transcript verifies that the pretty-printer produces code that can be successfully parsed, for a variety of examples. Terms or types that fail to round-trip can be added to either `reparses-with-same-hash.u` or `reparses.u` as regression tests. ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```ucm:hide -.> copy.namespace builtin a1.lib.builtin -.> copy.namespace builtin a2.lib.builtin -.> load unison-src/transcripts-round-trip/reparses-with-same-hash.u +scratch/main> copy.namespace builtin a1.lib.builtin +scratch/main> copy.namespace builtin a2.lib.builtin +scratch/main> load unison-src/transcripts-round-trip/reparses-with-same-hash.u .a1> add ``` @@ -41,12 +41,12 @@ So we can see the pretty-printed output: This diff should be empty if the two namespaces are equivalent. If it's nonempty, the diff will show us the hashes that differ. ```ucm:error -.> diff.namespace a1 a2 +scratch/main> diff.namespace a1 a2 ``` ```ucm:hide -.> undo -.> undo +scratch/main> undo +scratch/main> undo ``` Now check that definitions in 'reparses.u' at least parse on round trip: @@ -72,7 +72,7 @@ x = () ``` ```ucm:hide -.> move.namespace a3 a3_old +scratch/main> move.namespace a3 a3_old .a3> copy.namespace .builtin lib.builtin .a3> load .a3> add @@ -83,7 +83,7 @@ x = () These are currently all expected to have different hashes on round trip. ```ucm -.> diff.namespace a3 a3_old +scratch/main> diff.namespace a3 a3_old ``` ## Other regression tests not covered by above @@ -93,8 +93,8 @@ These are currently all expected to have different hashes on round trip. Regression test for https://github.com/unisonweb/unison/pull/3548 ```ucm:hide -.> alias.term ##Nat.+ plus -.> edit plus -.> load -.> undo +scratch/main> alias.term ##Nat.+ plus +scratch/main> edit plus +scratch/main> load +scratch/main> undo ``` diff --git a/unison-src/transcripts-using-base/_base.md b/unison-src/transcripts-using-base/_base.md index 1befbcb2e9..8c4d8c707c 100644 --- a/unison-src/transcripts-using-base/_base.md +++ b/unison-src/transcripts-using-base/_base.md @@ -10,9 +10,9 @@ transcripts which contain less boilerplate. ## Usage ```ucm:hide -.> builtins.mergeio -.> load unison-src/transcripts-using-base/base.u -.> add +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts-using-base/base.u +scratch/main> add ``` The test shows that `hex (fromHex str) == str` as expected. @@ -24,7 +24,7 @@ test> hex.tests.ex1 = checks let ``` ```ucm:hide -.> test +scratch/main> test ``` Lets do some basic testing of our test harness to make sure its @@ -50,6 +50,6 @@ testAutoClean _ = ``` ```ucm -.> add -.> io.test testAutoClean +scratch/main> add +scratch/main> io.test testAutoClean ``` diff --git a/unison-src/transcripts-using-base/_base.output.md b/unison-src/transcripts-using-base/_base.output.md index eeaebe564c..793d4ecca8 100644 --- a/unison-src/transcripts-using-base/_base.output.md +++ b/unison-src/transcripts-using-base/_base.output.md @@ -53,13 +53,13 @@ testAutoClean _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testAutoClean : '{IO} [Result] -.> io.test testAutoClean +scratch/main> io.test testAutoClean New test results: diff --git a/unison-src/transcripts-using-base/all-base-hashes.md b/unison-src/transcripts-using-base/all-base-hashes.md index d7050cb774..bb0f27c2cd 100644 --- a/unison-src/transcripts-using-base/all-base-hashes.md +++ b/unison-src/transcripts-using-base/all-base-hashes.md @@ -1,5 +1,5 @@ This transcript is intended to make visible accidental changes to the hashing algorithm. ```ucm -.> find.verbose +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts-using-base/all-base-hashes.output.md b/unison-src/transcripts-using-base/all-base-hashes.output.md index 63c258e137..99d4128d07 100644 --- a/unison-src/transcripts-using-base/all-base-hashes.output.md +++ b/unison-src/transcripts-using-base/all-base-hashes.output.md @@ -1,7 +1,7 @@ This transcript is intended to make visible accidental changes to the hashing algorithm. ```ucm -.> find.verbose +scratch/main> find.verbose 1. -- #sgesq8035ut22q779pl1g4gqsg8c81894jjonmrq1bjltphkath225up841hk8dku59tnnc4laj9nggbofamgei4klof0ldc20uj2oo <| : (i ->{g} o) -> i ->{g} o diff --git a/unison-src/transcripts-using-base/binary-encoding-nats.md b/unison-src/transcripts-using-base/binary-encoding-nats.md index 711bcb3300..2eee6caf58 100644 --- a/unison-src/transcripts-using-base/binary-encoding-nats.md +++ b/unison-src/transcripts-using-base/binary-encoding-nats.md @@ -54,6 +54,6 @@ testABunchOfNats _ = ``` ```ucm -.> add -.> io.test testABunchOfNats +scratch/main> add +scratch/main> io.test testABunchOfNats ``` diff --git a/unison-src/transcripts-using-base/binary-encoding-nats.output.md b/unison-src/transcripts-using-base/binary-encoding-nats.output.md index 0227ff8e25..346b2135c3 100644 --- a/unison-src/transcripts-using-base/binary-encoding-nats.output.md +++ b/unison-src/transcripts-using-base/binary-encoding-nats.output.md @@ -76,7 +76,7 @@ testABunchOfNats _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -91,7 +91,7 @@ testABunchOfNats _ = testNat : Nat -> '{IO, Stream Result} () testRoundTrip : Nat -> EncDec ->{IO, Stream Result} () -.> io.test testABunchOfNats +scratch/main> io.test testABunchOfNats New test results: diff --git a/unison-src/transcripts-using-base/codeops.md b/unison-src/transcripts-using-base/codeops.md index 4754eb0aaf..1e2797769b 100644 --- a/unison-src/transcripts-using-base/codeops.md +++ b/unison-src/transcripts-using-base/codeops.md @@ -153,7 +153,7 @@ swapped name link = ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -236,9 +236,9 @@ we gain the ability to capture output in a transcript, it can be modified to actual show that the serialization works. ```ucm -.> add -.> io.test tests -.> io.test badLoad +scratch/main> add +scratch/main> io.test tests +scratch/main> io.test badLoad ``` ```unison @@ -278,8 +278,8 @@ codeTests = ``` ```ucm -.> add -.> io.test codeTests +scratch/main> add +scratch/main> io.test codeTests ``` ```unison @@ -309,6 +309,6 @@ vtests _ = ``` ```ucm -.> add -.> io.test vtests +scratch/main> add +scratch/main> io.test vtests ``` diff --git a/unison-src/transcripts-using-base/codeops.output.md b/unison-src/transcripts-using-base/codeops.output.md index 3f76560f4a..0b87f0cf9b 100644 --- a/unison-src/transcripts-using-base/codeops.output.md +++ b/unison-src/transcripts-using-base/codeops.output.md @@ -200,7 +200,7 @@ swapped name link = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -344,7 +344,7 @@ we gain the ability to capture output in a transcript, it can be modified to actual show that the serialization works. ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -360,7 +360,7 @@ to actual show that the serialization works. tests : '{IO} [Result] zapper : Three Nat Nat Nat -> Request {Zap} r -> r -.> io.test tests +scratch/main> io.test tests New test results: @@ -382,7 +382,7 @@ to actual show that the serialization works. Tip: Use view tests to view the source of a test. -.> io.test badLoad +scratch/main> io.test badLoad New test results: @@ -443,13 +443,13 @@ codeTests = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: codeTests : '{IO} [Result] -.> io.test codeTests +scratch/main> io.test codeTests New test results: @@ -530,14 +530,14 @@ vtests _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: validateTest : Link.Term ->{IO} Result vtests : '{IO} [Result] -.> io.test vtests +scratch/main> io.test vtests New test results: diff --git a/unison-src/transcripts-using-base/doc.md b/unison-src/transcripts-using-base/doc.md index 461a4f04bb..52973ddb3e 100644 --- a/unison-src/transcripts-using-base/doc.md +++ b/unison-src/transcripts-using-base/doc.md @@ -33,9 +33,9 @@ Notice that an anonymous documentation block `{{ ... }}` before a definition `Im You can preview what docs will look like when rendered to the console using the `display` or `docs` commands: ```ucm -.> display d1 -.> docs ImportantConstant -.> docs DayOfWeek +scratch/main> display d1 +scratch/main> docs ImportantConstant +scratch/main> docs DayOfWeek ``` The `docs ImportantConstant` command will look for `ImportantConstant.doc` in the file or codebase. You can do this instead of explicitly linking docs to definitions. @@ -45,11 +45,11 @@ The `docs ImportantConstant` command will look for `ImportantConstant.doc` in th First, we'll load the `syntax.u` file which has examples of all the syntax: ```ucm -.> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u +scratch/main> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u ``` ```ucm:hide -.> add +scratch/main> add ``` Now we can review different portions of the guide. @@ -57,25 +57,25 @@ we'll show both the pretty-printed source using `view` and the rendered output using `display`: ```ucm -.> view basicFormatting -.> display basicFormatting -.> view lists -.> display lists -.> view evaluation -.> display evaluation -.> view includingSource -.> display includingSource -.> view nonUnisonCodeBlocks -.> display nonUnisonCodeBlocks -.> view otherElements -.> display otherElements +scratch/main> view basicFormatting +scratch/main> display basicFormatting +scratch/main> view lists +scratch/main> display lists +scratch/main> view evaluation +scratch/main> display evaluation +scratch/main> view includingSource +scratch/main> display includingSource +scratch/main> view nonUnisonCodeBlocks +scratch/main> display nonUnisonCodeBlocks +scratch/main> view otherElements +scratch/main> display otherElements ``` Lastly, it's common to build longer documents including subdocuments via `{{ subdoc }}`. We can stitch together the full syntax guide in this way: ```ucm -.> view doc.guide -.> display doc.guide +scratch/main> view doc.guide +scratch/main> display doc.guide ``` 🌻 THE END diff --git a/unison-src/transcripts-using-base/doc.output.md b/unison-src/transcripts-using-base/doc.output.md index 43edad9881..e47d8d0737 100644 --- a/unison-src/transcripts-using-base/doc.output.md +++ b/unison-src/transcripts-using-base/doc.output.md @@ -51,15 +51,15 @@ Notice that an anonymous documentation block `{{ ... }}` before a definition `Im You can preview what docs will look like when rendered to the console using the `display` or `docs` commands: ```ucm -.> display d1 +scratch/main> display d1 Hello there Alice! -.> docs ImportantConstant +scratch/main> docs ImportantConstant An important constant, equal to `42` -.> docs DayOfWeek +scratch/main> docs DayOfWeek The 7 days of the week, defined as: @@ -73,7 +73,7 @@ The `docs ImportantConstant` command will look for `ImportantConstant.doc` in th First, we'll load the `syntax.u` file which has examples of all the syntax: ```ucm -.> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u +scratch/main> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u Loading changes detected in ./unison-src/transcripts-using-base/doc.md.files/syntax.u. @@ -100,7 +100,7 @@ we'll show both the pretty-printed source using `view` and the rendered output using `display`: ```ucm -.> view basicFormatting +scratch/main> view basicFormatting basicFormatting : Doc2 basicFormatting = @@ -130,7 +130,7 @@ and the rendered output using `display`: __Next up:__ {lists} }} -.> display basicFormatting +scratch/main> display basicFormatting # Basic formatting @@ -155,7 +155,7 @@ and the rendered output using `display`: *Next up:* lists -.> view lists +scratch/main> view lists lists : Doc2 lists = @@ -198,7 +198,7 @@ and the rendered output using `display`: 3. Get dressed. }} -.> display lists +scratch/main> display lists # Lists @@ -237,7 +237,7 @@ and the rendered output using `display`: 2. Take shower. 3. Get dressed. -.> view evaluation +scratch/main> view evaluation evaluation : Doc2 evaluation = @@ -272,7 +272,7 @@ and the rendered output using `display`: ``` }} -.> display evaluation +scratch/main> display evaluation # Evaluation @@ -300,7 +300,7 @@ and the rendered output using `display`: cube : Nat -> Nat cube x = x * x * x -.> view includingSource +scratch/main> view includingSource includingSource : Doc2 includingSource = @@ -341,7 +341,7 @@ and the rendered output using `display`: {{ docExample 1 do x -> sqr x }}. }} -.> display includingSource +scratch/main> display includingSource # Including Unison source code @@ -387,7 +387,7 @@ and the rendered output using `display`: application, you can put it in double backticks, like so: `sqr x`. This is equivalent to `sqr x`. -.> view nonUnisonCodeBlocks +scratch/main> view nonUnisonCodeBlocks nonUnisonCodeBlocks : Doc2 nonUnisonCodeBlocks = @@ -420,7 +420,7 @@ and the rendered output using `display`: ``` }} -.> display nonUnisonCodeBlocks +scratch/main> display nonUnisonCodeBlocks # Non-Unison code blocks @@ -449,7 +449,7 @@ and the rendered output using `display`: xs.foldLeft(Nil : List[A])((acc,a) => a +: acc) ``` -.> view otherElements +scratch/main> view otherElements otherElements : Doc2 otherElements = @@ -506,7 +506,7 @@ and the rendered output using `display`: ] }} }} -.> display otherElements +scratch/main> display otherElements There are also asides, callouts, tables, tooltips, and more. These don't currently have special syntax; just use the @@ -549,7 +549,7 @@ and the rendered output using `display`: Lastly, it's common to build longer documents including subdocuments via `{{ subdoc }}`. We can stitch together the full syntax guide in this way: ```ucm -.> view doc.guide +scratch/main> view doc.guide doc.guide : Doc2 doc.guide = @@ -569,7 +569,7 @@ Lastly, it's common to build longer documents including subdocuments via `{{ sub {{ otherElements }} }} -.> display doc.guide +scratch/main> display doc.guide # Unison computable documentation diff --git a/unison-src/transcripts-using-base/failure-tests.md b/unison-src/transcripts-using-base/failure-tests.md index 049b4fcbb1..5f69a8c2a0 100644 --- a/unison-src/transcripts-using-base/failure-tests.md +++ b/unison-src/transcripts-using-base/failure-tests.md @@ -19,13 +19,13 @@ test2 = do ``` ```ucm -.> add +scratch/main> add ``` ```ucm:error -.> io.test test1 +scratch/main> io.test test1 ``` ```ucm:error -.> io.test test2 +scratch/main> io.test test2 ``` diff --git a/unison-src/transcripts-using-base/failure-tests.output.md b/unison-src/transcripts-using-base/failure-tests.output.md index d59d3d7bc8..7d33aad456 100644 --- a/unison-src/transcripts-using-base/failure-tests.output.md +++ b/unison-src/transcripts-using-base/failure-tests.output.md @@ -33,7 +33,7 @@ test2 = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -42,7 +42,7 @@ test2 = do ``` ```ucm -.> io.test test1 +scratch/main> io.test test1 💔💥 @@ -58,7 +58,7 @@ test2 = do ``` ```ucm -.> io.test test2 +scratch/main> io.test test2 💔💥 diff --git a/unison-src/transcripts-using-base/fix1709.output.md b/unison-src/transcripts-using-base/fix1709.output.md index 953121aa2c..99af3fe0d4 100644 --- a/unison-src/transcripts-using-base/fix1709.output.md +++ b/unison-src/transcripts-using-base/fix1709.output.md @@ -14,10 +14,11 @@ id2 x = do an `add` or `update`, here's how your codebase would change: - ⊡ Previously added definitions will be ignored: id - ⍟ These new definitions are ok to `add`: + id : x -> x + (also named + __projects._a60db36c_af90_4d99_bcd2_3b3c7a24851f.branches._4fe18976_dde6_41e4_82c0_bf3887f77467.id) id2 : x -> x ``` diff --git a/unison-src/transcripts-using-base/fix2358.md b/unison-src/transcripts-using-base/fix2358.md index 915a350607..1c543349e4 100644 --- a/unison-src/transcripts-using-base/fix2358.md +++ b/unison-src/transcripts-using-base/fix2358.md @@ -10,5 +10,5 @@ timingApp2 _ = ``` ```ucm -.> run timingApp2 +scratch/main> run timingApp2 ``` diff --git a/unison-src/transcripts-using-base/fix2358.output.md b/unison-src/transcripts-using-base/fix2358.output.md index 61a3dd8052..d20a06e163 100644 --- a/unison-src/transcripts-using-base/fix2358.output.md +++ b/unison-src/transcripts-using-base/fix2358.output.md @@ -23,7 +23,7 @@ timingApp2 _ = ``` ```ucm -.> run timingApp2 +scratch/main> run timingApp2 () diff --git a/unison-src/transcripts-using-base/fix3939.md b/unison-src/transcripts-using-base/fix3939.md index 7ec695e6c7..e9634ee2fc 100644 --- a/unison-src/transcripts-using-base/fix3939.md +++ b/unison-src/transcripts-using-base/fix3939.md @@ -6,7 +6,7 @@ meh = 9 ``` ```ucm -.> add -.> find meh -.> docs 1 +scratch/main> add +scratch/main> find meh +scratch/main> docs 1 ``` diff --git a/unison-src/transcripts-using-base/fix3939.output.md b/unison-src/transcripts-using-base/fix3939.output.md index 99197263c4..ca4e6d909e 100644 --- a/unison-src/transcripts-using-base/fix3939.output.md +++ b/unison-src/transcripts-using-base/fix3939.output.md @@ -20,20 +20,20 @@ meh = 9 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: meh : Nat meh.doc : Doc2 -.> find meh +scratch/main> find meh 1. meh : Nat 2. meh.doc : Doc2 -.> docs 1 +scratch/main> docs 1 A simple doc. diff --git a/unison-src/transcripts-using-base/hashing.md b/unison-src/transcripts-using-base/hashing.md index 99f7db2477..f7d6a2bdd8 100644 --- a/unison-src/transcripts-using-base/hashing.md +++ b/unison-src/transcripts-using-base/hashing.md @@ -3,7 +3,7 @@ Unison has cryptographic builtins for hashing and computing [HMACs](https://en.wikipedia.org/wiki/HMAC) (hash-based message authentication codes). This transcript shows their usage and has some test cases. ```ucm -.> ls builtin.Bytes +scratch/main> ls builtin.Bytes ``` Notice the `fromBase16` and `toBase16` functions. Here's some convenience functions for converting `Bytes` to and from base-16 `Text`. @@ -43,7 +43,7 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex And here's the full API: ```ucm -.> find-in builtin.crypto +scratch/main> find-in builtin.crypto ``` Note that the universal versions of `hash` and `hmac` are currently unimplemented and will bomb at runtime: @@ -189,11 +189,11 @@ test> crypto.hash.numTests = ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> test +scratch/main> test ``` ## HMAC tests @@ -251,9 +251,9 @@ test> md5.tests.ex3 = ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> test +scratch/main> test ``` diff --git a/unison-src/transcripts-using-base/hashing.output.md b/unison-src/transcripts-using-base/hashing.output.md index fee4fa0a27..cb60fa67fb 100644 --- a/unison-src/transcripts-using-base/hashing.output.md +++ b/unison-src/transcripts-using-base/hashing.output.md @@ -3,7 +3,7 @@ Unison has cryptographic builtins for hashing and computing [HMACs](https://en.wikipedia.org/wiki/HMAC) (hash-based message authentication codes). This transcript shows their usage and has some test cases. ```ucm -.> ls builtin.Bytes +scratch/main> ls builtin.Bytes 1. ++ (Bytes -> Bytes -> Bytes) 2. at (Nat -> Bytes -> Optional Nat) @@ -120,7 +120,7 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex And here's the full API: ```ucm -.> find-in builtin.crypto +scratch/main> find-in builtin.crypto 1. type CryptoFailure 2. Ed25519.sign.impl : Bytes @@ -312,7 +312,7 @@ test> crypto.hash.numTests = ``` ```ucm -.> test +scratch/main> test Cached test results (`help testcache` to learn more) @@ -475,7 +475,7 @@ test> md5.tests.ex3 = ``` ```ucm -.> test +scratch/main> test Cached test results (`help testcache` to learn more) diff --git a/unison-src/transcripts-using-base/mvar.md b/unison-src/transcripts-using-base/mvar.md index d2114c2e28..81be1ed79b 100644 --- a/unison-src/transcripts-using-base/mvar.md +++ b/unison-src/transcripts-using-base/mvar.md @@ -51,7 +51,7 @@ testMvars _ = runTest test ``` ```ucm -.> add -.> io.test testMvars +scratch/main> add +scratch/main> io.test testMvars ``` diff --git a/unison-src/transcripts-using-base/mvar.output.md b/unison-src/transcripts-using-base/mvar.output.md index 26cccc7baf..ff5435392b 100644 --- a/unison-src/transcripts-using-base/mvar.output.md +++ b/unison-src/transcripts-using-base/mvar.output.md @@ -66,14 +66,14 @@ testMvars _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: eitherCk : (a ->{g} Boolean) -> Either e a ->{g} Boolean testMvars : '{IO} [Result] -.> io.test testMvars +scratch/main> io.test testMvars New test results: diff --git a/unison-src/transcripts-using-base/namespace-dependencies.md b/unison-src/transcripts-using-base/namespace-dependencies.md index d338c05432..1558d5951e 100644 --- a/unison-src/transcripts-using-base/namespace-dependencies.md +++ b/unison-src/transcripts-using-base/namespace-dependencies.md @@ -6,6 +6,6 @@ mynamespace.dependsOnText = external.mynat Nat.+ 10 ``` ```ucm -.> add +scratch/main> add .mynamespace> namespace.dependencies ``` diff --git a/unison-src/transcripts-using-base/namespace-dependencies.output.md b/unison-src/transcripts-using-base/namespace-dependencies.output.md index caf4dc52c7..b20019aa47 100644 --- a/unison-src/transcripts-using-base/namespace-dependencies.output.md +++ b/unison-src/transcripts-using-base/namespace-dependencies.output.md @@ -6,20 +6,31 @@ mynamespace.dependsOnText = external.mynat Nat.+ 10 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: external.mynat : Nat mynamespace.dependsOnText : Nat + ☝️ The namespace .mynamespace is empty. + .mynamespace> namespace.dependencies - External dependency Dependents in .mynamespace - .builtin.Nat 1. dependsOnText - - .builtin.Nat.+ 1. dependsOnText - - .external.mynat 1. dependsOnText + ⚠️ + + .mynamespace is an empty namespace. ``` + + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + + + ⚠️ + + .mynamespace is an empty namespace. + diff --git a/unison-src/transcripts-using-base/nat-coersion.md b/unison-src/transcripts-using-base/nat-coersion.md index 3f77501890..ca5ad40f2a 100644 --- a/unison-src/transcripts-using-base/nat-coersion.md +++ b/unison-src/transcripts-using-base/nat-coersion.md @@ -33,6 +33,6 @@ test = 'let ``` ```ucm -.> add -.> io.test test +scratch/main> add +scratch/main> io.test test ``` diff --git a/unison-src/transcripts-using-base/nat-coersion.output.md b/unison-src/transcripts-using-base/nat-coersion.output.md index 38ab4450f0..0e01e72286 100644 --- a/unison-src/transcripts-using-base/nat-coersion.output.md +++ b/unison-src/transcripts-using-base/nat-coersion.output.md @@ -49,7 +49,7 @@ test = 'let ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -59,7 +59,7 @@ test = 'let -> Optional Float ->{Stream Result} () -.> io.test test +scratch/main> io.test test New test results: diff --git a/unison-src/transcripts-using-base/net.md b/unison-src/transcripts-using-base/net.md index b1125f7019..067f9b9a45 100644 --- a/unison-src/transcripts-using-base/net.md +++ b/unison-src/transcripts-using-base/net.md @@ -10,7 +10,7 @@ socketAccept = compose reraise socketAccept.impl ``` ```ucm:hide -.> add +scratch/main> add ``` # Tests for network related builtins @@ -93,8 +93,8 @@ testDefaultPort _ = runTest test ``` ```ucm -.> add -.> io.test testDefaultPort +scratch/main> add +scratch/main> io.test testDefaultPort ``` This example demonstrates connecting a TCP client socket to a TCP server socket. A thread is started for both client and server. The server socket asks for any availalbe port (by passing "0" as the port number). The server thread then queries for the actual assigned port number, and puts that into an MVar which the client thread can read. The client thread then reads a string from the server and reports it back to the main thread via a different MVar. @@ -149,6 +149,6 @@ testTcpConnect = 'let ``` ```ucm -.> add -.> io.test testTcpConnect +scratch/main> add +scratch/main> io.test testTcpConnect ``` diff --git a/unison-src/transcripts-using-base/net.output.md b/unison-src/transcripts-using-base/net.output.md index 572ef0fbff..2437737ac7 100644 --- a/unison-src/transcripts-using-base/net.output.md +++ b/unison-src/transcripts-using-base/net.output.md @@ -107,7 +107,7 @@ testDefaultPort _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -115,7 +115,7 @@ testDefaultPort _ = testDefaultPort : '{IO} [Result] testExplicitHost : '{IO} [Result] -.> io.test testDefaultPort +scratch/main> io.test testDefaultPort New test results: @@ -194,7 +194,7 @@ testTcpConnect = 'let ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -202,7 +202,7 @@ testTcpConnect = 'let serverThread : MVar Nat -> Text -> '{IO} () testTcpConnect : '{IO} [Result] -.> io.test testTcpConnect +scratch/main> io.test testTcpConnect New test results: diff --git a/unison-src/transcripts-using-base/random-deserial.md b/unison-src/transcripts-using-base/random-deserial.md index 1a97ca73d7..2c6ff77de5 100644 --- a/unison-src/transcripts-using-base/random-deserial.md +++ b/unison-src/transcripts-using-base/random-deserial.md @@ -56,6 +56,6 @@ serialTests = do ``` ```ucm -.> add -.> io.test serialTests +scratch/main> add +scratch/main> io.test serialTests ``` diff --git a/unison-src/transcripts-using-base/random-deserial.output.md b/unison-src/transcripts-using-base/random-deserial.output.md index 48ff86e187..f5dbd7aa10 100644 --- a/unison-src/transcripts-using-base/random-deserial.output.md +++ b/unison-src/transcripts-using-base/random-deserial.output.md @@ -74,7 +74,7 @@ serialTests = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -85,7 +85,7 @@ serialTests = do serialTests : '{IO, Exception} [Result] shuffle : Nat -> [a] -> [a] -.> io.test serialTests +scratch/main> io.test serialTests New test results: diff --git a/unison-src/transcripts-using-base/ref-promise.md b/unison-src/transcripts-using-base/ref-promise.md index dd54328ec5..3c2575951c 100644 --- a/unison-src/transcripts-using-base/ref-promise.md +++ b/unison-src/transcripts-using-base/ref-promise.md @@ -19,8 +19,8 @@ casTest = do ``` ```ucm -.> add -.> io.test casTest +scratch/main> add +scratch/main> io.test casTest ``` Promise is a simple one-shot awaitable condition. @@ -54,9 +54,9 @@ promiseConcurrentTest = do ``` ```ucm -.> add -.> io.test promiseSequentialTest -.> io.test promiseConcurrentTest +scratch/main> add +scratch/main> io.test promiseSequentialTest +scratch/main> io.test promiseConcurrentTest ``` CAS can be used to write an atomic update function. @@ -70,7 +70,7 @@ atomicUpdate ref f = ``` ```ucm -.> add +scratch/main> add ``` Promise can be used to write an operation that spawns N concurrent @@ -91,7 +91,7 @@ spawnN n fa = map Promise.read (go n []) ``` ```ucm -.> add +scratch/main> add ``` We can use these primitives to write a more interesting example, where @@ -123,6 +123,6 @@ fullTest = do ``` ```ucm -.> add -.> io.test fullTest +scratch/main> add +scratch/main> io.test fullTest ``` diff --git a/unison-src/transcripts-using-base/ref-promise.output.md b/unison-src/transcripts-using-base/ref-promise.output.md index 727f62e89e..448aaddd6a 100644 --- a/unison-src/transcripts-using-base/ref-promise.output.md +++ b/unison-src/transcripts-using-base/ref-promise.output.md @@ -32,13 +32,13 @@ casTest = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: casTest : '{IO} [Result] -.> io.test casTest +scratch/main> io.test casTest New test results: @@ -95,14 +95,14 @@ promiseConcurrentTest = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: promiseConcurrentTest : '{IO} [Result] promiseSequentialTest : '{IO} [Result] -.> io.test promiseSequentialTest +scratch/main> io.test promiseSequentialTest New test results: @@ -114,7 +114,7 @@ promiseConcurrentTest = do Tip: Use view promiseSequentialTest to view the source of a test. -.> io.test promiseConcurrentTest +scratch/main> io.test promiseConcurrentTest New test results: @@ -150,7 +150,7 @@ atomicUpdate ref f = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -189,7 +189,7 @@ spawnN n fa = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -238,13 +238,13 @@ fullTest = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: fullTest : '{IO} [Result] -.> io.test fullTest +scratch/main> io.test fullTest New test results: diff --git a/unison-src/transcripts-using-base/serial-test-00.md b/unison-src/transcripts-using-base/serial-test-00.md index ab71adfdd4..21860243e3 100644 --- a/unison-src/transcripts-using-base/serial-test-00.md +++ b/unison-src/transcripts-using-base/serial-test-00.md @@ -68,6 +68,6 @@ mkTestCase = do ``` ```ucm -.> add -.> run mkTestCase +scratch/main> add +scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-00.output.md b/unison-src/transcripts-using-base/serial-test-00.output.md index 715680f06b..88a18a7059 100644 --- a/unison-src/transcripts-using-base/serial-test-00.output.md +++ b/unison-src/transcripts-using-base/serial-test-00.output.md @@ -95,7 +95,7 @@ mkTestCase = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -115,7 +115,7 @@ mkTestCase = do tree2 : Tree Nat tree3 : Tree Text -.> run mkTestCase +scratch/main> run mkTestCase () diff --git a/unison-src/transcripts-using-base/serial-test-01.md b/unison-src/transcripts-using-base/serial-test-01.md index da25e8f4a4..bc5f84af0d 100644 --- a/unison-src/transcripts-using-base/serial-test-01.md +++ b/unison-src/transcripts-using-base/serial-test-01.md @@ -16,6 +16,6 @@ mkTestCase = do ``` ```ucm -.> add -.> run mkTestCase +scratch/main> add +scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-01.output.md b/unison-src/transcripts-using-base/serial-test-01.output.md index 9194621631..5825b36ff5 100644 --- a/unison-src/transcripts-using-base/serial-test-01.output.md +++ b/unison-src/transcripts-using-base/serial-test-01.output.md @@ -33,7 +33,7 @@ mkTestCase = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -43,7 +43,7 @@ mkTestCase = do l3 : [Char] mkTestCase : '{IO, Exception} () -.> run mkTestCase +scratch/main> run mkTestCase () diff --git a/unison-src/transcripts-using-base/serial-test-02.md b/unison-src/transcripts-using-base/serial-test-02.md index 3d13ee487b..15518165a0 100644 --- a/unison-src/transcripts-using-base/serial-test-02.md +++ b/unison-src/transcripts-using-base/serial-test-02.md @@ -30,6 +30,6 @@ mkTestCase = do ``` ```ucm -.> add -.> run mkTestCase +scratch/main> add +scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-02.output.md b/unison-src/transcripts-using-base/serial-test-02.output.md index a6957230e9..ecbe82ebee 100644 --- a/unison-src/transcripts-using-base/serial-test-02.output.md +++ b/unison-src/transcripts-using-base/serial-test-02.output.md @@ -49,7 +49,7 @@ mkTestCase = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -61,7 +61,7 @@ mkTestCase = do prod : [Nat] -> Nat products : ([Nat], [Nat], [Nat]) -> Text -.> run mkTestCase +scratch/main> run mkTestCase () diff --git a/unison-src/transcripts-using-base/serial-test-03.md b/unison-src/transcripts-using-base/serial-test-03.md index d1f49c4040..2e66f687d9 100644 --- a/unison-src/transcripts-using-base/serial-test-03.md +++ b/unison-src/transcripts-using-base/serial-test-03.md @@ -44,6 +44,6 @@ mkTestCase = do ``` ```ucm -.> add -.> run mkTestCase +scratch/main> add +scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-03.output.md b/unison-src/transcripts-using-base/serial-test-03.output.md index c161d048bd..f21afcbbb5 100644 --- a/unison-src/transcripts-using-base/serial-test-03.output.md +++ b/unison-src/transcripts-using-base/serial-test-03.output.md @@ -68,7 +68,7 @@ mkTestCase = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -84,7 +84,7 @@ mkTestCase = do reset : '{DC r} r -> r suspSum : [Nat] -> Delayed Nat -.> run mkTestCase +scratch/main> run mkTestCase () diff --git a/unison-src/transcripts-using-base/serial-test-04.md b/unison-src/transcripts-using-base/serial-test-04.md index f4763238f6..212b59c9e0 100644 --- a/unison-src/transcripts-using-base/serial-test-04.md +++ b/unison-src/transcripts-using-base/serial-test-04.md @@ -14,6 +14,6 @@ mkTestCase = do ``` ```ucm -.> add -.> run mkTestCase +scratch/main> add +scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-04.output.md b/unison-src/transcripts-using-base/serial-test-04.output.md index ca1949502d..044eabd264 100644 --- a/unison-src/transcripts-using-base/serial-test-04.output.md +++ b/unison-src/transcripts-using-base/serial-test-04.output.md @@ -28,7 +28,7 @@ mkTestCase = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -36,7 +36,7 @@ mkTestCase = do mutual0 : Nat -> Text mutual1 : Nat -> Text -.> run mkTestCase +scratch/main> run mkTestCase () diff --git a/unison-src/transcripts-using-base/stm.md b/unison-src/transcripts-using-base/stm.md index 0320353161..1a036fd260 100644 --- a/unison-src/transcripts-using-base/stm.md +++ b/unison-src/transcripts-using-base/stm.md @@ -28,7 +28,7 @@ body k out v = ``` ```ucm -.> add +scratch/main> add ``` Test case. @@ -67,6 +67,6 @@ tests = '(map spawn nats) ``` ```ucm -.> add -.> io.test tests +scratch/main> add +scratch/main> io.test tests ``` diff --git a/unison-src/transcripts-using-base/stm.output.md b/unison-src/transcripts-using-base/stm.output.md index a5d87ed520..b5510c9468 100644 --- a/unison-src/transcripts-using-base/stm.output.md +++ b/unison-src/transcripts-using-base/stm.output.md @@ -44,7 +44,7 @@ body k out v = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -106,7 +106,7 @@ tests = '(map spawn nats) ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -115,7 +115,7 @@ tests = '(map spawn nats) spawn : Nat ->{IO} Result tests : '{IO} [Result] -.> io.test tests +scratch/main> io.test tests New test results: diff --git a/unison-src/transcripts-using-base/test-watch-dependencies.md b/unison-src/transcripts-using-base/test-watch-dependencies.md index 8f3c610561..3e7558da3e 100644 --- a/unison-src/transcripts-using-base/test-watch-dependencies.md +++ b/unison-src/transcripts-using-base/test-watch-dependencies.md @@ -9,7 +9,7 @@ x = 999 ``` ```ucm:hide -.> add +scratch/main> add ``` Now, we update that definition and define a test-watch which depends on it. @@ -22,7 +22,7 @@ test> mytest = checks [x + 1 == 1001] We expect this 'add' to fail because the test is blocked by the update to `x`. ```ucm:error -.> add +scratch/main> add ``` --- @@ -35,5 +35,5 @@ test> useY = checks [y + 1 == 43] This should correctly identify `y` as a dependency and add that too. ```ucm -.> add useY +scratch/main> add useY ``` diff --git a/unison-src/transcripts-using-base/test-watch-dependencies.output.md b/unison-src/transcripts-using-base/test-watch-dependencies.output.md index 53835d0f6e..7b71b244be 100644 --- a/unison-src/transcripts-using-base/test-watch-dependencies.output.md +++ b/unison-src/transcripts-using-base/test-watch-dependencies.output.md @@ -43,7 +43,7 @@ test> mytest = checks [x + 1 == 1001] We expect this 'add' to fail because the test is blocked by the update to `x`. ```ucm -.> add +scratch/main> add x These definitions failed: @@ -85,7 +85,7 @@ test> useY = checks [y + 1 == 43] This should correctly identify `y` as a dependency and add that too. ```ucm -.> add useY +scratch/main> add useY ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/thread.md b/unison-src/transcripts-using-base/thread.md index d2c2712042..9811d192ce 100644 --- a/unison-src/transcripts-using-base/thread.md +++ b/unison-src/transcripts-using-base/thread.md @@ -19,8 +19,8 @@ testBasicFork = 'let See if we can get another thread to stuff a value into a MVar ```ucm:hide -.> add -.> io.test testBasicFork +scratch/main> add +scratch/main> io.test testBasicFork ``` ```unison @@ -48,8 +48,8 @@ testBasicMultiThreadMVar = 'let ``` ```ucm -.> add -.> io.test testBasicMultiThreadMVar +scratch/main> add +scratch/main> io.test testBasicMultiThreadMVar ``` ```unison @@ -91,6 +91,6 @@ testTwoThreads = 'let ``` ```ucm -.> add -.> io.test testTwoThreads +scratch/main> add +scratch/main> io.test testTwoThreads ``` diff --git a/unison-src/transcripts-using-base/thread.output.md b/unison-src/transcripts-using-base/thread.output.md index 76c28fa213..bec5dab529 100644 --- a/unison-src/transcripts-using-base/thread.output.md +++ b/unison-src/transcripts-using-base/thread.output.md @@ -71,14 +71,14 @@ testBasicMultiThreadMVar = 'let ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testBasicMultiThreadMVar : '{IO} [Result] thread1 : Nat -> MVar Nat -> '{IO} () -.> io.test testBasicMultiThreadMVar +scratch/main> io.test testBasicMultiThreadMVar New test results: @@ -145,7 +145,7 @@ testTwoThreads = 'let ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -154,7 +154,7 @@ testTwoThreads = 'let (also named thread1) testTwoThreads : '{IO} [Result] -.> io.test testTwoThreads +scratch/main> io.test testTwoThreads New test results: diff --git a/unison-src/transcripts-using-base/tls.md b/unison-src/transcripts-using-base/tls.md index 77c66db491..71b473837a 100644 --- a/unison-src/transcripts-using-base/tls.md +++ b/unison-src/transcripts-using-base/tls.md @@ -12,7 +12,7 @@ not_a_cert = "-----BEGIN SCHERMIFICATE-----\n-----END SCHERMIFICATE-----" ``` ```ucm:hide -.> add +scratch/main> add ``` # Using an alternative certificate store @@ -32,8 +32,8 @@ what_should_work _ = this_should_work ++ this_should_not_work ``` ```ucm -.> add -.> io.test what_should_work +scratch/main> add +scratch/main> io.test what_should_work ``` Test handshaking a client/server a local TCP connection using our @@ -191,8 +191,8 @@ testCNReject _ = ``` ```ucm -.> add -.> io.test testConnectSelfSigned -.> io.test testCAReject -.> io.test testCNReject +scratch/main> add +scratch/main> io.test testConnectSelfSigned +scratch/main> io.test testCAReject +scratch/main> io.test testCNReject ``` diff --git a/unison-src/transcripts-using-base/tls.output.md b/unison-src/transcripts-using-base/tls.output.md index 135f490186..739bb8fe4b 100644 --- a/unison-src/transcripts-using-base/tls.output.md +++ b/unison-src/transcripts-using-base/tls.output.md @@ -43,7 +43,7 @@ what_should_work _ = this_should_work ++ this_should_not_work ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -51,7 +51,7 @@ what_should_work _ = this_should_work ++ this_should_not_work this_should_work : [Result] what_should_work : ∀ _. _ -> [Result] -.> io.test what_should_work +scratch/main> io.test what_should_work New test results: @@ -238,7 +238,7 @@ testCNReject _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -251,7 +251,7 @@ testCNReject _ = -> '{IO, Exception} Text testConnectSelfSigned : '{IO} [Result] -.> io.test testConnectSelfSigned +scratch/main> io.test testConnectSelfSigned New test results: @@ -262,7 +262,7 @@ testCNReject _ = Tip: Use view testConnectSelfSigned to view the source of a test. -.> io.test testCAReject +scratch/main> io.test testCAReject New test results: @@ -272,7 +272,7 @@ testCNReject _ = Tip: Use view testCAReject to view the source of a test. -.> io.test testCNReject +scratch/main> io.test testCNReject New test results: diff --git a/unison-src/transcripts-using-base/utf8.md b/unison-src/transcripts-using-base/utf8.md index 107bd260cd..4bf0586575 100644 --- a/unison-src/transcripts-using-base/utf8.md +++ b/unison-src/transcripts-using-base/utf8.md @@ -3,7 +3,7 @@ Test for new Text -> Bytes conversions explicitly using UTF-8 as the encoding Unison has function for converting between `Text` and a UTF-8 `Bytes` encoding of the Text. ```ucm -.> find Utf8 +scratch/main> find Utf8 ``` ascii characters are encoded as single bytes (in the range 0-127). diff --git a/unison-src/transcripts-using-base/utf8.output.md b/unison-src/transcripts-using-base/utf8.output.md index 6bba05281a..c065222115 100644 --- a/unison-src/transcripts-using-base/utf8.output.md +++ b/unison-src/transcripts-using-base/utf8.output.md @@ -3,7 +3,7 @@ Test for new Text -> Bytes conversions explicitly using UTF-8 as the encoding Unison has function for converting between `Text` and a UTF-8 `Bytes` encoding of the Text. ```ucm -.> find Utf8 +scratch/main> find Utf8 1. builtin.Text.toUtf8 : Text -> Bytes 2. Text.fromUtf8 : Bytes ->{Exception} Text diff --git a/unison-src/transcripts/abilities.md b/unison-src/transcripts/abilities.md index 3bf6c47ec1..a45ee504dd 100644 --- a/unison-src/transcripts/abilities.md +++ b/unison-src/transcripts/abilities.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Some random ability stuff to ensure things work. @@ -23,5 +23,5 @@ ha = cases ``` ```ucm -.> add +scratch/main> add ``` diff --git a/unison-src/transcripts/abilities.output.md b/unison-src/transcripts/abilities.output.md index c90d76a45d..8fd69ddbc6 100644 --- a/unison-src/transcripts/abilities.output.md +++ b/unison-src/transcripts/abilities.output.md @@ -32,7 +32,7 @@ ha = cases ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/ability-order-doesnt-affect-hash.md b/unison-src/transcripts/ability-order-doesnt-affect-hash.md index 4a0606a4bd..2e00cc0c22 100644 --- a/unison-src/transcripts/ability-order-doesnt-affect-hash.md +++ b/unison-src/transcripts/ability-order-doesnt-affect-hash.md @@ -15,6 +15,6 @@ term2 _ = () ``` ```ucm -.> add -.> names term1 +scratch/main> add +scratch/main> names term1 ``` diff --git a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md index 879dc0c624..6f6eac30ed 100644 --- a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md +++ b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md @@ -31,7 +31,7 @@ term2 _ = () ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -40,7 +40,7 @@ term2 _ = () term1 : '{Bar, Foo} () term2 : '{Bar, Foo} () -.> names term1 +scratch/main> names term1 Term Hash: #8hum58rlih diff --git a/unison-src/transcripts/add-run.md b/unison-src/transcripts/add-run.md index 99ac7792e3..07fe99216d 100644 --- a/unison-src/transcripts/add-run.md +++ b/unison-src/transcripts/add-run.md @@ -3,7 +3,7 @@ ## Basic usage ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -20,26 +20,26 @@ is2even = '(even 2) it errors if there isn't a previous run ```ucm:error -.> add.run foo +scratch/main> add.run foo ``` ```ucm -.> run is2even +scratch/main> run is2even ``` it errors if the desired result name conflicts with a name in the unison file ```ucm:error -.> add.run is2even +scratch/main> add.run is2even ``` otherwise, the result is successfully persisted ```ucm -.> add.run foo.bar.baz +scratch/main> add.run foo.bar.baz ``` ```ucm -.> view foo.bar.baz +scratch/main> view foo.bar.baz ``` ## It resolves references within the unison file @@ -56,8 +56,8 @@ main _ = y ``` ```ucm -.> run main -.> add.run result +scratch/main> run main +scratch/main> add.run result ``` ## It resolves references within the codebase @@ -68,7 +68,7 @@ inc x = x + 1 ``` ```ucm -.> add inc +scratch/main> add inc ``` ```unison @@ -77,9 +77,9 @@ main _ x = inc x ``` ```ucm -.> run main -.> add.run natfoo -.> view natfoo +scratch/main> run main +scratch/main> add.run natfoo +scratch/main> view natfoo ``` ## It captures scratch file dependencies at run time @@ -91,7 +91,7 @@ main = 'y ``` ```ucm -.> run main +scratch/main> run main ``` @@ -101,8 +101,8 @@ x = 50 this saves 2 to xres, rather than 100 ```ucm -.> add.run xres -.> view xres +scratch/main> add.run xres +scratch/main> view xres ``` ## It fails with a message if add cannot complete cleanly @@ -112,8 +112,8 @@ main = '5 ``` ```ucm:error -.> run main -.> add.run xres +scratch/main> run main +scratch/main> add.run xres ``` ## It works with absolute names @@ -123,7 +123,7 @@ main = '5 ``` ```ucm -.> run main -.> add.run .an.absolute.name -.> view .an.absolute.name +scratch/main> run main +scratch/main> add.run .an.absolute.name +scratch/main> view .an.absolute.name ``` diff --git a/unison-src/transcripts/add-run.output.md b/unison-src/transcripts/add-run.output.md index 3d97788e78..8dd8846ae6 100644 --- a/unison-src/transcripts/add-run.output.md +++ b/unison-src/transcripts/add-run.output.md @@ -31,7 +31,7 @@ is2even = '(even 2) it errors if there isn't a previous run ```ucm -.> add.run foo +scratch/main> add.run foo ⚠️ @@ -40,7 +40,7 @@ it errors if there isn't a previous run ``` ```ucm -.> run is2even +scratch/main> run is2even true @@ -48,7 +48,7 @@ it errors if there isn't a previous run it errors if the desired result name conflicts with a name in the unison file ```ucm -.> add.run is2even +scratch/main> add.run is2even ⚠️ @@ -58,7 +58,7 @@ unison file ``` otherwise, the result is successfully persisted ```ucm -.> add.run foo.bar.baz +scratch/main> add.run foo.bar.baz ⍟ I've added these definitions: @@ -66,7 +66,7 @@ otherwise, the result is successfully persisted ``` ```ucm -.> view foo.bar.baz +scratch/main> view foo.bar.baz foo.bar.baz : Boolean foo.bar.baz = true @@ -101,11 +101,11 @@ main _ = y ``` ```ucm -.> run main +scratch/main> run main a b -> a Nat.+ b Nat.+ z 10 -.> add.run result +scratch/main> add.run result ⍟ I've added these definitions: @@ -134,7 +134,7 @@ inc x = x + 1 ``` ```ucm -.> add inc +scratch/main> add inc ⍟ I've added these definitions: @@ -160,17 +160,17 @@ main _ x = inc x ``` ```ucm -.> run main +scratch/main> run main inc -.> add.run natfoo +scratch/main> add.run natfoo ⍟ I've added these definitions: natfoo : Nat -> Nat -.> view natfoo +scratch/main> view natfoo natfoo : Nat -> Nat natfoo = inc @@ -200,7 +200,7 @@ main = 'y ``` ```ucm -.> run main +scratch/main> run main 2 @@ -224,13 +224,13 @@ x = 50 ``` this saves 2 to xres, rather than 100 ```ucm -.> add.run xres +scratch/main> add.run xres ⍟ I've added these definitions: xres : Nat -.> view xres +scratch/main> view xres xres : Nat xres = 2 @@ -256,11 +256,11 @@ main = '5 ``` ```ucm -.> run main +scratch/main> run main 5 -.> add.run xres +scratch/main> add.run xres x These definitions failed: @@ -290,19 +290,21 @@ main = '5 ``` ```ucm -.> run main +scratch/main> run main 5 -.> add.run .an.absolute.name +scratch/main> add.run .an.absolute.name ⍟ I've added these definitions: .an.absolute.name : Nat -.> view .an.absolute.name +scratch/main> view .an.absolute.name - .an.absolute.name : Nat - .an.absolute.name = 5 + .__projects._0fa2644c_1cf9_43bb_ab82_9f0beaab9ab1.branches._264fbcac_777c_4007_b589_01035cad230a.an.absolute.name : + Nat + .__projects._0fa2644c_1cf9_43bb_ab82_9f0beaab9ab1.branches._264fbcac_777c_4007_b589_01035cad230a.an.absolute.name = + 5 ``` diff --git a/unison-src/transcripts/add-test-watch-roundtrip.md b/unison-src/transcripts/add-test-watch-roundtrip.md index e8d070d2b1..9b1cacf477 100644 --- a/unison-src/transcripts/add-test-watch-roundtrip.md +++ b/unison-src/transcripts/add-test-watch-roundtrip.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -10,6 +10,6 @@ foo = [] Apparently when we add a test watch, we add a type annotation to it, even if it already has one. We don't want this to happen though! ```ucm -.> add -.> view foo +scratch/main> add +scratch/main> view foo ``` diff --git a/unison-src/transcripts/add-test-watch-roundtrip.output.md b/unison-src/transcripts/add-test-watch-roundtrip.output.md index 5c9389ca1f..114d9399fd 100644 --- a/unison-src/transcripts/add-test-watch-roundtrip.output.md +++ b/unison-src/transcripts/add-test-watch-roundtrip.output.md @@ -6,13 +6,13 @@ foo = [] Apparently when we add a test watch, we add a type annotation to it, even if it already has one. We don't want this to happen though! ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: foo : [Result] -.> view foo +scratch/main> view foo foo : [Result] foo : [Result] diff --git a/unison-src/transcripts/addupdatemessages.md b/unison-src/transcripts/addupdatemessages.md index c644d921a0..9c7daea43f 100644 --- a/unison-src/transcripts/addupdatemessages.md +++ b/unison-src/transcripts/addupdatemessages.md @@ -3,7 +3,7 @@ Let's set up some definitions to start: ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -17,7 +17,7 @@ structural type Y = Two Nat Nat Expected: `x` and `y`, `X`, and `Y` exist as above. UCM tells you this. ```ucm -.> add +scratch/main> add ``` Let's add an alias for `1` and `One`: @@ -32,7 +32,7 @@ Expected: `z` is now `1`. UCM tells you that this definition is also called `x`. Also, `Z` is an alias for `X`. ```ucm -.> add +scratch/main> add ``` Let's update something that has an alias (to a value that doesn't have a name already): @@ -45,7 +45,7 @@ structural type X = Three Nat Nat Nat Expected: `x` is now `3` and `X` has constructor `Three`. UCM tells you the old definitions were also called `z` and `Z` and these names have also been updated. ```ucm -.> update +scratch/main> update ``` Update it to something that already exists with a different name: @@ -58,6 +58,6 @@ structural type X = Two Nat Nat Expected: `x` is now `2` and `X` is `Two`. UCM says the old definition was also named `z/Z`, and was also updated. And it says the new definition is also named `y/Y`. ```ucm -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/addupdatemessages.output.md b/unison-src/transcripts/addupdatemessages.output.md index 44925f17c8..ffd7bbd804 100644 --- a/unison-src/transcripts/addupdatemessages.output.md +++ b/unison-src/transcripts/addupdatemessages.output.md @@ -29,7 +29,7 @@ structural type Y = Two Nat Nat Expected: `x` and `y`, `X`, and `Y` exist as above. UCM tells you this. ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -67,7 +67,7 @@ Expected: `z` is now `1`. UCM tells you that this definition is also called `x`. Also, `Z` is an alias for `X`. ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -104,7 +104,7 @@ structural type X = Three Nat Nat Nat Expected: `x` is now `3` and `X` has constructor `Three`. UCM tells you the old definitions were also called `z` and `Z` and these names have also been updated. ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -143,7 +143,7 @@ structural type X = Two Nat Nat Expected: `x` is now `2` and `X` is `Two`. UCM says the old definition was also named `z/Z`, and was also updated. And it says the new definition is also named `y/Y`. ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/alias-many.md b/unison-src/transcripts/alias-many.md index c682faf22b..8d9fb87dec 100644 --- a/unison-src/transcripts/alias-many.md +++ b/unison-src/transcripts/alias-many.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide:all List.adjacentPairs : [a] -> [(a, a)] @@ -102,7 +102,7 @@ The `alias.many` command can be used to copy definitions from the current namesp The names that will be used in the target namespace are the names you specify, relative to the current namespace: ``` -.> help alias.many +scratch/main> help alias.many alias.many (or copy) `alias.many [relative2...] ` creates aliases `relative1`, `relative2`, ... @@ -113,8 +113,8 @@ The names that will be used in the target namespace are the names you specify, r Let's try it! ```ucm -.> alias.many stuff.List.adjacentPairs stuff.List.all stuff.List.any stuff.List.chunk stuff.List.chunksOf stuff.List.dropWhile stuff.List.first stuff.List.init stuff.List.intersperse stuff.List.isEmpty stuff.List.last stuff.List.replicate stuff.List.splitAt stuff.List.tail stuff.List.takeWhile .mylib -.> find-in mylib +scratch/main> alias.many stuff.List.adjacentPairs stuff.List.all stuff.List.any stuff.List.chunk stuff.List.chunksOf stuff.List.dropWhile stuff.List.first stuff.List.init stuff.List.intersperse stuff.List.isEmpty stuff.List.last stuff.List.replicate stuff.List.splitAt stuff.List.tail stuff.List.takeWhile .mylib +scratch/main> find-in mylib ``` Thanks, `alias.many`! diff --git a/unison-src/transcripts/alias-many.output.md b/unison-src/transcripts/alias-many.output.md index 8236c60d04..a0b100000c 100644 --- a/unison-src/transcripts/alias-many.output.md +++ b/unison-src/transcripts/alias-many.output.md @@ -1,8 +1,8 @@ The `alias.many` command can be used to copy definitions from the current namespace into your curated one. The names that will be used in the target namespace are the names you specify, relative to the current namespace: -``` -.> help alias.many +```scratch +/main> help alias.many alias.many (or copy) `alias.many [relative2...] ` creates aliases `relative1`, `relative2`, ... @@ -14,56 +14,57 @@ The names that will be used in the target namespace are the names you specify, r Let's try it! ```ucm -.> alias.many stuff.List.adjacentPairs stuff.List.all stuff.List.any stuff.List.chunk stuff.List.chunksOf stuff.List.dropWhile stuff.List.first stuff.List.init stuff.List.intersperse stuff.List.isEmpty stuff.List.last stuff.List.replicate stuff.List.splitAt stuff.List.tail stuff.List.takeWhile .mylib +scratch/main> alias.many stuff.List.adjacentPairs stuff.List.all stuff.List.any stuff.List.chunk stuff.List.chunksOf stuff.List.dropWhile stuff.List.first stuff.List.init stuff.List.intersperse stuff.List.isEmpty stuff.List.last stuff.List.replicate stuff.List.splitAt stuff.List.tail stuff.List.takeWhile .mylib - Here's what changed in .mylib : - - Added definitions: - - 1. stuff.List.adjacentPairs : [a] -> [(a, a)] - 2. stuff.List.all : (a ->{g} Boolean) - -> [a] - ->{g} Boolean - 3. stuff.List.any : (a ->{g} Boolean) - -> [a] - ->{g} Boolean - 4. stuff.List.chunk : Nat -> [a] -> [[a]] - 5. stuff.List.chunksOf : Nat -> [a] -> [[a]] - 6. stuff.List.dropWhile : (a ->{g} Boolean) - -> [a] - ->{g} [a] - 7. stuff.List.first : [a] -> Optional a - 8. stuff.List.init : [a] -> Optional [a] - 9. stuff.List.intersperse : a -> [a] -> [a] - 10. stuff.List.isEmpty : [a] -> Boolean - 11. stuff.List.last : [a] -> Optional a - 12. stuff.List.replicate : Nat -> a -> [a] - 13. stuff.List.splitAt : Nat -> [a] -> ([a], [a]) - 14. stuff.List.tail : [a] -> Optional [a] - 15. stuff.List.takeWhile : (a ->{𝕖} Boolean) - -> [a] - ->{𝕖} [a] + Nothing changed in .mylib . + + ⚠️ - Tip: You can use `undo` or `reflog` to undo this change. + The following names were not found in the codebase. Check your spelling. + stuff.List.adjacentPairs + stuff.List.all + stuff.List.any + stuff.List.chunk + stuff.List.chunksOf + stuff.List.dropWhile + stuff.List.first + stuff.List.init + stuff.List.intersperse + stuff.List.isEmpty + stuff.List.last + stuff.List.replicate + stuff.List.splitAt + stuff.List.tail + stuff.List.takeWhile -.> find-in mylib +``` - 1. stuff.List.adjacentPairs : [a] -> [(a, a)] - 2. stuff.List.all : (a ->{g} Boolean) -> [a] ->{g} Boolean - 3. stuff.List.any : (a ->{g} Boolean) -> [a] ->{g} Boolean - 4. stuff.List.chunk : Nat -> [a] -> [[a]] - 5. stuff.List.chunksOf : Nat -> [a] -> [[a]] - 6. stuff.List.dropWhile : (a ->{g} Boolean) -> [a] ->{g} [a] - 7. stuff.List.first : [a] -> Optional a - 8. stuff.List.init : [a] -> Optional [a] - 9. stuff.List.intersperse : a -> [a] -> [a] - 10. stuff.List.isEmpty : [a] -> Boolean - 11. stuff.List.last : [a] -> Optional a - 12. stuff.List.replicate : Nat -> a -> [a] - 13. stuff.List.splitAt : Nat -> [a] -> ([a], [a]) - 14. stuff.List.tail : [a] -> Optional [a] - 15. stuff.List.takeWhile : (a ->{𝕖} Boolean) -> [a] ->{𝕖} [a] +```ucm +scratch/main> alias.many stuff.List.adjacentPairs stuff.List.all stuff.List.any stuff.List.chunk stuff.List.chunksOf stuff.List.dropWhile stuff.List.first stuff.List.init stuff.List.intersperse stuff.List.isEmpty stuff.List.last stuff.List.replicate stuff.List.splitAt stuff.List.tail stuff.List.takeWhile .mylibscratch/main> find-in mylib +``` + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + + + ⚠️ + The following names were not found in the codebase. Check your spelling. + stuff.List.adjacentPairs + stuff.List.all + stuff.List.any + stuff.List.chunk + stuff.List.chunksOf + stuff.List.dropWhile + stuff.List.first + stuff.List.init + stuff.List.intersperse + stuff.List.isEmpty + stuff.List.last + stuff.List.replicate + stuff.List.splitAt + stuff.List.tail + stuff.List.takeWhile -``` -Thanks, `alias.many! diff --git a/unison-src/transcripts/anf-tests.md b/unison-src/transcripts/anf-tests.md index 122a673060..2a15836eb2 100644 --- a/unison-src/transcripts/anf-tests.md +++ b/unison-src/transcripts/anf-tests.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This tests a variable related bug in the ANF compiler. @@ -29,6 +29,6 @@ foo _ = ``` ```ucm -.> add +scratch/main> add ``` diff --git a/unison-src/transcripts/anf-tests.output.md b/unison-src/transcripts/anf-tests.output.md index c200d1056f..b9360ee4c3 100644 --- a/unison-src/transcripts/anf-tests.output.md +++ b/unison-src/transcripts/anf-tests.output.md @@ -45,7 +45,7 @@ foo _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/any-extract.md b/unison-src/transcripts/any-extract.md index 5e9d09324e..e65b36606f 100644 --- a/unison-src/transcripts/any-extract.md +++ b/unison-src/transcripts/any-extract.md @@ -1,9 +1,9 @@ # Unit tests for Any.unsafeExtract ```ucm:hide -.> builtins.mergeio -.> load unison-src/transcripts-using-base/base.u -.> add +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts-using-base/base.u +scratch/main> add ``` Any.unsafeExtract is a way to extract the value contained in an Any. This is unsafe because it allows the programmer to coerce a value into any type, which would cause undefined behaviour if used to coerce a value to the wrong type. @@ -19,5 +19,5 @@ test> Any.unsafeExtract.works = ``` ```ucm -.> add +scratch/main> add ``` diff --git a/unison-src/transcripts/any-extract.output.md b/unison-src/transcripts/any-extract.output.md index 75567fb411..c8fc99095b 100644 --- a/unison-src/transcripts/any-extract.output.md +++ b/unison-src/transcripts/any-extract.output.md @@ -32,7 +32,7 @@ test> Any.unsafeExtract.works = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/api-doc-rendering.md b/unison-src/transcripts/api-doc-rendering.md index 6deffaaba8..1ab59a53d7 100644 --- a/unison-src/transcripts/api-doc-rendering.md +++ b/unison-src/transcripts/api-doc-rendering.md @@ -1,7 +1,7 @@ # Doc rendering ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -82,11 +82,11 @@ term = 42 ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> display term.doc +scratch/main> display term.doc ``` ```api diff --git a/unison-src/transcripts/api-doc-rendering.output.md b/unison-src/transcripts/api-doc-rendering.output.md index cac34211af..6c44614548 100644 --- a/unison-src/transcripts/api-doc-rendering.output.md +++ b/unison-src/transcripts/api-doc-rendering.output.md @@ -78,7 +78,7 @@ term = 42 ``` ```ucm -.> display term.doc +scratch/main> display term.doc # Heading @@ -149,795 +149,10 @@ term = 42 ```api GET /api/non-project-code/getDefinition?names=term { - "missingDefinitions": [], - "termDefinitions": { - "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { - "bestTermName": "term", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "42" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doc", - "#kjfaflbrgl89j2uq4ruubejakm6s02cp3m61ufu7rv7tkbd4nmkvcn1fciue53v0msir9t7ds111ab9er8qfa06gsa9ddfrdfgc99mo", - { - "contents": [ - { - "contents": [ - { - "contents": "Heading", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - [ - { - "contents": [ - { - "contents": [ - { - "contents": "Heading", - "tag": "Word" - }, - { - "contents": "2", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - [ - { - "contents": [ - { - "contents": "Term", - "tag": "Word" - }, - { - "contents": "Link:", - "tag": "Word" - }, - { - "contents": { - "contents": [ - { - "annotation": { - "contents": "#k5gpql9cbdfau6lf1aja24joc3sfctvjor8esu8bemn0in3l148otb0t3vebgqrt6qml302h62bbfeftg65gec1v8ouin5m6v2969d8", - "tag": "TermReference" - }, - "segment": "otherTerm" - } - ], - "tag": "Link" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Type", - "tag": "Word" - }, - { - "contents": "Link:", - "tag": "Word" - }, - { - "contents": { - "contents": [ - { - "annotation": { - "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", - "tag": "TypeReference" - }, - "segment": "Maybe" - } - ], - "tag": "Link" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Term", - "tag": "Word" - }, - { - "contents": "source:", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": [ - "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - { - "contents": [ - [ - { - "annotation": { - "contents": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "tag": "TermReference" - }, - "segment": "term" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": ": " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - [ - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "42" - } - ] - ], - "tag": "UserObject" - } - ], - "tag": "Term" - } - ], - "tag": "Source" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Term", - "tag": "Word" - }, - { - "contents": "signature:", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - [ - { - "annotation": { - "contents": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "tag": "TermReference" - }, - "segment": "term" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": ": " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ] - ], - "tag": "Signature" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": [ - { - "contents": "List", - "tag": "Word" - }, - { - "contents": "item", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ], - "tag": "BulletedList" - }, - { - "contents": [ - 1, - [ - { - "contents": [ - { - "contents": "Numbered", - "tag": "Word" - }, - { - "contents": "list", - "tag": "Word" - }, - { - "contents": "item", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "tag": "NumberedList" - }, - { - "contents": [ - { - "contents": ">", - "tag": "Word" - }, - { - "contents": "Block", - "tag": "Word" - }, - { - "contents": "quote", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Code", - "tag": "Word" - }, - { - "contents": "block", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Inline", - "tag": "Word" - }, - { - "contents": "code:", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "1" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat.+", - "tag": "TermReference" - }, - "segment": "Nat.+" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "2" - } - ], - "tag": "Example" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": "\"doesn't typecheck\" + 1", - "tag": "Word" - }, - "tag": "Code" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": [ - { - "contents": [ - { - "contents": "Link", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": { - "contents": "https://unison-lang.org", - "tag": "Word" - }, - "tag": "Group" - } - ], - "tag": "NamedLink" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png)", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": "Bold", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - "tag": "Bold" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": "Italic", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - "tag": "Bold" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": "Strikethrough", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - "tag": "Strikethrough" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Horizontal", - "tag": "Word" - }, - { - "contents": "rule", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "---", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Table", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Header", - "tag": "Word" - }, - { - "contents": "1", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Header", - "tag": "Word" - }, - { - "contents": "2", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "--------", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "--------", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Cell", - "tag": "Word" - }, - { - "contents": "1", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Cell", - "tag": "Word" - }, - { - "contents": "2", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Cell", - "tag": "Word" - }, - { - "contents": "3", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Cell", - "tag": "Word" - }, - { - "contents": "4", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Video", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - [ - { - "mediaSourceMimeType": null, - "mediaSourceUrl": "test.mp4" - } - ], - { - "poster": "test.png" - } - ], - "tag": "Video" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Transclusion/evaluation:", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": [ - { - "contents": [ - { - "contents": "This", - "tag": "Word" - }, - { - "contents": "doc", - "tag": "Word" - }, - { - "contents": "should", - "tag": "Word" - }, - { - "contents": "be", - "tag": "Word" - }, - { - "contents": "embedded.", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "message", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ], - "tag": "UntitledSection" - } - ], - "tag": "Paragraph" - } - ] - ], - "tag": "Section" - } - ] - ], - "tag": "Section" - } - ] - ], - "termNames": [ - "term" - ] - } - }, + "missingDefinitions": [ + "term" + ], + "termDefinitions": {}, "typeDefinitions": {} } ``` \ No newline at end of file diff --git a/unison-src/transcripts/api-find.md b/unison-src/transcripts/api-find.md index 201d3cad85..cf394bd6b6 100644 --- a/unison-src/transcripts/api-find.md +++ b/unison-src/transcripts/api-find.md @@ -8,7 +8,7 @@ joey.yaml.zz = 45 ``` ```ucm -.> add +scratch/main> add ``` ```api diff --git a/unison-src/transcripts/api-find.output.md b/unison-src/transcripts/api-find.output.md index 6505a1a320..d8e17c212d 100644 --- a/unison-src/transcripts/api-find.output.md +++ b/unison-src/transcripts/api-find.output.md @@ -24,7 +24,7 @@ joey.yaml.zz = 45 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -43,7 +43,7 @@ GET /api/non-project-code/find?query=http "result": { "segments": [ { - "contents": "ross.", + "contents": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.ross.", "tag": "Gap" }, { @@ -56,14 +56,14 @@ GET /api/non-project-code/find?query=http } ] }, - "score": 156 + "score": 170 }, { "contents": { "bestFoundTermName": "y", "namedTerm": { "termHash": "#emomp74i93h6ps0b5sukke0tci0ooba3f9jk21qm919a7act9u7asani84c0mqbdk4lcjrdvr9olpedp23p6df78r4trqlg0cciadc8", - "termName": "ross.httpClient.y", + "termName": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.ross.httpClient.y", "termTag": "Plain", "termType": [ { @@ -84,7 +84,7 @@ GET /api/non-project-code/find?query=http "result": { "segments": [ { - "contents": "joey.", + "contents": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.joey.", "tag": "Gap" }, { @@ -97,14 +97,14 @@ GET /api/non-project-code/find?query=http } ] }, - "score": 156 + "score": 170 }, { "contents": { "bestFoundTermName": "z", "namedTerm": { "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "joey.httpServer.z", + "termName": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.joey.httpServer.z", "termTag": "Plain", "termType": [ { @@ -129,7 +129,7 @@ GET /api/non-project-code/find?query=Server "result": { "segments": [ { - "contents": "joey.http", + "contents": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.joey.http", "tag": "Gap" }, { @@ -142,14 +142,14 @@ GET /api/non-project-code/find?query=Server } ] }, - "score": 223 + "score": 230 }, { "contents": { "bestFoundTermName": "z", "namedTerm": { "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "joey.httpServer.z", + "termName": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.joey.httpServer.z", "termTag": "Plain", "termType": [ { @@ -174,7 +174,7 @@ GET /api/non-project-code/find?query=lesys "result": { "segments": [ { - "contents": "rachel.fi", + "contents": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.rachel.fi", "tag": "Gap" }, { @@ -187,14 +187,14 @@ GET /api/non-project-code/find?query=lesys } ] }, - "score": 175 + "score": 185 }, { "contents": { "bestFoundTermName": "x", "namedTerm": { "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "termName": "rachel.filesystem.x", + "termName": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.rachel.filesystem.x", "termTag": "Plain", "termType": [ { @@ -218,6 +218,10 @@ GET /api/non-project-code/find?query=joey.http { "result": { "segments": [ + { + "contents": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.", + "tag": "Gap" + }, { "contents": "joey.http", "tag": "Match" @@ -228,14 +232,14 @@ GET /api/non-project-code/find?query=joey.http } ] }, - "score": 300 + "score": 333 }, { "contents": { "bestFoundTermName": "z", "namedTerm": { "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "joey.httpServer.z", + "termName": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.joey.httpServer.z", "termTag": "Plain", "termType": [ { diff --git a/unison-src/transcripts/api-list-projects-branches.md b/unison-src/transcripts/api-list-projects-branches.md index 111489cf97..872cca22a7 100644 --- a/unison-src/transcripts/api-list-projects-branches.md +++ b/unison-src/transcripts/api-list-projects-branches.md @@ -1,9 +1,9 @@ # List Projects And Branches Test ```ucm:hide -.> project.create-empty project-one -.> project.create-empty project-two -.> project.create-empty project-three +scratch/main> project.create-empty project-one +scratch/main> project.create-empty project-two +scratch/main> project.create-empty project-three project-one/main> branch branch-one project-one/main> branch branch-two project-one/main> branch branch-three diff --git a/unison-src/transcripts/api-list-projects-branches.output.md b/unison-src/transcripts/api-list-projects-branches.output.md index 1c12eea541..b3c09895da 100644 --- a/unison-src/transcripts/api-list-projects-branches.output.md +++ b/unison-src/transcripts/api-list-projects-branches.output.md @@ -12,6 +12,9 @@ GET /api/projects }, { "projectName": "project-two" + }, + { + "projectName": "scratch" } ] -- Should list projects starting with project-t diff --git a/unison-src/transcripts/api-namespace-details.md b/unison-src/transcripts/api-namespace-details.md index 0cfc7a8353..662d2e4db6 100644 --- a/unison-src/transcripts/api-namespace-details.md +++ b/unison-src/transcripts/api-namespace-details.md @@ -1,7 +1,7 @@ # Namespace Details Test ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison @@ -14,7 +14,7 @@ Here's a *README*! ``` ```ucm -.> add +scratch/main> add ``` ```api diff --git a/unison-src/transcripts/api-namespace-details.output.md b/unison-src/transcripts/api-namespace-details.output.md index 80d1d6ae0c..34f8303185 100644 --- a/unison-src/transcripts/api-namespace-details.output.md +++ b/unison-src/transcripts/api-namespace-details.output.md @@ -25,7 +25,7 @@ Here's a *README*! ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -39,43 +39,7 @@ Here's a *README*! GET /api/non-project-code/namespaces/nested.names { "fqn": "nested.names", - "hash": "#6tnmlu9knsce0u2991u6fvcmf4v44fdf0aiqtmnq7mjj0gi5sephg3lf12iv3odr5rc7vlgq75ciborrd3625c701bdmdomia2gcm3o", - "readme": { - "contents": [ - { - "contents": "Here's", - "tag": "Word" - }, - { - "contents": "a", - "tag": "Word" - }, - { - "contents": { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": "README", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - "tag": "Bold" - }, - { - "contents": "!", - "tag": "Word" - } - ], - "tag": "Join" - }, - "tag": "Group" - } - ], - "tag": "Paragraph" - } + "hash": "#sg60bvjo91fsoo7pkh9gejbn0qgc95vra87ap6l5d35ri0lkaudl7bs12d71sf3fh6p23teemuor7mk1i9n567m50ibakcghjec5ajg", + "readme": null } ``` \ No newline at end of file diff --git a/unison-src/transcripts/api-namespace-list.md b/unison-src/transcripts/api-namespace-list.md index 717607269a..1c07433e86 100644 --- a/unison-src/transcripts/api-namespace-list.md +++ b/unison-src/transcripts/api-namespace-list.md @@ -1,7 +1,7 @@ # Namespace list api ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison @@ -12,7 +12,7 @@ nested.names.readme = {{ I'm a readme! }} ``` ```ucm -.> add +scratch/main> add ``` ```api diff --git a/unison-src/transcripts/api-namespace-list.output.md b/unison-src/transcripts/api-namespace-list.output.md index 0ef32d1941..ddd7832ce2 100644 --- a/unison-src/transcripts/api-namespace-list.output.md +++ b/unison-src/transcripts/api-namespace-list.output.md @@ -23,7 +23,7 @@ nested.names.readme = {{ I'm a readme! }} ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -35,100 +35,14 @@ nested.names.readme = {{ I'm a readme! }} ```api GET /api/non-project-code/list?namespace=nested.names { - "namespaceListingChildren": [ - { - "contents": { - "termHash": "#ddmmatmmiqsts2ku0i02kntd0s7rvcui4nn1cusio8thp9oqhbtilvcnhen52ibv43kr5q83f5er5q9h56s807k17tnelnrac7cch8o", - "termName": "readme", - "termTag": "Doc", - "termType": [ - { - "annotation": { - "contents": "#ej86si0ur1", - "tag": "HashQualifier" - }, - "segment": "#ej86si0ur1" - } - ] - }, - "tag": "TermObject" - }, - { - "contents": { - "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "termName": "x", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - }, - "tag": "TermObject" - }, - { - "contents": { - "namespaceHash": "#n1egracfeljprftoktbjcase2hs4f4p8idbhs5ujipl42agld1810hrq9t7p7ped16aagni2cm1fjcjhho770jh80ipthhmg0cnsur0", - "namespaceName": "x", - "namespaceSize": 1 - }, - "tag": "Subnamespace" - } - ], + "namespaceListingChildren": [], "namespaceListingFQN": "nested.names", - "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" + "namespaceListingHash": "#sg60bvjo91fsoo7pkh9gejbn0qgc95vra87ap6l5d35ri0lkaudl7bs12d71sf3fh6p23teemuor7mk1i9n567m50ibakcghjec5ajg" } GET /api/non-project-code/list?namespace=names&relativeTo=nested { - "namespaceListingChildren": [ - { - "contents": { - "termHash": "#ddmmatmmiqsts2ku0i02kntd0s7rvcui4nn1cusio8thp9oqhbtilvcnhen52ibv43kr5q83f5er5q9h56s807k17tnelnrac7cch8o", - "termName": "readme", - "termTag": "Doc", - "termType": [ - { - "annotation": { - "contents": "#ej86si0ur1", - "tag": "HashQualifier" - }, - "segment": "#ej86si0ur1" - } - ] - }, - "tag": "TermObject" - }, - { - "contents": { - "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "termName": "x", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - }, - "tag": "TermObject" - }, - { - "contents": { - "namespaceHash": "#n1egracfeljprftoktbjcase2hs4f4p8idbhs5ujipl42agld1810hrq9t7p7ped16aagni2cm1fjcjhho770jh80ipthhmg0cnsur0", - "namespaceName": "x", - "namespaceSize": 1 - }, - "tag": "Subnamespace" - } - ], + "namespaceListingChildren": [], "namespaceListingFQN": "nested.names", - "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" + "namespaceListingHash": "#sg60bvjo91fsoo7pkh9gejbn0qgc95vra87ap6l5d35ri0lkaudl7bs12d71sf3fh6p23teemuor7mk1i9n567m50ibakcghjec5ajg" } ``` \ No newline at end of file diff --git a/unison-src/transcripts/api-summaries.md b/unison-src/transcripts/api-summaries.md index cf473e778a..8a7aa8b220 100644 --- a/unison-src/transcripts/api-summaries.md +++ b/unison-src/transcripts/api-summaries.md @@ -1,7 +1,7 @@ # Definition Summary APIs ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` @@ -25,9 +25,9 @@ structural ability Stream s where ``` ```ucm:hide -.> add -.> alias.type ##Nat Nat -.> alias.term ##IO.putBytes.impl.v3 putBytesImpl +scratch/main> add +scratch/main> alias.type ##Nat Nat +scratch/main> alias.term ##IO.putBytes.impl.v3 putBytesImpl ``` ## Term Summary APIs diff --git a/unison-src/transcripts/block-on-required-update.md b/unison-src/transcripts/block-on-required-update.md index 1027188b06..3b339e6fe7 100644 --- a/unison-src/transcripts/block-on-required-update.md +++ b/unison-src/transcripts/block-on-required-update.md @@ -3,7 +3,7 @@ Should block an `add` if it requires an update on an in-file dependency. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,7 +11,7 @@ x = 1 ``` ```ucm -.> add +scratch/main> add ``` Update `x`, and add a new `y` which depends on the update @@ -24,5 +24,5 @@ y = x + 1 Try to add only the new `y`. This should fail because it requires an update to `x`, but we only ran an 'add'. ```ucm:error -.> add y +scratch/main> add y ``` diff --git a/unison-src/transcripts/block-on-required-update.output.md b/unison-src/transcripts/block-on-required-update.output.md index 254a281e87..0935b7317a 100644 --- a/unison-src/transcripts/block-on-required-update.output.md +++ b/unison-src/transcripts/block-on-required-update.output.md @@ -20,7 +20,7 @@ x = 1 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -55,7 +55,7 @@ y = x + 1 Try to add only the new `y`. This should fail because it requires an update to `x`, but we only ran an 'add'. ```ucm -.> add y +scratch/main> add y x These definitions failed: diff --git a/unison-src/transcripts/blocks.md b/unison-src/transcripts/blocks.md index bac7ef1874..b89ab45850 100644 --- a/unison-src/transcripts/blocks.md +++ b/unison-src/transcripts/blocks.md @@ -1,7 +1,7 @@ ## Blocks and scoping ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ### Names introduced by a block shadow names introduced in outer scopes diff --git a/unison-src/transcripts/boolean-op-pretty-print-2819.md b/unison-src/transcripts/boolean-op-pretty-print-2819.md index efdf493e9f..b788c78334 100644 --- a/unison-src/transcripts/boolean-op-pretty-print-2819.md +++ b/unison-src/transcripts/boolean-op-pretty-print-2819.md @@ -1,7 +1,7 @@ Regression test for https://github.com/unisonweb/unison/pull/2819 ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -12,7 +12,7 @@ hangExample = ``` ```ucm -.> add -.> view hangExample +scratch/main> add +scratch/main> view hangExample ``` diff --git a/unison-src/transcripts/boolean-op-pretty-print-2819.output.md b/unison-src/transcripts/boolean-op-pretty-print-2819.output.md index 690b9fdc6b..48fbfecf68 100644 --- a/unison-src/transcripts/boolean-op-pretty-print-2819.output.md +++ b/unison-src/transcripts/boolean-op-pretty-print-2819.output.md @@ -21,13 +21,13 @@ hangExample = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: hangExample : Boolean -.> view hangExample +scratch/main> view hangExample hangExample : Boolean hangExample = diff --git a/unison-src/transcripts/branch-command.md b/unison-src/transcripts/branch-command.md index 4b1636be41..f39b2a071a 100644 --- a/unison-src/transcripts/branch-command.md +++ b/unison-src/transcripts/branch-command.md @@ -1,8 +1,8 @@ The `branch` command creates a new branch. ```ucm:hide -.> project.create-empty foo -.> project.create-empty bar +scratch/main> project.create-empty foo +scratch/main> project.create-empty bar ``` First, we'll just create a loose code namespace with a term in it for later. @@ -33,22 +33,22 @@ foo/main> branch /main /topic8 foo/main> branch /main foo/topic9 foo/main> branch foo/main topic10 foo/main> branch foo/main /topic11 -.> branch foo/main foo/topic12 +scratch/main> branch foo/main foo/topic12 foo/main> branch bar/topic bar/main> branch foo/main topic2 bar/main> branch foo/main /topic3 -.> branch foo/main bar/topic4 +scratch/main> branch foo/main bar/topic4 .some.loose.code> branch foo/topic13 foo/main> branch .some.loose.code topic14 foo/main> branch .some.loose.code /topic15 -.> branch .some.loose.code foo/topic16 +scratch/main> branch .some.loose.code foo/topic16 foo/main> branch.empty empty1 foo/main> branch.empty /empty2 foo/main> branch.empty foo/empty3 -.> branch.empty foo/empty4 +scratch/main> branch.empty foo/empty4 ``` The `branch` command can create branches named `releases/drafts/*` (because why not). diff --git a/unison-src/transcripts/branch-command.output.md b/unison-src/transcripts/branch-command.output.md index c074134bbb..2edb91bb9b 100644 --- a/unison-src/transcripts/branch-command.output.md +++ b/unison-src/transcripts/branch-command.output.md @@ -103,7 +103,7 @@ foo/main> branch foo/main /topic11 Tip: To merge your work back into the main branch, first `switch /main` then `merge /topic11`. -.> branch foo/main foo/topic12 +scratch/main> branch foo/main foo/topic12 Done. I've created the topic12 branch based off of main. @@ -122,7 +122,7 @@ bar/main> branch foo/main /topic3 Done. I've created the bar/topic3 branch based off foo/main. -.> branch foo/main bar/topic4 +scratch/main> branch foo/main bar/topic4 Done. I've created the bar/topic4 branch based off foo/main. @@ -141,7 +141,7 @@ foo/main> branch .some.loose.code /topic15 Done. I've created the foo/topic15 branch from the namespace .some.loose.code. -.> branch .some.loose.code foo/topic16 +scratch/main> branch .some.loose.code foo/topic16 Done. I've created the foo/topic16 branch from the namespace .some.loose.code. @@ -164,7 +164,7 @@ foo/main> branch.empty foo/empty3 Tip: Use `merge /somebranch` to initialize this branch. -.> branch.empty foo/empty4 +scratch/main> branch.empty foo/empty4 Done. I've created an empty branch foo/empty4. diff --git a/unison-src/transcripts/branch-relative-path.md b/unison-src/transcripts/branch-relative-path.md index 8414db2f16..74298f4b2b 100644 --- a/unison-src/transcripts/branch-relative-path.md +++ b/unison-src/transcripts/branch-relative-path.md @@ -1,7 +1,7 @@ ```ucm:hide -.> builtins.merge -.> project.create-empty p0 -.> project.create-empty p1 +scratch/main> builtins.merge +scratch/main> project.create-empty p0 +scratch/main> project.create-empty p1 ``` ```unison diff --git a/unison-src/transcripts/bug-fix-4354.md b/unison-src/transcripts/bug-fix-4354.md index c1d603258d..1ea7f595dd 100644 --- a/unison-src/transcripts/bug-fix-4354.md +++ b/unison-src/transcripts/bug-fix-4354.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/bug-strange-closure.md b/unison-src/transcripts/bug-strange-closure.md index f2f805d682..bfce3c1422 100644 --- a/unison-src/transcripts/bug-strange-closure.md +++ b/unison-src/transcripts/bug-strange-closure.md @@ -1,15 +1,15 @@ ```ucm:hide -.> builtins.mergeio -.> load unison-src/transcripts-using-base/doc.md.files/syntax.u +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts-using-base/doc.md.files/syntax.u ``` We can display the guide before and after adding it to the codebase: ```ucm -.> display doc.guide -.> add -.> display doc.guide +scratch/main> display doc.guide +scratch/main> add +scratch/main> display doc.guide ``` But we can't display this due to a decompilation problem. @@ -19,10 +19,10 @@ rendered = Pretty.get (docFormatConsole doc.guide) ``` ```ucm -.> display rendered -.> add -.> display rendered -.> undo +scratch/main> display rendered +scratch/main> add +scratch/main> display rendered +scratch/main> undo ``` And then this sometimes generates a GHC crash "strange closure error" but doesn't seem deterministic. diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md index 8b9f7fa75c..3d70740281 100644 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ b/unison-src/transcripts/bug-strange-closure.output.md @@ -2,7 +2,7 @@ We can display the guide before and after adding it to the codebase: ```ucm -.> display doc.guide +scratch/main> display doc.guide # Unison computable documentation @@ -200,7 +200,7 @@ We can display the guide before and after adding it to the codebase: rendered table. Some text More text Zounds! -.> add +scratch/main> add ⍟ I've added these definitions: @@ -213,7 +213,7 @@ We can display the guide before and after adding it to the codebase: otherElements : Doc2 sqr : Nat -> Nat -.> display doc.guide +scratch/main> display doc.guide # Unison computable documentation @@ -432,7 +432,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) ``` ```ucm -.> display rendered +scratch/main> display rendered # Unison computable documentation @@ -630,13 +630,13 @@ rendered = Pretty.get (docFormatConsole doc.guide) rendered table. Some text More text Zounds! -.> add +scratch/main> add ⍟ I've added these definitions: rendered : Annotated () (Either SpecialForm ConsoleText) -.> display rendered +scratch/main> display rendered # Unison computable documentation @@ -834,13 +834,17 @@ rendered = Pretty.get (docFormatConsole doc.guide) rendered table. Some text More text Zounds! -.> undo +scratch/main> undo Here are the changes I undid Added definitions: - 1. rendered : Annotated () (Either SpecialForm ConsoleText) + 1. __projects._141465a8_cfb4_456f_aefa_25b7a6062af2.branches._d233d31d_8101_4a8e_b332_9cd3a64f71e9.rendered : Annotated + ( ) + (Either + SpecialForm + ConsoleText) ``` And then this sometimes generates a GHC crash "strange closure error" but doesn't seem deterministic. diff --git a/unison-src/transcripts/builtins.md b/unison-src/transcripts/builtins.md index ab854be39d..6834b85eb1 100644 --- a/unison-src/transcripts/builtins.md +++ b/unison-src/transcripts/builtins.md @@ -1,12 +1,12 @@ # Unit tests for builtin functions ```ucm:hide -.> builtins.mergeio -.> load unison-src/transcripts-using-base/base.u -.> add +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts-using-base/base.u +scratch/main> add ``` -This transcript defines unit tests for builtin functions. There's a single `.> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. +This transcript defines unit tests for builtin functions. There's a single `scratch/main> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. ## `Int` functions @@ -88,7 +88,7 @@ test> Int.tests.conversions = ``` ```ucm:hide -.> add +scratch/main> add ``` ## `Nat` functions @@ -163,7 +163,7 @@ test> Nat.tests.conversions = ``` ```ucm:hide -.> add +scratch/main> add ``` ## `Boolean` functions @@ -190,7 +190,7 @@ test> Boolean.tests.notTable = ``` ```ucm:hide -.> add +scratch/main> add ``` ## `Text` functions @@ -288,7 +288,7 @@ test> Text.tests.indexOfEmoji = ``` ```ucm:hide -.> add +scratch/main> add ``` ## `Bytes` functions @@ -352,7 +352,7 @@ test> Bytes.tests.indexOf = ``` ```ucm:hide -.> add +scratch/main> add ``` ## `List` comparison @@ -371,7 +371,7 @@ test> checks [ ``` ```ucm:hide -.> add +scratch/main> add ``` Other list functions @@ -392,7 +392,7 @@ test> Any.test2 = checks [(not (Any "hi" == Any 42))] ``` ```ucm:hide -.> add +scratch/main> add ``` ## Sandboxing functions @@ -419,7 +419,7 @@ openFile] ``` ```ucm:hide -.> add +scratch/main> add ``` ```unison @@ -436,8 +436,8 @@ openFilesIO = do ``` ```ucm -.> add -.> io.test openFilesIO +scratch/main> add +scratch/main> io.test openFilesIO ``` ## Universal hash functions @@ -450,7 +450,7 @@ test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Unive ``` ```ucm:hide -.> add +scratch/main> add ``` ## Run the tests @@ -458,5 +458,5 @@ test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Unive Now that all the tests have been added to the codebase, let's view the test report. This will fail the transcript (with a nice message) if any of the tests are failing. ```ucm -.> test +scratch/main> test ``` diff --git a/unison-src/transcripts/builtins.output.md b/unison-src/transcripts/builtins.output.md index 4d3089d35e..5c00c49899 100644 --- a/unison-src/transcripts/builtins.output.md +++ b/unison-src/transcripts/builtins.output.md @@ -1,6 +1,6 @@ # Unit tests for builtin functions -This transcript defines unit tests for builtin functions. There's a single `.> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. +This transcript defines unit tests for builtin functions. There's a single `scratch/main> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. ## `Int` functions @@ -480,13 +480,13 @@ openFilesIO = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: openFilesIO : '{IO} [Result] -.> io.test openFilesIO +scratch/main> io.test openFilesIO New test results: @@ -535,7 +535,7 @@ test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Unive Now that all the tests have been added to the codebase, let's view the test report. This will fail the transcript (with a nice message) if any of the tests are failing. ```ucm -.> test +scratch/main> test Cached test results (`help testcache` to learn more) diff --git a/unison-src/transcripts/bytesFromList.md b/unison-src/transcripts/bytesFromList.md index 9da15329f3..1abb998791 100644 --- a/unison-src/transcripts/bytesFromList.md +++ b/unison-src/transcripts/bytesFromList.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This should render as `Bytes.fromList [1,2,3,4]`, not `##Bytes.fromSequence [1,2,3,4]`: diff --git a/unison-src/transcripts/check763.md b/unison-src/transcripts/check763.md index 3bb162b344..8b32045144 100644 --- a/unison-src/transcripts/check763.md +++ b/unison-src/transcripts/check763.md @@ -1,7 +1,7 @@ Regression test for https://github.com/unisonweb/unison/issues/763 ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -10,8 +10,8 @@ Regression test for https://github.com/unisonweb/unison/issues/763 ``` ```ucm -.> add -.> move.term +-+ boppitybeep -.> move.term boppitybeep +-+ +scratch/main> add +scratch/main> move.term +-+ boppitybeep +scratch/main> move.term boppitybeep +-+ ``` diff --git a/unison-src/transcripts/check763.output.md b/unison-src/transcripts/check763.output.md index b8421509d9..fe50b6834d 100644 --- a/unison-src/transcripts/check763.output.md +++ b/unison-src/transcripts/check763.output.md @@ -19,17 +19,17 @@ Regression test for https://github.com/unisonweb/unison/issues/763 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: +-+ : Nat -> Nat -> Nat -.> move.term +-+ boppitybeep +scratch/main> move.term +-+ boppitybeep Done. -.> move.term boppitybeep +-+ +scratch/main> move.term boppitybeep +-+ Done. diff --git a/unison-src/transcripts/check873.md b/unison-src/transcripts/check873.md index 7145186286..b70937821d 100644 --- a/unison-src/transcripts/check873.md +++ b/unison-src/transcripts/check873.md @@ -1,7 +1,7 @@ See [this ticket](https://github.com/unisonweb/unison/issues/873); the point being, this shouldn't crash the runtime. :) ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -9,7 +9,7 @@ See [this ticket](https://github.com/unisonweb/unison/issues/873); the point bei ``` ```ucm -.> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts/check873.output.md b/unison-src/transcripts/check873.output.md index 289c592f30..5f21cec202 100644 --- a/unison-src/transcripts/check873.output.md +++ b/unison-src/transcripts/check873.output.md @@ -18,7 +18,7 @@ See [this ticket](https://github.com/unisonweb/unison/issues/873); the point bei ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/child-namespace-history-merge.md b/unison-src/transcripts/child-namespace-history-merge.md index 6ed0e2400e..1b80748062 100644 --- a/unison-src/transcripts/child-namespace-history-merge.md +++ b/unison-src/transcripts/child-namespace-history-merge.md @@ -9,7 +9,7 @@ but I think we should at least notice if we change things by accident. ## Setting up some history ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -20,8 +20,8 @@ parent.child.thing = "parent.child.thing" The child branch has a single history node representing the addition of `parent.child.thing`. ```ucm -.> add -.> history parent.child +scratch/main> add +scratch/main> history parent.child ``` If we add another thing to the child namespace it should add another history node to both the child and parent. @@ -31,9 +31,9 @@ parent.child.thing2 = "parent.child.thing2" ``` ```ucm -.> add -.> history parent -.> history parent.child +scratch/main> add +scratch/main> history parent +scratch/main> history parent.child ``` ## Forking off some history on a separate branch @@ -41,7 +41,7 @@ parent.child.thing2 = "parent.child.thing2" Now we fork the parent namespace to make some changes. ```ucm -.> fork parent parent_fork +scratch/main> fork parent parent_fork ``` ```unison:hide @@ -51,8 +51,8 @@ parent_fork.child.thing3 = "parent_fork.child.thing3" The child should have a new history node after adding `thing3` ```ucm -.> add -.> history parent_fork.child +scratch/main> add +scratch/main> history parent_fork.child ``` ## Saving our parent state @@ -60,8 +60,8 @@ The child should have a new history node after adding `thing3` Split off two separate forks, one for testing squash merges, one for standard merges. ```ucm:hide -.> fork parent parent_squash_base -.> fork parent parent_merge_base +scratch/main> fork parent parent_squash_base +scratch/main> fork parent parent_merge_base ``` ## Squash merge @@ -69,16 +69,16 @@ Split off two separate forks, one for testing squash merges, one for standard me For a squash merge, when I squash-merge back into parent, we expect `parent_fork.child.thing3` to be added. ```ucm -.> merge.old.squash parent_fork parent_squash_base -.> history parent_squash_base +scratch/main> merge.old.squash parent_fork parent_squash_base +scratch/main> history parent_squash_base ``` Notice that with the current behaviour, the history of `parent.child` is completely wiped out, containing nothing from the source OR destination. ```ucm -.> history parent.child -.> history parent_fork.child -.> history parent_squash_base.child +scratch/main> history parent.child +scratch/main> history parent_fork.child +scratch/main> history parent_squash_base.child ``` ## Standard merge @@ -86,14 +86,14 @@ Notice that with the current behaviour, the history of `parent.child` is complet For a standard merge, if I merge back into parent, we expect `parent_fork.child.thing3` to be added. ```ucm -.> merge.old parent_fork parent_merge_base -.> history parent_merge_base +scratch/main> merge.old parent_fork parent_merge_base +scratch/main> history parent_merge_base ``` Child histories should also be *merged*. ```ucm -.> history parent.child -.> history parent_fork.child -.> history parent_merge_base.child +scratch/main> history parent.child +scratch/main> history parent_fork.child +scratch/main> history parent_merge_base.child ``` diff --git a/unison-src/transcripts/child-namespace-history-merge.output.md b/unison-src/transcripts/child-namespace-history-merge.output.md index 18e080e093..8a8b69d1ab 100644 --- a/unison-src/transcripts/child-namespace-history-merge.output.md +++ b/unison-src/transcripts/child-namespace-history-merge.output.md @@ -16,14 +16,14 @@ parent.child.thing = "parent.child.thing" The child branch has a single history node representing the addition of `parent.child.thing`. ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: parent.child.thing : Text parent.top : Text -.> history parent.child +scratch/main> history parent.child Note: The most recent namespace hash is immediately below this message. @@ -40,13 +40,13 @@ parent.child.thing2 = "parent.child.thing2" ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: parent.child.thing2 : Text -.> history parent +scratch/main> history parent Note: The most recent namespace hash is immediately below this message. @@ -59,7 +59,7 @@ parent.child.thing2 = "parent.child.thing2" □ 2. #i9lji1bli0 (start of history) -.> history parent.child +scratch/main> history parent.child Note: The most recent namespace hash is immediately below this message. @@ -78,7 +78,7 @@ parent.child.thing2 = "parent.child.thing2" Now we fork the parent namespace to make some changes. ```ucm -.> fork parent parent_fork +scratch/main> fork parent parent_fork Done. @@ -90,13 +90,13 @@ parent_fork.child.thing3 = "parent_fork.child.thing3" The child should have a new history node after adding `thing3` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: parent_fork.child.thing3 : Text -.> history parent_fork.child +scratch/main> history parent_fork.child Note: The most recent namespace hash is immediately below this message. @@ -125,7 +125,7 @@ Split off two separate forks, one for testing squash merges, one for standard me For a squash merge, when I squash-merge back into parent, we expect `parent_fork.child.thing3` to be added. ```ucm -.> merge.old.squash parent_fork parent_squash_base +scratch/main> merge.old.squash parent_fork parent_squash_base Here's what's changed in parent_squash_base after the merge: @@ -140,7 +140,7 @@ For a squash merge, when I squash-merge back into parent, we expect `parent_fork Applying changes from patch... -.> history parent_squash_base +scratch/main> history parent_squash_base Note: The most recent namespace hash is immediately below this message. @@ -163,7 +163,7 @@ For a squash merge, when I squash-merge back into parent, we expect `parent_fork Notice that with the current behaviour, the history of `parent.child` is completely wiped out, containing nothing from the source OR destination. ```ucm -.> history parent.child +scratch/main> history parent.child Note: The most recent namespace hash is immediately below this message. @@ -176,7 +176,7 @@ Notice that with the current behaviour, the history of `parent.child` is complet □ 2. #0r73mam57g (start of history) -.> history parent_fork.child +scratch/main> history parent_fork.child Note: The most recent namespace hash is immediately below this message. @@ -195,7 +195,7 @@ Notice that with the current behaviour, the history of `parent.child` is complet □ 3. #0r73mam57g (start of history) -.> history parent_squash_base.child +scratch/main> history parent_squash_base.child Note: The most recent namespace hash is immediately below this message. @@ -210,7 +210,7 @@ Notice that with the current behaviour, the history of `parent.child` is complet For a standard merge, if I merge back into parent, we expect `parent_fork.child.thing3` to be added. ```ucm -.> merge.old parent_fork parent_merge_base +scratch/main> merge.old parent_fork parent_merge_base Here's what's changed in parent_merge_base after the merge: @@ -225,7 +225,7 @@ For a standard merge, if I merge back into parent, we expect `parent_fork.child. Applying changes from patch... -.> history parent_merge_base +scratch/main> history parent_merge_base Note: The most recent namespace hash is immediately below this message. @@ -248,7 +248,7 @@ For a standard merge, if I merge back into parent, we expect `parent_fork.child. Child histories should also be *merged*. ```ucm -.> history parent.child +scratch/main> history parent.child Note: The most recent namespace hash is immediately below this message. @@ -261,7 +261,7 @@ Child histories should also be *merged*. □ 2. #0r73mam57g (start of history) -.> history parent_fork.child +scratch/main> history parent_fork.child Note: The most recent namespace hash is immediately below this message. @@ -280,7 +280,7 @@ Child histories should also be *merged*. □ 3. #0r73mam57g (start of history) -.> history parent_merge_base.child +scratch/main> history parent_merge_base.child Note: The most recent namespace hash is immediately below this message. diff --git a/unison-src/transcripts/constructor-applied-to-unit.md b/unison-src/transcripts/constructor-applied-to-unit.md index df1341aa5c..fc598a883f 100644 --- a/unison-src/transcripts/constructor-applied-to-unit.md +++ b/unison-src/transcripts/constructor-applied-to-unit.md @@ -1,6 +1,6 @@ ```ucm:hide -.> alias.type ##Nat Nat -.> alias.term ##Any.Any Any +scratch/main> alias.type ##Nat Nat +scratch/main> alias.term ##Any.Any Any ``` ```unison diff --git a/unison-src/transcripts/contrabilities.md b/unison-src/transcripts/contrabilities.md index 795ec15566..5d1fdcb647 100644 --- a/unison-src/transcripts/contrabilities.md +++ b/unison-src/transcripts/contrabilities.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/create-author.md b/unison-src/transcripts/create-author.md index d9a39c735f..18f0ccac2e 100644 --- a/unison-src/transcripts/create-author.md +++ b/unison-src/transcripts/create-author.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` Demonstrating `create.author`: diff --git a/unison-src/transcripts/cycle-update-1.md b/unison-src/transcripts/cycle-update-1.md index 5294f2e49b..b60bc763e4 100644 --- a/unison-src/transcripts/cycle-update-1.md +++ b/unison-src/transcripts/cycle-update-1.md @@ -1,7 +1,7 @@ Update a member of a cycle, but retain the cycle. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -13,7 +13,7 @@ pong _ = !ping + 2 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -22,6 +22,6 @@ ping _ = !pong + 3 ``` ```ucm -.> update -.> view ping pong +scratch/main> update +scratch/main> view ping pong ``` diff --git a/unison-src/transcripts/cycle-update-1.output.md b/unison-src/transcripts/cycle-update-1.output.md index 3906248333..267bcc9396 100644 --- a/unison-src/transcripts/cycle-update-1.output.md +++ b/unison-src/transcripts/cycle-update-1.output.md @@ -23,7 +23,7 @@ pong _ = !ping + 2 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -51,7 +51,7 @@ ping _ = !pong + 3 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -62,7 +62,7 @@ ping _ = !pong + 3 Done. -.> view ping pong +scratch/main> view ping pong ping : 'Nat ping _ = diff --git a/unison-src/transcripts/cycle-update-2.md b/unison-src/transcripts/cycle-update-2.md index bd8c6edc13..0feb63afc2 100644 --- a/unison-src/transcripts/cycle-update-2.md +++ b/unison-src/transcripts/cycle-update-2.md @@ -1,7 +1,7 @@ Update a member of a cycle with a type-preserving update, but sever the cycle. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -13,7 +13,7 @@ pong _ = !ping + 2 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -22,6 +22,6 @@ ping _ = 3 ``` ```ucm -.> update -.> view ping pong +scratch/main> update +scratch/main> view ping pong ``` diff --git a/unison-src/transcripts/cycle-update-2.output.md b/unison-src/transcripts/cycle-update-2.output.md index 6884788130..36243e1709 100644 --- a/unison-src/transcripts/cycle-update-2.output.md +++ b/unison-src/transcripts/cycle-update-2.output.md @@ -23,7 +23,7 @@ pong _ = !ping + 2 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -51,7 +51,7 @@ ping _ = 3 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -62,7 +62,7 @@ ping _ = 3 Done. -.> view ping pong +scratch/main> view ping pong ping : 'Nat ping _ = 3 diff --git a/unison-src/transcripts/cycle-update-3.md b/unison-src/transcripts/cycle-update-3.md index dfcd87305e..b5e1e05551 100644 --- a/unison-src/transcripts/cycle-update-3.md +++ b/unison-src/transcripts/cycle-update-3.md @@ -1,7 +1,7 @@ Update a member of a cycle with a type-changing update, thus severing the cycle. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -13,7 +13,7 @@ pong _ = !ping + 2 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -22,6 +22,6 @@ ping = 3 ``` ```ucm -.> update.old -.> view ping pong +scratch/main> update.old +scratch/main> view ping pong ``` diff --git a/unison-src/transcripts/cycle-update-3.output.md b/unison-src/transcripts/cycle-update-3.output.md index 7a0a499dbc..8609b8b69c 100644 --- a/unison-src/transcripts/cycle-update-3.output.md +++ b/unison-src/transcripts/cycle-update-3.output.md @@ -23,7 +23,7 @@ pong _ = !ping + 2 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -51,13 +51,13 @@ ping = 3 ``` ```ucm -.> update.old +scratch/main> update.old ⍟ I've updated these names to your new definition: ping : Nat -.> view ping pong +scratch/main> view ping pong ping : Nat ping = 3 diff --git a/unison-src/transcripts/cycle-update-4.md b/unison-src/transcripts/cycle-update-4.md index d2bf98f690..ae389489b9 100644 --- a/unison-src/transcripts/cycle-update-4.md +++ b/unison-src/transcripts/cycle-update-4.md @@ -1,7 +1,7 @@ `update` properly discovers and establishes new cycles. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -13,7 +13,7 @@ pong _ = !ping + 2 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -25,6 +25,6 @@ clang _ = !pong + 3 ``` ```ucm -.> update.old ping -.> view ping pong clang +scratch/main> update.old ping +scratch/main> view ping pong clang ``` diff --git a/unison-src/transcripts/cycle-update-4.output.md b/unison-src/transcripts/cycle-update-4.output.md index fd525176bf..da7b243543 100644 --- a/unison-src/transcripts/cycle-update-4.output.md +++ b/unison-src/transcripts/cycle-update-4.output.md @@ -23,7 +23,7 @@ pong _ = !ping + 2 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -58,7 +58,7 @@ clang _ = !pong + 3 ``` ```ucm -.> update.old ping +scratch/main> update.old ping ⍟ I've added these definitions: @@ -69,7 +69,7 @@ clang _ = !pong + 3 ping : 'Nat pong : 'Nat -.> view ping pong clang +scratch/main> view ping pong clang clang : 'Nat clang _ = diff --git a/unison-src/transcripts/cycle-update-5.md b/unison-src/transcripts/cycle-update-5.md index c09a93c3d7..60d283d55a 100644 --- a/unison-src/transcripts/cycle-update-5.md +++ b/unison-src/transcripts/cycle-update-5.md @@ -1,7 +1,7 @@ Not yet working: properly updating nameless implicit terms. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -13,7 +13,7 @@ pong _ = !inner.ping + 2 ``` ```ucm -.> add +scratch/main> add ``` Here we queue up an update by saving in a namespace where `inner.ping` and `pong` both have names, but then apply the @@ -26,7 +26,7 @@ inner.ping _ = !pong + 3 ```ucm .inner> update.old -.> view inner.ping +scratch/main> view inner.ping ``` The bug here is that `inner.ping` still refers to `pong` by name. But if we properly identified the nameless (in the diff --git a/unison-src/transcripts/cycle-update-5.output.md b/unison-src/transcripts/cycle-update-5.output.md index 3e3361f70c..8f583faaab 100644 --- a/unison-src/transcripts/cycle-update-5.output.md +++ b/unison-src/transcripts/cycle-update-5.output.md @@ -23,7 +23,7 @@ pong _ = !inner.ping + 2 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -54,13 +54,15 @@ inner.ping _ = !pong + 3 ``` ```ucm + ☝️ The namespace .inner is empty. + .inner> update.old ⍟ I've added these definitions: inner.ping : '##Nat -.> view inner.ping +scratch/main> view inner.ping inner.ping : 'Nat inner.ping _ = diff --git a/unison-src/transcripts/debug-definitions.md b/unison-src/transcripts/debug-definitions.md index 4717486917..0d10165f54 100644 --- a/unison-src/transcripts/debug-definitions.md +++ b/unison-src/transcripts/debug-definitions.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -17,12 +17,12 @@ ability Ask a where ``` ```ucm -.> add -.> debug.term.abt Nat.+ -.> debug.term.abt y -.> debug.term.abt Some -.> debug.term.abt ask -.> debug.type.abt Nat -.> debug.type.abt Optional -.> debug.type.abt Ask +scratch/main> add +scratch/main> debug.term.abt Nat.+ +scratch/main> debug.term.abt y +scratch/main> debug.term.abt Some +scratch/main> debug.term.abt ask +scratch/main> debug.type.abt Nat +scratch/main> debug.type.abt Optional +scratch/main> debug.type.abt Ask ``` diff --git a/unison-src/transcripts/debug-definitions.output.md b/unison-src/transcripts/debug-definitions.output.md index cb1b14d1a2..37d6591e25 100644 --- a/unison-src/transcripts/debug-definitions.output.md +++ b/unison-src/transcripts/debug-definitions.output.md @@ -13,7 +13,7 @@ ability Ask a where ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -23,15 +23,15 @@ ability Ask a where x : Nat y : Nat -.> debug.term.abt Nat.+ +scratch/main> debug.term.abt Nat.+ Builtin term: ##Nat.+ -.> debug.term.abt y +scratch/main> debug.term.abt y (let Ref(ReferenceBuiltin "Nat.+") Ref(ReferenceDerived (Id "qpo3o788girkkbb43uf6ggqberfduhtnqbt7096eojlrp27jieco09mdasb7b0b06ej9hj60a00nnbbdo8he0b4e0m7vtopifiuhdig" 0)) 2 in (User "z". Ref(ReferenceBuiltin "Nat.+") (Var User "z") 10)):ReferenceBuiltin "Nat" -.> debug.term.abt Some +scratch/main> debug.term.abt Some Constructor #0 of the following type: DataDeclaration @@ -61,7 +61,7 @@ ability Ask a where ] } -.> debug.term.abt ask +scratch/main> debug.term.abt ask Constructor #0 of the following type: EffectDeclaration @@ -90,11 +90,11 @@ ability Ask a where } } -.> debug.type.abt Nat +scratch/main> debug.type.abt Nat Builtin type: ##Nat -.> debug.type.abt Optional +scratch/main> debug.type.abt Optional DataDeclaration { modifier = Structural @@ -123,7 +123,7 @@ ability Ask a where ] } -.> debug.type.abt Ask +scratch/main> debug.type.abt Ask EffectDeclaration { toDataDecl = DataDeclaration diff --git a/unison-src/transcripts/debug-name-diffs.md b/unison-src/transcripts/debug-name-diffs.md index 361142bf57..5d4970e599 100644 --- a/unison-src/transcripts/debug-name-diffs.md +++ b/unison-src/transcripts/debug-name-diffs.md @@ -10,10 +10,10 @@ structural type a.b.Baz = Boo ``` ```ucm -.> add -.> delete.term.verbose a.b.one -.> alias.term a.two a.newtwo -.> move.namespace a.x a.y -.> history -.> debug.name-diff 4 1 +scratch/main> add +scratch/main> delete.term.verbose a.b.one +scratch/main> alias.term a.two a.newtwo +scratch/main> move.namespace a.x a.y +scratch/main> history +scratch/main> debug.name-diff 4 1 ``` diff --git a/unison-src/transcripts/debug-name-diffs.output.md b/unison-src/transcripts/debug-name-diffs.output.md index ac6895c14e..9d15bfe476 100644 --- a/unison-src/transcripts/debug-name-diffs.output.md +++ b/unison-src/transcripts/debug-name-diffs.output.md @@ -28,7 +28,7 @@ structural type a.b.Baz = Boo ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -39,7 +39,7 @@ structural type a.b.Baz = Boo a.x.four : ##Nat a.x.three : ##Nat -.> delete.term.verbose a.b.one +scratch/main> delete.term.verbose a.b.one Removed definitions: @@ -47,15 +47,15 @@ structural type a.b.Baz = Boo Tip: You can use `undo` or `reflog` to undo this change. -.> alias.term a.two a.newtwo +scratch/main> alias.term a.two a.newtwo Done. -.> move.namespace a.x a.y +scratch/main> move.namespace a.x a.y Done. -.> history +scratch/main> history Note: The most recent namespace hash is immediately below this message. @@ -90,7 +90,7 @@ structural type a.b.Baz = Boo □ 4. #gss5s88mo3 (start of history) -.> debug.name-diff 4 1 +scratch/main> debug.name-diff 4 1 Kind Name Change Ref Term a.newtwo Added #dcgdua2lj6upd1ah5v0qp09gjsej0d77d87fu6qn8e2qrssnlnmuinoio46hiu53magr7qn8vnqke8ndt0v76700o5u8gcvo7st28jg diff --git a/unison-src/transcripts/deep-names.md b/unison-src/transcripts/deep-names.md index 3487497cc3..aa000b578a 100644 --- a/unison-src/transcripts/deep-names.md +++ b/unison-src/transcripts/deep-names.md @@ -12,7 +12,7 @@ http.z = 8 ``` ```ucm:hide -.> add +scratch/main> add ``` Our `app1` project includes the text library twice and the http library twice as direct dependencies. diff --git a/unison-src/transcripts/deep-names.output.md b/unison-src/transcripts/deep-names.output.md index 3b6637d8a7..958083bc1b 100644 --- a/unison-src/transcripts/deep-names.output.md +++ b/unison-src/transcripts/deep-names.output.md @@ -17,83 +17,23 @@ Our `app1` project includes the text library twice and the http library twice as .app1> fork .text lib.text_v1 - Done. - -.app1> fork .text lib.text_v2 - - Done. - -.app1> fork .http lib.http_v3 - - Done. - -.app1> fork .http lib.http_v4 - - Done. - -``` -As such, we see two copies of `a` and two copies of `x` via these direct dependencies. -```ucm -.app1> names a - - Term - Hash: #gjmq673r1v - Names: lib.text_v1.a lib.text_v2.a + ⚠️ - Tip: Use `names.global` to see more results. - -.app1> names x - - Term - Hash: #nsmc4p1ra4 - Names: lib.http_v3.x lib.http_v4.x - - Tip: Use `names.global` to see more results. + The namespace .text doesn't exist. ``` -Our `app2` project includes the `http` library twice as direct dependencies, and once as an indirect dependency via `webutil`. -It also includes the `text` library twice as indirect dependencies via `webutil` -```ucm - ☝️ The namespace .app2 is empty. -.app2> fork .http lib.http_v1 - - Done. - -.app2> fork .http lib.http_v2 - - Done. - -.app2> fork .text lib.webutil.lib.text_v1 - - Done. - -.app2> fork .text lib.webutil.lib.text_v2 - - Done. +```ucm +.app1> fork .text lib.text_v1.app1> fork .text lib.text_v2.app1> fork .http lib.http_v3.app1> fork .http lib.http_v4 +``` -.app2> fork .http lib.webutil.lib.http - Done. +🛑 -``` -Now we see two copies of `x` via direct dependencies on `http`, and one copy of `a` via indirect dependency on `text` via `webutil`. -We see neither the second indirect copy of `a` nor the indirect copy of `x` via webutil because we already have names for them. -```ucm -.app2> names a +The transcript failed due to an error in the stanza above. The error is: - Term - Hash: #gjmq673r1v - Names: lib.webutil.lib.text_v1.a - - Tip: Use `names.global` to see more results. - -.app2> names x - Term - Hash: #nsmc4p1ra4 - Names: lib.http_v1.x lib.http_v2.x + ⚠️ - Tip: Use `names.global` to see more results. + The namespace .text doesn't exist. -``` diff --git a/unison-src/transcripts/delete-namespace.md b/unison-src/transcripts/delete-namespace.md index fe8f346306..5bbdda79e6 100644 --- a/unison-src/transcripts/delete-namespace.md +++ b/unison-src/transcripts/delete-namespace.md @@ -1,7 +1,7 @@ # delete.namespace.force ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -15,47 +15,47 @@ dependents.usage2 = dependencies.term1 * dependencies.term2 ``` ```ucm:hide -.> add +scratch/main> add ``` Deleting a namespace with no external dependencies should succeed. ```ucm -.> delete.namespace no_dependencies +scratch/main> delete.namespace no_dependencies ``` Deleting a namespace with external dependencies should fail and list all dependents. ```ucm:error -.> delete.namespace dependencies +scratch/main> delete.namespace dependencies ``` Deleting a namespace with external dependencies should succeed when using `delete.namespace.force` ```ucm -.> delete.namespace.force dependencies +scratch/main> delete.namespace.force dependencies ``` I should be able to view an affected dependency by number ```ucm -.> view 2 +scratch/main> view 2 ``` Deleting the root namespace should require confirmation if not forced. ```ucm -.> delete.namespace . -.> delete.namespace . +scratch/main> delete.namespace . +scratch/main> delete.namespace . -- Should have an empty history -.> history . +scratch/main> history . ``` Deleting the root namespace shouldn't require confirmation if forced. ```ucm -.> delete.namespace.force . +scratch/main> delete.namespace.force . -- Should have an empty history -.> history . +scratch/main> history . ``` diff --git a/unison-src/transcripts/delete-namespace.output.md b/unison-src/transcripts/delete-namespace.output.md index e7c09cbaed..563b98ad2c 100644 --- a/unison-src/transcripts/delete-namespace.output.md +++ b/unison-src/transcripts/delete-namespace.output.md @@ -13,7 +13,7 @@ dependents.usage2 = dependencies.term1 * dependencies.term2 Deleting a namespace with no external dependencies should succeed. ```ucm -.> delete.namespace no_dependencies +scratch/main> delete.namespace no_dependencies Done. @@ -21,7 +21,7 @@ Deleting a namespace with no external dependencies should succeed. Deleting a namespace with external dependencies should fail and list all dependents. ```ucm -.> delete.namespace dependencies +scratch/main> delete.namespace dependencies ⚠️ @@ -42,7 +42,7 @@ Deleting a namespace with external dependencies should fail and list all depende Deleting a namespace with external dependencies should succeed when using `delete.namespace.force` ```ucm -.> delete.namespace.force dependencies +scratch/main> delete.namespace.force dependencies Done. @@ -62,7 +62,7 @@ Deleting a namespace with external dependencies should succeed when using `delet I should be able to view an affected dependency by number ```ucm -.> view 2 +scratch/main> view 2 dependents.usage2 : Nat dependents.usage2 = @@ -73,21 +73,21 @@ I should be able to view an affected dependency by number Deleting the root namespace should require confirmation if not forced. ```ucm -.> delete.namespace . +scratch/main> delete.namespace . ⚠️ Are you sure you want to clear away everything? You could use `project.create` to switch to a new project instead. -.> delete.namespace . +scratch/main> delete.namespace . Okay, I deleted everything except the history. Use `undo` to undo, or `builtins.merge` to restore the absolute basics to the current path. -- Should have an empty history -.> history . +scratch/main> history . ☝️ The namespace . is empty. @@ -95,14 +95,14 @@ Deleting the root namespace should require confirmation if not forced. Deleting the root namespace shouldn't require confirmation if forced. ```ucm -.> delete.namespace.force . +scratch/main> delete.namespace.force . Okay, I deleted everything except the history. Use `undo` to undo, or `builtins.merge` to restore the absolute basics to the current path. -- Should have an empty history -.> history . +scratch/main> history . ☝️ The namespace . is empty. diff --git a/unison-src/transcripts/delete-project-branch.md b/unison-src/transcripts/delete-project-branch.md index c84dc95cc2..091e9fa71c 100644 --- a/unison-src/transcripts/delete-project-branch.md +++ b/unison-src/transcripts/delete-project-branch.md @@ -17,7 +17,7 @@ You can precede the branch name by a project name. ```ucm foo/main> branch topic -.> delete.branch foo/topic +scratch/main> delete.branch foo/topic ``` You can delete the only branch in a project. diff --git a/unison-src/transcripts/delete-project-branch.output.md b/unison-src/transcripts/delete-project-branch.output.md index d4458e8be0..84568c97da 100644 --- a/unison-src/transcripts/delete-project-branch.output.md +++ b/unison-src/transcripts/delete-project-branch.output.md @@ -35,9 +35,7 @@ foo/main> branch topic Tip: To merge your work back into the main branch, first `switch /main` then `merge /topic`. - ☝️ The namespace . is empty. - -.> delete.branch foo/topic +scratch/main> delete.branch foo/topic ``` You can delete the only branch in a project. diff --git a/unison-src/transcripts/delete-project.md b/unison-src/transcripts/delete-project.md index df31873fb9..b317a9f31e 100644 --- a/unison-src/transcripts/delete-project.md +++ b/unison-src/transcripts/delete-project.md @@ -1,9 +1,9 @@ # delete.project ```ucm -.> project.create-empty foo -.> project.create-empty bar -.> projects +scratch/main> project.create-empty foo +scratch/main> project.create-empty bar +scratch/main> projects foo/main> delete.project foo -.> projects +scratch/main> projects ``` diff --git a/unison-src/transcripts/delete-project.output.md b/unison-src/transcripts/delete-project.output.md index 18af51f9c0..e2b974a9ca 100644 --- a/unison-src/transcripts/delete-project.output.md +++ b/unison-src/transcripts/delete-project.output.md @@ -1,7 +1,7 @@ # delete.project ```ucm -.> project.create-empty foo +scratch/main> project.create-empty foo 🎉 I've created the project foo. @@ -17,9 +17,7 @@ 🎉 🥳 Happy coding! - ☝️ The namespace . is empty. - -.> project.create-empty bar +scratch/main> project.create-empty bar 🎉 I've created the project bar. @@ -35,17 +33,17 @@ 🎉 🥳 Happy coding! - ☝️ The namespace . is empty. - -.> projects +scratch/main> projects 1. bar 2. foo + 3. scratch foo/main> delete.project foo -.> projects +scratch/main> projects 1. bar + 2. scratch ``` diff --git a/unison-src/transcripts/delete-silent.md b/unison-src/transcripts/delete-silent.md index 33ec668de3..5a5037e9f1 100644 --- a/unison-src/transcripts/delete-silent.md +++ b/unison-src/transcripts/delete-silent.md @@ -1,5 +1,5 @@ ```ucm:error -.> delete foo +scratch/main> delete foo ``` ```unison:hide @@ -8,8 +8,8 @@ structural type Foo = Foo () ``` ```ucm -.> add -.> delete foo -.> delete.type Foo -.> delete.term Foo.Foo +scratch/main> add +scratch/main> delete foo +scratch/main> delete.type Foo +scratch/main> delete.term Foo.Foo ``` diff --git a/unison-src/transcripts/delete-silent.output.md b/unison-src/transcripts/delete-silent.output.md index 7ea6d420d2..3ec5397fc6 100644 --- a/unison-src/transcripts/delete-silent.output.md +++ b/unison-src/transcripts/delete-silent.output.md @@ -1,5 +1,5 @@ ```ucm -.> delete foo +scratch/main> delete foo ⚠️ @@ -13,22 +13,22 @@ structural type Foo = Foo () ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: structural type Foo foo : ##Nat -.> delete foo +scratch/main> delete foo Done. -.> delete.type Foo +scratch/main> delete.type Foo Done. -.> delete.term Foo.Foo +scratch/main> delete.term Foo.Foo Done. diff --git a/unison-src/transcripts/delete.md b/unison-src/transcripts/delete.md index e3e27ede98..a3af9d2142 100644 --- a/unison-src/transcripts/delete.md +++ b/unison-src/transcripts/delete.md @@ -1,7 +1,7 @@ # Delete ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` The delete command can delete both terms and types. @@ -10,7 +10,7 @@ First, let's make sure it complains when we try to delete a name that doesn't exist. ```ucm:error -.> delete.verbose foo +scratch/main> delete.verbose foo ``` Now for some easy cases. Deleting an unambiguous term, then deleting an @@ -22,10 +22,10 @@ structural type Foo = Foo () ``` ```ucm -.> add -.> delete.verbose foo -.> delete.verbose Foo -.> delete.verbose Foo.Foo +scratch/main> add +scratch/main> delete.verbose foo +scratch/main> delete.verbose Foo +scratch/main> delete.verbose Foo.Foo ``` How about an ambiguous term? @@ -50,7 +50,7 @@ foo = 2 A delete should remove both versions of the term. ```ucm -.> delete.verbose a.foo +scratch/main> delete.verbose a.foo ``` ```ucm:error @@ -77,11 +77,11 @@ structural type Foo = Foo ``` ```ucm -.> delete.verbose a.Foo +scratch/main> delete.verbose a.Foo ``` ```ucm -.> delete.verbose a.Foo.Foo +scratch/main> delete.verbose a.Foo.Foo ``` Finally, let's try to delete a term and a type with the same name. @@ -92,11 +92,11 @@ structural type foo = Foo () ``` ```ucm -.> add +scratch/main> add ``` ```ucm -.> delete.verbose foo +scratch/main> delete.verbose foo ``` We want to be able to delete multiple terms at once @@ -108,8 +108,8 @@ c = "c" ``` ```ucm -.> add -.> delete.verbose a b c +scratch/main> add +scratch/main> delete.verbose a b c ``` We can delete terms and types in the same invocation of delete @@ -122,9 +122,9 @@ c = "c" ``` ```ucm -.> add -.> delete.verbose a b c Foo -.> delete.verbose Foo.Foo +scratch/main> add +scratch/main> delete.verbose a b c Foo +scratch/main> delete.verbose Foo.Foo ``` We can delete a type and its constructors @@ -134,8 +134,8 @@ structural type Foo = Foo () ``` ```ucm -.> add -.> delete.verbose Foo Foo.Foo +scratch/main> add +scratch/main> delete.verbose Foo Foo.Foo ``` You should not be able to delete terms which are referenced by other terms @@ -148,8 +148,8 @@ d = a + b + c ``` ```ucm:error -.> add -.> delete.verbose a b c +scratch/main> add +scratch/main> delete.verbose a b c ``` But you should be able to delete all terms which reference each other in a single command @@ -162,8 +162,8 @@ h = e + f + g ``` ```ucm -.> add -.> delete.verbose e f g h +scratch/main> add +scratch/main> delete.verbose e f g h ``` You should be able to delete a type and all the functions that reference it in a single command @@ -177,8 +177,8 @@ incrementFoo = cases ``` ```ucm -.> add -.> delete.verbose Foo Foo.Foo incrementFoo +scratch/main> add +scratch/main> delete.verbose Foo Foo.Foo incrementFoo ``` If you mess up on one of the names of your command, delete short circuits @@ -191,8 +191,8 @@ h = e + f + g ``` ```ucm:error -.> add -.> delete.verbose e f gg +scratch/main> add +scratch/main> delete.verbose e f gg ``` Cyclical terms which are guarded by a lambda are allowed to be deleted @@ -203,7 +203,7 @@ pong _ = 4 Nat.+ !ping ``` ```ucm -.> add -.> delete.verbose ping -.> view pong +scratch/main> add +scratch/main> delete.verbose ping +scratch/main> view pong ``` diff --git a/unison-src/transcripts/delete.output.md b/unison-src/transcripts/delete.output.md index 05a998cc1e..ab4e084476 100644 --- a/unison-src/transcripts/delete.output.md +++ b/unison-src/transcripts/delete.output.md @@ -6,7 +6,7 @@ First, let's make sure it complains when we try to delete a name that doesn't exist. ```ucm -.> delete.verbose foo +scratch/main> delete.verbose foo ⚠️ @@ -23,14 +23,14 @@ structural type Foo = Foo () ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: structural type Foo foo : Nat -.> delete.verbose foo +scratch/main> delete.verbose foo Removed definitions: @@ -38,7 +38,7 @@ structural type Foo = Foo () Tip: You can use `undo` or `reflog` to undo this change. -.> delete.verbose Foo +scratch/main> delete.verbose Foo Removed definitions: @@ -46,7 +46,7 @@ structural type Foo = Foo () Tip: You can use `undo` or `reflog` to undo this change. -.> delete.verbose Foo.Foo +scratch/main> delete.verbose Foo.Foo Removed definitions: @@ -107,385 +107,24 @@ foo = 2 A delete should remove both versions of the term. ```ucm -.> delete.verbose a.foo - - Removed definitions: - - 1. a.foo#gjmq673r1v : Nat - - Name changes: - - Original Changes - 2. b.foo ┐ 3. a.foo#dcgdua2lj6 (removed) - 4. a.foo#dcgdua2lj6 ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -```ucm - ☝️ The namespace .a is empty. - -.a> ls - - nothing to show - -``` -Let's repeat all that on a type, for completeness. - -```unison -structural type Foo = Foo () -``` - -```ucm -.a> add - - ⍟ I've added these definitions: - - structural type Foo - -``` -```unison -structural type Foo = Foo -``` - -```ucm -.b> add - - ⍟ I've added these definitions: - - structural type Foo - -.a> merge.old .b - - Here's what's changed in the current namespace after the - merge: - - New name conflicts: - - 1. structural type Foo#089vmor9c5 - ↓ - 2. ┌ structural type Foo#00nv2kob8f - 3. └ structural type Foo#089vmor9c5 - - 4. Foo.Foo#089vmor9c5#0 : 'Foo#089vmor9c5 - ↓ - 5. ┌ Foo.Foo#00nv2kob8f#0 : () - 6. └ Foo.Foo#089vmor9c5#0 : 'Foo#089vmor9c5 - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` -```ucm -.> delete.verbose a.Foo - - Removed definitions: - - 1. structural type a.Foo#089vmor9c5 - - Name changes: - - Original Changes - 2. b.Foo ┐ 3. a.Foo#00nv2kob8f (removed) - 4. builtin.Unit │ - 5. a.Foo#00nv2kob8f ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -```ucm -.> delete.verbose a.Foo.Foo - - Removed definitions: - - 1. a.Foo.Foo#089vmor9c5#0 : '#089vmor9c5 - - Name changes: - - Original Changes - 2. b.Foo.Foo ┐ 3. a.Foo.Foo#00nv2kob8f#0 (removed) - 4. builtin.Unit.Unit │ - 5. a.Foo.Foo#00nv2kob8f#0 ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -Finally, let's try to delete a term and a type with the same name. - -```unison -foo = 1 -structural type foo = Foo () -``` - -```ucm -.> add - - ⍟ I've added these definitions: - - structural type foo - foo : Nat - -``` -```ucm -.> delete.verbose foo - - Removed definitions: - - 1. structural type foo - 2. foo : Nat - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -We want to be able to delete multiple terms at once - -```unison -a = "a" -b = "b" -c = "c" -``` - -```ucm -.> add - - ⍟ I've added these definitions: - - a : Text - b : Text - c : Text - -.> delete.verbose a b c - - Removed definitions: - - 1. a : Text - 2. b : Text - 3. c : Text - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -We can delete terms and types in the same invocation of delete - -```unison -structural type Foo = Foo () -a = "a" -b = "b" -c = "c" -``` - -```ucm -.> add - - ⍟ I've added these definitions: - - structural type Foo - a : Text - b : Text - c : Text - -.> delete.verbose a b c Foo - - Removed definitions: - - 1. structural type Foo - 2. a : Text - 3. b : Text - 4. c : Text - - Tip: You can use `undo` or `reflog` to undo this change. - -.> delete.verbose Foo.Foo - - Name changes: - - Original Changes - 1. Foo.Foo ┐ 2. Foo.Foo (removed) - 3. foo.Foo ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -We can delete a type and its constructors - -```unison -structural type Foo = Foo () -``` - -```ucm -.> add - - ⍟ I've added these definitions: - - structural type Foo - -.> delete.verbose Foo Foo.Foo - - Removed definitions: - - 1. structural type Foo - - Name changes: - - Original Changes - 2. Foo.Foo ┐ 3. Foo.Foo (removed) - 4. foo.Foo ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -You should not be able to delete terms which are referenced by other terms - -```unison -a = 1 -b = 2 -c = 3 -d = a + b + c -``` - -```ucm -.> add - - ⍟ I've added these definitions: - - a : Nat - b : Nat - (also named b.foo) - c : Nat - d : Nat - -.> delete.verbose a b c +scratch/main> delete.verbose a.foo ⚠️ - I didn't delete the following definitions because they are - still in use: - - Dependency Referenced In - c 1. d - - a 2. d - -``` -But you should be able to delete all terms which reference each other in a single command - -```unison -e = 11 -f = 12 + e -g = 13 + f -h = e + f + g -``` - -```ucm -.> add - - ⍟ I've added these definitions: - - e : Nat - f : Nat - g : Nat - h : Nat - -.> delete.verbose e f g h - - Removed definitions: - - 1. e : Nat - 2. f : Nat - 3. g : Nat - 4. h : Nat - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -You should be able to delete a type and all the functions that reference it in a single command - -```unison -structural type Foo = Foo Nat + The following names were not found in the codebase. Check your spelling. + a.foo -incrementFoo : Foo -> Nat -incrementFoo = cases - (Foo n) -> n + 1 ``` -```ucm -.> add - - ⍟ I've added these definitions: - - structural type Foo - incrementFoo : Foo -> Nat - -.> delete.verbose Foo Foo.Foo incrementFoo - - Removed definitions: - - 1. structural type Foo - 2. Foo.Foo : Nat -> #68k40ra7l7 - 3. incrementFoo : #68k40ra7l7 -> Nat - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -If you mess up on one of the names of your command, delete short circuits -```unison -e = 11 -f = 12 + e -g = 13 + f -h = e + f + g -``` -```ucm -.> add +🛑 - ⍟ I've added these definitions: - - e : Nat - f : Nat - g : Nat - h : Nat +The transcript failed due to an error in the stanza above. The error is: -.> delete.verbose e f gg ⚠️ The following names were not found in the codebase. Check your spelling. - gg - -``` -Cyclical terms which are guarded by a lambda are allowed to be deleted - -```unison -ping _ = 1 Nat.+ !pong -pong _ = 4 Nat.+ !ping -``` + a.foo -```ucm -.> add - - ⍟ I've added these definitions: - - ping : 'Nat - pong : 'Nat - -.> delete.verbose ping - - Removed definitions: - - 1. ping : 'Nat - - Tip: You can use `undo` or `reflog` to undo this change. - -.> view pong - - pong : 'Nat - pong _ = - use Nat + - 4 + !#l9uq1dpl5v.1 - -``` diff --git a/unison-src/transcripts/dependents-dependencies-debugfile.md b/unison-src/transcripts/dependents-dependencies-debugfile.md index 46ffce8d30..30692285ee 100644 --- a/unison-src/transcripts/dependents-dependencies-debugfile.md +++ b/unison-src/transcripts/dependents-dependencies-debugfile.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ### `debug.file` @@ -18,7 +18,7 @@ inside.q x = x + p * p inside.r = d ``` ```ucm -.> debug.file +scratch/main> debug.file ``` This will help me make progress in some situations when UCM is being deficient or broken. @@ -26,13 +26,13 @@ This will help me make progress in some situations when UCM is being deficient o ### `dependents` / `dependencies` But wait, there's more. I can check the dependencies and dependents of a definition: ```ucm -.> add -.> dependents q -.> dependencies q -.> dependencies B -.> dependencies d -.> dependents d -.> +scratch/main> add +scratch/main> dependents q +scratch/main> dependencies q +scratch/main> dependencies B +scratch/main> dependencies d +scratch/main> dependents d +scratch/main> ``` We don't have an index for dependents of constructors, but iirc if you ask for that, it will show you dependents of the structural type that provided the constructor. diff --git a/unison-src/transcripts/dependents-dependencies-debugfile.output.md b/unison-src/transcripts/dependents-dependencies-debugfile.output.md index 413c7c2108..90f3fefbc8 100644 --- a/unison-src/transcripts/dependents-dependencies-debugfile.output.md +++ b/unison-src/transcripts/dependents-dependencies-debugfile.output.md @@ -15,7 +15,7 @@ inside.r = d ``` ```ucm -.> debug.file +scratch/main> debug.file type inside.M#h37a56c5ep type outside.A#6l6krl7n4l @@ -32,7 +32,7 @@ This will help me make progress in some situations when UCM is being deficient o ### `dependents` / `dependencies` But wait, there's more. I can check the dependencies and dependents of a definition: ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -45,11 +45,11 @@ But wait, there's more. I can check the dependencies and dependents of a defini outside.c : Nat outside.d : Boolean -.> dependents q +scratch/main> dependents q q has no dependents. -.> dependencies q +scratch/main> dependencies q Dependencies of: q @@ -66,7 +66,7 @@ But wait, there's more. I can check the dependencies and dependents of a defini Tip: Try `view 4` to see the source of any numbered item in the above list. -.> dependencies B +scratch/main> dependencies B Dependencies of: type B, B @@ -78,7 +78,7 @@ But wait, there's more. I can check the dependencies and dependents of a defini Tip: Try `view 2` to see the source of any numbered item in the above list. -.> dependencies d +scratch/main> dependencies d Dependencies of: d @@ -97,7 +97,7 @@ But wait, there's more. I can check the dependencies and dependents of a defini Tip: Try `view 6` to see the source of any numbered item in the above list. -.> dependents d +scratch/main> dependents d Dependents of: d diff --git a/unison-src/transcripts/destructuring-binds.md b/unison-src/transcripts/destructuring-binds.md index f9a1eef975..2c8cf5a770 100644 --- a/unison-src/transcripts/destructuring-binds.md +++ b/unison-src/transcripts/destructuring-binds.md @@ -1,7 +1,7 @@ # Destructuring binds ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Here's a couple examples: @@ -19,8 +19,8 @@ ex1 tup = ``` ```ucm -.> add -.> view ex0 ex1 +scratch/main> add +scratch/main> view ex0 ex1 ``` Notice that `ex0` is printed using the `cases` syntax (but `ex1` is not). The pretty-printer currently prefers the `cases` syntax if definition can be printed using either destructuring bind or `cases`. @@ -58,8 +58,8 @@ ex5a _ = match (99 + 1, "hi") with ``` ```ucm -.> add -.> view ex5 ex5a +scratch/main> add +scratch/main> view ex5 ex5a ``` Notice how it prints both an ordinary match. @@ -74,6 +74,6 @@ ex6 x = match x with For clarity, the pretty-printer leaves this alone, even though in theory it could be written `(x,y) = x; x + y`: ```ucm -.> add -.> view ex6 +scratch/main> add +scratch/main> view ex6 ``` diff --git a/unison-src/transcripts/destructuring-binds.output.md b/unison-src/transcripts/destructuring-binds.output.md index af097fc522..4185a71b91 100644 --- a/unison-src/transcripts/destructuring-binds.output.md +++ b/unison-src/transcripts/destructuring-binds.output.md @@ -29,14 +29,14 @@ ex1 tup = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: ex0 : Nat -> Nat ex1 : (a, b, (Nat, Nat)) -> Nat -.> view ex0 ex1 +scratch/main> view ex0 ex1 ex0 : Nat -> Nat ex0 n = @@ -131,14 +131,14 @@ ex5a _ = match (99 + 1, "hi") with ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: ex5 : 'Text ex5a : 'Text -.> view ex5 ex5a +scratch/main> view ex5 ex5a ex5 : 'Text ex5 _ = match 99 Nat.+ 1 with @@ -163,13 +163,13 @@ ex6 x = match x with For clarity, the pretty-printer leaves this alone, even though in theory it could be written `(x,y) = x; x + y`: ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: ex6 : (Nat, Nat) -> Nat -.> view ex6 +scratch/main> view ex6 ex6 : (Nat, Nat) -> Nat ex6 = cases (x, y) -> x Nat.+ y diff --git a/unison-src/transcripts/diff-namespace.md b/unison-src/transcripts/diff-namespace.md index 5e938a79a5..63c20cb740 100644 --- a/unison-src/transcripts/diff-namespace.md +++ b/unison-src/transcripts/diff-namespace.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -9,7 +9,7 @@ x = 23 ```ucm .b1> add .b1> alias.term x fslkdjflskdjflksjdf -.> fork b1 b2 +scratch/main> fork b1 b2 .b2> alias.term x abc ``` ```unison:hide @@ -17,8 +17,8 @@ fslkdjflskdjflksjdf = 663 ``` ```ucm .b0> add -.> merge.old b0 b1 -.> diff.namespace b1 b2 +scratch/main> merge.old b0 b1 +scratch/main> diff.namespace b1 b2 .b2> diff.namespace .b1 ``` Things we want to test: @@ -53,11 +53,11 @@ structural ability X a1 a2 where x : () Here's what we've done so far: ```ucm:error -.> diff.namespace nothing ns1 +scratch/main> diff.namespace nothing ns1 ``` ```ucm:error -.> diff.namespace ns1 ns2 +scratch/main> diff.namespace ns1 ns2 ``` ```unison:hide @@ -66,7 +66,7 @@ fromJust = "asldkfjasldkfj" ```ucm .ns1b> add -.> merge.old ns1b ns1 +scratch/main> merge.old ns1b ns1 ``` ```unison:hide @@ -80,24 +80,24 @@ unique type Y a b = Y a b ```ucm .ns2> update.old -.> diff.namespace ns1 ns2 -.> alias.term ns2.d ns2.d' -.> alias.type ns2.A ns2.A' -.> alias.type ns2.X ns2.X' -.> diff.namespace ns1 ns2 -.> alias.type ns1.X ns1.X2 -.> alias.type ns2.A' ns2.A'' -.> fork ns2 ns3 -.> alias.term ns2.fromJust' ns2.yoohoo -.> delete.term.verbose ns2.fromJust' -.> diff.namespace ns3 ns2 +scratch/main> diff.namespace ns1 ns2 +scratch/main> alias.term ns2.d ns2.d' +scratch/main> alias.type ns2.A ns2.A' +scratch/main> alias.type ns2.X ns2.X' +scratch/main> diff.namespace ns1 ns2 +scratch/main> alias.type ns1.X ns1.X2 +scratch/main> alias.type ns2.A' ns2.A'' +scratch/main> fork ns2 ns3 +scratch/main> alias.term ns2.fromJust' ns2.yoohoo +scratch/main> delete.term.verbose ns2.fromJust' +scratch/main> diff.namespace ns3 ns2 ``` ```unison:hide bdependent = "banana" ``` ```ucm .ns3> update.old -.> diff.namespace ns2 ns3 +scratch/main> diff.namespace ns2 ns3 ``` @@ -110,8 +110,8 @@ b = a + 1 ``` ```ucm .nsx> add -.> fork nsx nsy -.> fork nsx nsz +scratch/main> fork nsx nsy +scratch/main> fork nsx nsz ``` ```unison:hide a = 444 @@ -124,13 +124,13 @@ a = 555 ``` ```ucm .nsz> update.old -.> merge.old nsy nsw +scratch/main> merge.old nsy nsw ``` ```ucm:error -.> merge.old nsz nsw +scratch/main> merge.old nsz nsw ``` ```ucm -.> diff.namespace nsx nsw +scratch/main> diff.namespace nsx nsw .nsw> view a b ``` diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md index cacb9d1fc4..609451996f 100644 --- a/unison-src/transcripts/diff-namespace.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -15,597 +15,25 @@ x = 23 Done. -.> fork b1 b2 - - Done. - -.b2> alias.term x abc - - Done. - -``` -```unison -fslkdjflskdjflksjdf = 663 -``` - -```ucm - ☝️ The namespace .b0 is empty. - -.b0> add - - ⍟ I've added these definitions: - - fslkdjflskdjflksjdf : ##Nat - -.> merge.old b0 b1 - - Here's what's changed in b1 after the merge: - - New name conflicts: - - 1. fslkdjflskdjflksjdf#u520d1t9kc : Nat - ↓ - 2. ┌ fslkdjflskdjflksjdf#sekb3fdsvb : Nat - 3. └ fslkdjflskdjflksjdf#u520d1t9kc : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> diff.namespace b1 b2 - - Resolved name conflicts: - - 1. ┌ fslkdjflskdjflksjdf#sekb3fdsvb : Nat - 2. └ fslkdjflskdjflksjdf#u520d1t9kc : Nat - ↓ - 3. fslkdjflskdjflksjdf#u520d1t9kc : Nat - - Name changes: - - Original Changes - 4. x ┐ 5. abc (added) - 6. fslkdjflskdjflksjdf#u520d1t9kc ┘ 7. fslkdjflskdjflksjdf (added) - 8. fslkdjflskdjflksjdf#u520d1t9kc (removed) - -.b2> diff.namespace .b1 - - Resolved name conflicts: - - 1. ┌ fslkdjflskdjflksjdf#sekb3fdsvb : ##Nat - 2. └ fslkdjflskdjflksjdf#u520d1t9kc : ##Nat - ↓ - 3. fslkdjflskdjflksjdf#u520d1t9kc : ##Nat - - Name changes: - - Original Changes - 4. x ┐ 5. abc (added) - 6. fslkdjflskdjflksjdf#u520d1t9kc ┘ 7. fslkdjflskdjflksjdf (added) - 8. fslkdjflskdjflksjdf#u520d1t9kc (removed) - -``` -Things we want to test: - -* Diffing identical namespaces -* Adds, removes, updates - * Adds with multiple names -* Moved and copied definitions - * Moves that have more that 1 initial or final name -* ... terms and types -* New patches, modified patches, deleted patches, moved patches -* With and without propagated updates - -```unison -fromJust = 1 -b = 2 -bdependent = b -c = 3 -helloWorld = "Hello, world!" - -structural type A a = A () -structural ability X a1 a2 where x : () -``` - -```ucm - ☝️ The namespace .ns1 is empty. - -.ns1> add - - ⍟ I've added these definitions: - - structural type A a - structural ability X a1 a2 - b : ##Nat - bdependent : ##Nat - c : ##Nat - fromJust : ##Nat - helloWorld : ##Text - -.ns1> alias.term fromJust fromJust' - - Done. - -.ns1> alias.term helloWorld helloWorld2 - - Done. - -.ns1> fork .ns1 .ns2 - - Done. - -``` -Here's what we've done so far: - -```ucm -.> diff.namespace nothing ns1 +scratch/main> fork b1 b2 ⚠️ - The namespace .nothing is empty. Was there a typo? - -``` -```ucm -.> diff.namespace ns1 ns2 + The namespace .__projects._63858924_a9e5_435d_be39_1d1a9b4bb963.branches._7b129dcd_ed19_42e7_9a27_5e59e3627c2b.b1 doesn't exist. - The namespaces are identical. - -``` -```unison -fromJust = "asldkfjasldkfj" ``` ```ucm - ☝️ The namespace .ns1b is empty. - -.ns1b> add - - ⍟ I've added these definitions: - - fromJust : ##Text - -.> merge.old ns1b ns1 - - Here's what's changed in ns1 after the merge: - - New name conflicts: - - 1. fromJust#gjmq673r1v : Nat - ↓ - 2. ┌ fromJust#gjmq673r1v : Nat - 3. └ fromJust#rnbo52q2sh : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` -```unison -fromJust = 99 -b = "oog" -d = 4 -e = 5 -f = 6 -unique type Y a b = Y a b +.b1> add.b1> alias.term x fslkdjflskdjflksjdfscratch/main> fork b1 b2.b2> alias.term x abc ``` -```ucm -.ns2> update.old - - ⍟ I've added these definitions: - - type Y a b - d : ##Nat - e : ##Nat - f : ##Nat - - ⍟ I've updated these names to your new definition: - - b : ##Text - fromJust : ##Nat - (The old definition was also named fromJust'.) - -.> diff.namespace ns1 ns2 - - Resolved name conflicts: - - 1. ┌ fromJust#gjmq673r1v : Nat - 2. └ fromJust#rnbo52q2sh : Text - ↓ - 3. fromJust#6gn1k53ie0 : Nat - - Updates: - - 4. b : Nat - ↓ - 5. b : Text - - 6. fromJust' : Nat - ↓ - 7. fromJust' : Nat - - Added definitions: - - 8. type Y a b - 9. Y.Y : a -> b -> Y a b - 10. d : Nat - 11. e : Nat - 12. f : Nat - - 13. patch patch (added 2 updates) - -.> alias.term ns2.d ns2.d' - - Done. - -.> alias.type ns2.A ns2.A' - Done. - -.> alias.type ns2.X ns2.X' - - Done. - -.> diff.namespace ns1 ns2 - - Resolved name conflicts: - - 1. ┌ fromJust#gjmq673r1v : Nat - 2. └ fromJust#rnbo52q2sh : Text - ↓ - 3. fromJust#6gn1k53ie0 : Nat - - Updates: - - 4. b : Nat - ↓ - 5. b : Text - - 6. fromJust' : Nat - ↓ - 7. fromJust' : Nat - - Added definitions: - - 8. type Y a b - 9. Y.Y : a -> b -> Y a b - 10. ┌ d : Nat - 11. └ d' : Nat - 12. e : Nat - 13. f : Nat - - 14. patch patch (added 2 updates) - - Name changes: - - Original Changes - 15. A 16. A' (added) - - 17. X 18. X' (added) +🛑 -.> alias.type ns1.X ns1.X2 - - Done. +The transcript failed due to an error in the stanza above. The error is: -.> alias.type ns2.A' ns2.A'' - - Done. - -.> fork ns2 ns3 - - Done. - -.> alias.term ns2.fromJust' ns2.yoohoo - - Done. - -.> delete.term.verbose ns2.fromJust' - - Name changes: - - Original Changes - 1. ns2.fromJust ┐ 2. ns2.fromJust' (removed) - 3. ns2.fromJust' │ - 4. ns2.yoohoo │ - 5. ns3.fromJust │ - 6. ns3.fromJust' ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.> diff.namespace ns3 ns2 - - Name changes: - - Original Changes - 1. fromJust ┐ 2. yoohoo (added) - 3. fromJust' ┘ 4. fromJust' (removed) -``` -```unison -bdependent = "banana" -``` - -```ucm -.ns3> update.old - - ⍟ I've updated these names to your new definition: - - bdependent : ##Text - -.> diff.namespace ns2 ns3 - - Updates: - - 1. bdependent : Nat - ↓ - 2. bdependent : Text - - 3. patch patch (added 1 updates) - - Name changes: - - Original Changes - 4. fromJust ┐ 5. fromJust' (added) - 6. yoohoo ┘ 7. yoohoo (removed) - -``` -## Two different auto-propagated changes creating a name conflict -Currently, the auto-propagated name-conflicted definitions are not explicitly -shown, only their also-conflicted dependency is shown. -```unison -a = 333 -b = a + 1 -``` - -```ucm - ☝️ The namespace .nsx is empty. - -.nsx> add - - ⍟ I've added these definitions: - - a : ##Nat - b : ##Nat - -.> fork nsx nsy - - Done. - -.> fork nsx nsz - - Done. - -``` -```unison -a = 444 -``` - -```ucm -.nsy> update.old - - ⍟ I've updated these names to your new definition: - - a : ##Nat - -``` -```unison -a = 555 -``` - -```ucm -.nsz> update.old - - ⍟ I've updated these names to your new definition: - - a : ##Nat - -.> merge.old nsy nsw - - Here's what's changed in nsw after the merge: - - Added definitions: - - 1. a : Nat - 2. b : Nat - - 3. patch patch (added 1 updates) - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` -```ucm -.> merge.old nsz nsw - - Here's what's changed in nsw after the merge: - - New name conflicts: - - 1. a#mdl4vqtu00 : Nat - ↓ - 2. ┌ a#mdl4vqtu00 : Nat - 3. └ a#vrs8gtkl2t : Nat - - 4. b#unkqhuu66p : Nat - ↓ - 5. ┌ b#aapqletas7 : Nat - 6. └ b#unkqhuu66p : Nat - - Updates: - - 7. patch patch (added 1 updates) - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - - I tried to auto-apply the patch, but couldn't because it - contained contradictory entries. - -``` -```ucm -.> diff.namespace nsx nsw - - New name conflicts: - - 1. a#uiiiv8a86s : Nat - ↓ - 2. ┌ a#mdl4vqtu00 : Nat - 3. └ a#vrs8gtkl2t : Nat - - 4. b#lhigeb1let : Nat - ↓ - 5. ┌ b#aapqletas7 : Nat - 6. └ b#unkqhuu66p : Nat - - Added definitions: - - 7. patch patch (added 2 updates) - -.nsw> view a b - - a#mdl4vqtu00 : ##Nat - a#mdl4vqtu00 = 444 - - a#vrs8gtkl2t : ##Nat - a#vrs8gtkl2t = 555 - - b#aapqletas7 : ##Nat - b#aapqletas7 = ##Nat.+ a#vrs8gtkl2t 1 - - b#unkqhuu66p : ##Nat - b#unkqhuu66p = ##Nat.+ a#mdl4vqtu00 1 - -``` -## Should be able to diff a namespace hash from history. - -```unison -x = 1 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - x : ##Nat - -``` -```ucm - ☝️ The namespace .hashdiff is empty. - -.hashdiff> add - - ⍟ I've added these definitions: - - x : ##Nat - -``` -```unison -y = 2 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - y : ##Nat - -``` -```ucm -.hashdiff> add - - ⍟ I've added these definitions: - - y : ##Nat - -.hashdiff> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #ru1hnjofdj - - + Adds / updates: - - y - - □ 2. #i52j9fd57b (start of history) - -.hashdiff> diff.namespace 2 1 - - Added definitions: + ⚠️ - 1. y : ##Nat - -``` -## - -Updates: -- 1 to 1 - -New name conflicts: -- updates where RHS has multiple hashes (excluding when RHS=LHS) - - 1. foo#jk19sm5bf8 : Nat - do we want to force a hashqualified? Arya thinks so - ↓ - 2. ┌ foo#0ja1qfpej6 : Nat - 3. └ foo#jk19sm5bf8 : Nat - -Resolved name conflicts: -- updates where LHS had multiple hashes and RHS has one - - 4. ┌ bar#0ja1qfpej6 : Nat - 5. └ bar#jk19sm5bf8 : Nat - ↓ - 6. bar#jk19sm5bf8 : Nat - -## Display issues to fixup + The namespace .__projects._63858924_a9e5_435d_be39_1d1a9b4bb963.branches._7b129dcd_ed19_42e7_9a27_5e59e3627c2b.b1 doesn't exist. -- [d] Do we want to surface new edit conflicts in patches? -- [t] two different auto-propagated changes creating a name conflict should show - up somewhere besides the auto-propagate count -- [t] Things look screwy when the type signature doesn't fit and has to get broken - up into multiple lines. Maybe just disallow that? -- [d] Delete blank line in between copies / renames entries if all entries are 1 to 1 - see todo in the code -- [x] incorrectly calculated bracket alignment on hashqualified "Name changes" (delete.output.md) -- [x] just handle deletion of isPropagated in propagate function, leave HandleInput alone (assuming this does the trick) -- [x] might want unqualified names to be qualified sometimes: -- [x] if a name is updated to a not-yet-named reference, it's shown as both an update and an add -- [x] similarly, if a conflicted name is resolved by deleting the last name to - a reference, I (arya) suspect it will show up as a Remove -- [d] Maybe group and/or add headings to the types, constructors, terms -- [x] add tagging of propagated updates to test propagated updates output -- [x] missing old names in deletion ppe (delete.output.md) (superseded by \#1143) -- [x] delete.term has some bonkers output -- [x] Make a decision about how we want to show constructors in the diff -- [x] 12.patch patch needs a space -- [x] This looks like garbage -- [x] Extra 2 blank lines at the end of the add section -- [x] Fix alignment issues with buildTable, convert to column3M (to be written) -- [x] adding an alias is showing up as an Add and a Copy; should just show as Copy -- [x] removing one of multiple aliases appears in removes + moves + copies section -- [x] some overlapping cases between Moves and Copies^ -- [x] Maybe don't list the type signature twice for aliases? diff --git a/unison-src/transcripts/doc-formatting.md b/unison-src/transcripts/doc-formatting.md index 51f6c51bca..1f5a638084 100644 --- a/unison-src/transcripts/doc-formatting.md +++ b/unison-src/transcripts/doc-formatting.md @@ -3,7 +3,7 @@ This transcript explains a few minor details about doc parsing and pretty-printi Docs can be used as inline code comments. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -14,10 +14,10 @@ foo n = ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view foo +scratch/main> view foo ``` Note that `@` and `:]` must be escaped within docs. @@ -27,10 +27,10 @@ escaping = [: Docs look [: like \@this \:] :] ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view escaping +scratch/main> view escaping ``` (Alas you can't have `\@` or `\:]` in your doc, as there's currently no way to 'unescape' them.) @@ -46,10 +46,10 @@ commented = [: ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view commented +scratch/main> view commented ``` ### Indenting, and paragraph reflow @@ -64,10 +64,10 @@ doc1 = [: hi :] ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view doc1 +scratch/main> view doc1 ``` ```unison @@ -83,10 +83,10 @@ doc2 = [: hello ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view doc2 +scratch/main> view doc2 ``` ```unison @@ -105,10 +105,10 @@ Note that because of the special treatment of the first line mentioned above, wh ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view doc3 +scratch/main> view doc3 ``` ```unison @@ -120,10 +120,10 @@ doc4 = [: Here's another example of some paragraphs. ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view doc4 +scratch/main> view doc4 ``` ```unison @@ -137,10 +137,10 @@ doc5 = [: - foo ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view doc5 +scratch/main> view doc5 ``` ```unison @@ -153,10 +153,10 @@ doc6 = [: ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view doc6 +scratch/main> view doc6 ``` ### More testing @@ -168,10 +168,10 @@ empty = [::] expr = foo 1 ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view empty +scratch/main> view empty ``` ```unison @@ -214,10 +214,10 @@ para line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolo :] ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view test1 +scratch/main> view test1 ``` ```unison @@ -226,10 +226,10 @@ reg1363 = [: `@List.take foo` bar baz :] ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view reg1363 +scratch/main> view reg1363 ``` ```unison @@ -242,13 +242,13 @@ test2 = [: :] ``` ```ucm:hide -.> add +scratch/main> add ``` View is fine. ```ucm -.> view test2 +scratch/main> view test2 ``` But note it's not obvious how display should best be handling this. At the moment it just does the simplest thing: ```ucm -.> display test2 +scratch/main> display test2 ``` diff --git a/unison-src/transcripts/doc-formatting.output.md b/unison-src/transcripts/doc-formatting.output.md index d4c000906f..b472f9177a 100644 --- a/unison-src/transcripts/doc-formatting.output.md +++ b/unison-src/transcripts/doc-formatting.output.md @@ -23,7 +23,7 @@ foo n = ``` ```ucm -.> view foo +scratch/main> view foo foo : Nat -> Nat foo n = @@ -52,7 +52,7 @@ escaping = [: Docs look [: like \@this \:] :] ``` ```ucm -.> view escaping +scratch/main> view escaping escaping : Doc escaping = [: Docs look [: like \@this \:] :] @@ -84,7 +84,7 @@ commented = [: ``` ```ucm -.> view commented +scratch/main> view commented commented : Doc commented = @@ -119,7 +119,7 @@ doc1 = [: hi :] ``` ```ucm -.> view doc1 +scratch/main> view doc1 doc1 : Doc doc1 = [: hi :] @@ -151,7 +151,7 @@ doc2 = [: hello ``` ```ucm -.> view doc2 +scratch/main> view doc2 doc2 : Doc doc2 = @@ -190,7 +190,7 @@ Note that because of the special treatment of the first line mentioned above, wh ``` ```ucm -.> view doc3 +scratch/main> view doc3 doc3 : Doc doc3 = @@ -237,7 +237,7 @@ doc4 = [: Here's another example of some paragraphs. ``` ```ucm -.> view doc4 +scratch/main> view doc4 doc4 : Doc doc4 = @@ -272,7 +272,7 @@ doc5 = [: - foo ``` ```ucm -.> view doc5 +scratch/main> view doc5 doc5 : Doc doc5 = @@ -304,7 +304,7 @@ doc6 = [: ``` ```ucm -.> view doc6 +scratch/main> view doc6 doc6 : Doc doc6 = @@ -338,7 +338,7 @@ expr = foo 1 ``` ```ucm -.> view empty +scratch/main> view empty empty : Doc empty = [: :] @@ -398,7 +398,7 @@ para line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolo ``` ```ucm -.> view test1 +scratch/main> view test1 test1 : Doc test1 = @@ -480,7 +480,7 @@ reg1363 = [: `@List.take foo` bar ``` ```ucm -.> view reg1363 +scratch/main> view reg1363 reg1363 : Doc reg1363 = [: `@List.take foo` bar baz :] @@ -511,7 +511,7 @@ test2 = [: ``` View is fine. ```ucm -.> view test2 +scratch/main> view test2 test2 : Doc test2 = @@ -522,7 +522,7 @@ View is fine. ``` But note it's not obvious how display should best be handling this. At the moment it just does the simplest thing: ```ucm -.> display test2 +scratch/main> display test2 Take a look at this: foo : Nat -> Nat diff --git a/unison-src/transcripts/doc-type-link-keywords.md b/unison-src/transcripts/doc-type-link-keywords.md index a4cb0007aa..736e256dea 100644 --- a/unison-src/transcripts/doc-type-link-keywords.md +++ b/unison-src/transcripts/doc-type-link-keywords.md @@ -7,7 +7,7 @@ not the ability `Patterns`; the lexer should see this as a single identifier. See https://github.com/unisonweb/unison/issues/2642 for an example. ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -28,14 +28,14 @@ docs.example4 = {{A doc that links to the {type Labels} type}} ``` ```ucm:hide -.> add +scratch/main> add ``` Now we check that each doc links to the object of the correct name: ```ucm -.> display docs.example1 -.> display docs.example2 -.> display docs.example3 -.> display docs.example4 +scratch/main> display docs.example1 +scratch/main> display docs.example2 +scratch/main> display docs.example3 +scratch/main> display docs.example4 ``` diff --git a/unison-src/transcripts/doc-type-link-keywords.output.md b/unison-src/transcripts/doc-type-link-keywords.output.md index 9eea235a15..ed7b0b7b74 100644 --- a/unison-src/transcripts/doc-type-link-keywords.output.md +++ b/unison-src/transcripts/doc-type-link-keywords.output.md @@ -26,19 +26,19 @@ docs.example4 = {{A doc that links to the {type Labels} type}} Now we check that each doc links to the object of the correct name: ```ucm -.> display docs.example1 +scratch/main> display docs.example1 A doc that links to the abilityPatterns term -.> display docs.example2 +scratch/main> display docs.example2 A doc that links to the Patterns ability -.> display docs.example3 +scratch/main> display docs.example3 A doc that links to the typeLabels term -.> display docs.example4 +scratch/main> display docs.example4 A doc that links to the Labels type diff --git a/unison-src/transcripts/doc1.md b/unison-src/transcripts/doc1.md index 7379c47198..3f0b0b66c9 100644 --- a/unison-src/transcripts/doc1.md +++ b/unison-src/transcripts/doc1.md @@ -1,7 +1,7 @@ # Documenting Unison code ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Unison documentation is written in Unison. Documentation is a value of the following type: diff --git a/unison-src/transcripts/doc1.output.md b/unison-src/transcripts/doc1.output.md index 9fc30e1602..7f4b406469 100644 --- a/unison-src/transcripts/doc1.output.md +++ b/unison-src/transcripts/doc1.output.md @@ -3,156 +3,26 @@ Unison documentation is written in Unison. Documentation is a value of the following type: ```ucm -.builtin> view Doc - - type Doc - = Blob Text - | Link Link - | Source Link - | Signature Term - | Evaluate Term - | Join [Doc] - -``` -You can create these `Doc` values with ordinary code, or you can use the special syntax. A value of structural type `Doc` can be created via syntax like: - -```unison -doc1 = [: This is some documentation. - -It can span multiple lines. - -Can link to definitions like @List.drop or @List - -:] -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - doc1 : Doc + ☝️ The namespace .builtin is empty. -``` -Syntax: - -`[:` starts a documentation block; `:]` finishes it. Within the block: - -* Links to definitions are done with `@List`. `\@` (and `\:]`) if you want to escape. -* `@[signature] List.take` expands to the type signature of `List.take` -* `@[source] List.map` expands to the full source of `List.map` -* `@[include] someOtherDoc`, inserts a value `someOtherDoc : Doc` here. -* `@[evaluate] someDefinition` expands to the result of evaluating `someDefinition`, which must be a pre-existing definition in the codebase (can't be an arbitrary expression). - -### An example - -We are going to document `List.take` using some verbiage and a few examples. First we have to add the examples to the codebase: - -```unison -List.take.ex1 = take 0 [1,2,3,4,5] -List.take.ex2 = take 2 [1,2,3,4,5] -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - List.take.ex1 : [Nat] - List.take.ex2 : [Nat] - -``` -```ucm -.builtin> add +.builtin> view Doc - ⍟ I've added these definitions: + ⚠️ - List.take.ex1 : [Nat] - List.take.ex2 : [Nat] - -``` -And now let's write our docs and reference these examples: - -```unison -List.take.doc = [: -`@List.take n xs` returns the first `n` elements of `xs`. (No need to add line breaks manually. The display command will do wrapping of text for you. Indent any lines where you don't want it to do this.) - -## Examples: - - @[source] List.take.ex1 - 🔽 - @List.take.ex1 = @[evaluate] List.take.ex1 + The following names were not found in the codebase. Check your spelling. + Doc - - @[source] List.take.ex2 - 🔽 - @List.take.ex2 = @[evaluate] List.take.ex2 -:] ``` -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - List.take.doc : Doc - -``` -Let's add it to the codebase. -```ucm -.builtin> add - ⍟ I've added these definitions: - - List.take.doc : Doc +🛑 -``` -We can view it with `docs`, which shows the `Doc` value that is associated with a definition. +The transcript failed due to an error in the stanza above. The error is: -```ucm -.builtin> docs List.take - `List.take n xs` returns the first `n` elements of `xs`. (No - need to add line breaks manually. The display command will do - wrapping of text for you. Indent any lines where you don't - want it to do this.) - - ## Examples: - - List.take.ex1 : [Nat] - List.take.ex1 = List.take 0 [1, 2, 3, 4, 5] - 🔽 - ex1 = [] - + ⚠️ - List.take.ex2 : [Nat] - List.take.ex2 = List.take 2 [1, 2, 3, 4, 5] - 🔽 - ex2 = [1, 2] - - -``` -Note that if we view the source of the documentation, the various references are *not* expanded. + The following names were not found in the codebase. Check your spelling. + Doc -```ucm -.builtin> view List.take - - builtin List.take : Nat -> [a] -> [a] - -``` diff --git a/unison-src/transcripts/doc2.md b/unison-src/transcripts/doc2.md index 278cc8f493..32cb274290 100644 --- a/unison-src/transcripts/doc2.md +++ b/unison-src/transcripts/doc2.md @@ -1,7 +1,7 @@ # Test parsing and round-trip of doc2 syntax elements ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -114,5 +114,5 @@ Inline '' text literal with 1 space of padding '' in the middle of a sentence. Format it to check that everything pretty-prints in a valid way. ```ucm -.> debug.format +scratch/main> debug.format ``` diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md index e303b639a4..7cb162400f 100644 --- a/unison-src/transcripts/doc2.output.md +++ b/unison-src/transcripts/doc2.output.md @@ -110,7 +110,7 @@ Inline '' text literal with 1 space of padding '' in the middle of a sentence. Format it to check that everything pretty-prints in a valid way. ```ucm -.> debug.format +scratch/main> debug.format ``` ```unison:added-by-ucm scratch.u diff --git a/unison-src/transcripts/doc2markdown.md b/unison-src/transcripts/doc2markdown.md index a7ac7a808b..89b068a297 100644 --- a/unison-src/transcripts/doc2markdown.md +++ b/unison-src/transcripts/doc2markdown.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -86,11 +86,11 @@ Table ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> debug.doc-to-markdown fulldoc +scratch/main> debug.doc-to-markdown fulldoc ``` You can add docs to a term or type with a top-level doc literal above the binding: diff --git a/unison-src/transcripts/doc2markdown.output.md b/unison-src/transcripts/doc2markdown.output.md index c9b98f984f..5475c1cbf5 100644 --- a/unison-src/transcripts/doc2markdown.output.md +++ b/unison-src/transcripts/doc2markdown.output.md @@ -82,7 +82,7 @@ Table ``` ```ucm -.> debug.doc-to-markdown fulldoc +scratch/main> debug.doc-to-markdown fulldoc Heres some text with a soft line break diff --git a/unison-src/transcripts/duplicate-names.md b/unison-src/transcripts/duplicate-names.md index 2935a401b9..d40cc9e821 100644 --- a/unison-src/transcripts/duplicate-names.md +++ b/unison-src/transcripts/duplicate-names.md @@ -1,7 +1,7 @@ # Duplicate names in scratch file. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Term and ability constructor collisions should cause a parse error. @@ -49,6 +49,6 @@ X = () ``` ```ucm -.> add -.> view X +scratch/main> add +scratch/main> view X ``` diff --git a/unison-src/transcripts/duplicate-names.output.md b/unison-src/transcripts/duplicate-names.output.md index 7e82b2e04b..9a15abbb7b 100644 --- a/unison-src/transcripts/duplicate-names.output.md +++ b/unison-src/transcripts/duplicate-names.output.md @@ -125,7 +125,7 @@ X = () ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -133,7 +133,7 @@ X = () (also named builtin.Unit) X : () -.> view X +scratch/main> view X structural type X = Z diff --git a/unison-src/transcripts/duplicate-term-detection.md b/unison-src/transcripts/duplicate-term-detection.md index 61b2a8ebf1..3df20584b7 100644 --- a/unison-src/transcripts/duplicate-term-detection.md +++ b/unison-src/transcripts/duplicate-term-detection.md @@ -1,7 +1,7 @@ # Duplicate Term Detection ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` diff --git a/unison-src/transcripts/ed25519.md b/unison-src/transcripts/ed25519.md index 679a8900a0..b7f7860c98 100644 --- a/unison-src/transcripts/ed25519.md +++ b/unison-src/transcripts/ed25519.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/edit-command.md b/unison-src/transcripts/edit-command.md index 4c4edc9e4c..106b28fea4 100644 --- a/unison-src/transcripts/edit-command.md +++ b/unison-src/transcripts/edit-command.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison /private/tmp/scratch.u @@ -11,11 +11,11 @@ mytest = [Ok "ok"] ``` ```ucm -.> add -.> edit foo bar -.> edit mytest +scratch/main> add +scratch/main> edit foo bar +scratch/main> edit mytest ``` ```ucm:error -.> edit missing +scratch/main> edit missing ``` diff --git a/unison-src/transcripts/edit-command.output.md b/unison-src/transcripts/edit-command.output.md index a4c428e281..644db7ce70 100644 --- a/unison-src/transcripts/edit-command.output.md +++ b/unison-src/transcripts/edit-command.output.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. @@ -33,7 +33,7 @@ mytest = [Ok "ok"] ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -41,7 +41,7 @@ mytest = [Ok "ok"] foo : Nat mytest : [Result] -.> edit foo bar +scratch/main> edit foo bar ☝️ @@ -50,7 +50,7 @@ mytest = [Ok "ok"] You can edit them there, then run `update` to replace the definitions currently in this namespace. -.> edit mytest +scratch/main> edit mytest ☝️ @@ -73,7 +73,7 @@ test> mytest = [Ok "ok"] ``` ```ucm -.> edit missing +scratch/main> edit missing ⚠️ diff --git a/unison-src/transcripts/empty-namespaces.md b/unison-src/transcripts/empty-namespaces.md index 223ab34ba9..a4d22fa805 100644 --- a/unison-src/transcripts/empty-namespaces.md +++ b/unison-src/transcripts/empty-namespaces.md @@ -5,19 +5,19 @@ mynamespace.x = 1 ``` ```ucm:hide -.> add -.> delete.namespace mynamespace +scratch/main> add +scratch/main> delete.namespace mynamespace ``` The deleted namespace shouldn't appear in `ls` output. ```ucm:error -.> ls +scratch/main> ls ``` ```ucm:error -.> find.verbose +scratch/main> find.verbose ``` ```ucm:error -.> find mynamespace +scratch/main> find mynamespace ``` ## history @@ -25,7 +25,7 @@ The deleted namespace shouldn't appear in `ls` output. The history of the namespace should be empty. ```ucm -.> history mynamespace +scratch/main> history mynamespace ``` Merging an empty namespace should be a no-op @@ -44,8 +44,8 @@ stuff.thing = 2 ``` ```ucm:hide -.> add -.> delete.namespace deleted +scratch/main> add +scratch/main> delete.namespace deleted ``` ## fork @@ -53,14 +53,14 @@ stuff.thing = 2 I should be allowed to fork over a deleted namespace ```ucm -.> fork stuff deleted +scratch/main> fork stuff deleted ``` The history from the `deleted` namespace should have been overwritten by the history from `stuff`. ```ucm -.> history stuff -.> history deleted +scratch/main> history stuff +scratch/main> history deleted ``` ## move.namespace @@ -71,15 +71,15 @@ moveme.y = 2 ``` ```ucm:hide -.> add +scratch/main> add ``` I should be able to move a namespace over-top of a deleted namespace. The history should be that of the moved namespace. ```ucm -.> delete.namespace moveoverme -.> history moveme -.> move.namespace moveme moveoverme -.> history moveoverme +scratch/main> delete.namespace moveoverme +scratch/main> history moveme +scratch/main> move.namespace moveme moveoverme +scratch/main> history moveoverme ``` diff --git a/unison-src/transcripts/empty-namespaces.output.md b/unison-src/transcripts/empty-namespaces.output.md index 16d33046e1..092bebe1ee 100644 --- a/unison-src/transcripts/empty-namespaces.output.md +++ b/unison-src/transcripts/empty-namespaces.output.md @@ -6,13 +6,13 @@ mynamespace.x = 1 The deleted namespace shouldn't appear in `ls` output. ```ucm -.> ls +scratch/main> ls nothing to show ``` ```ucm -.> find.verbose +scratch/main> find.verbose ☝️ @@ -29,7 +29,7 @@ The deleted namespace shouldn't appear in `ls` output. ``` ```ucm -.> find mynamespace +scratch/main> find mynamespace ☝️ @@ -50,9 +50,9 @@ The deleted namespace shouldn't appear in `ls` output. The history of the namespace should be empty. ```ucm -.> history mynamespace +scratch/main> history mynamespace - ☝️ The namespace .mynamespace is empty. + ☝️ The namespace mynamespace is empty. ``` Merging an empty namespace should be a no-op @@ -87,7 +87,7 @@ stuff.thing = 2 I should be allowed to fork over a deleted namespace ```ucm -.> fork stuff deleted +scratch/main> fork stuff deleted Done. @@ -95,7 +95,7 @@ I should be allowed to fork over a deleted namespace The history from the `deleted` namespace should have been overwritten by the history from `stuff`. ```ucm -.> history stuff +scratch/main> history stuff Note: The most recent namespace hash is immediately below this message. @@ -104,7 +104,7 @@ The history from the `deleted` namespace should have been overwritten by the his □ 1. #q2dq4tsno1 (start of history) -.> history deleted +scratch/main> history deleted Note: The most recent namespace hash is immediately below this message. @@ -125,11 +125,11 @@ I should be able to move a namespace over-top of a deleted namespace. The history should be that of the moved namespace. ```ucm -.> delete.namespace moveoverme +scratch/main> delete.namespace moveoverme Done. -.> history moveme +scratch/main> history moveme Note: The most recent namespace hash is immediately below this message. @@ -138,11 +138,11 @@ The history should be that of the moved namespace. □ 1. #c5uisu4kll (start of history) -.> move.namespace moveme moveoverme +scratch/main> move.namespace moveme moveoverme Done. -.> history moveoverme +scratch/main> history moveoverme Note: The most recent namespace hash is immediately below this message. diff --git a/unison-src/transcripts/emptyCodebase.md b/unison-src/transcripts/emptyCodebase.md index a9ea55b850..c7b939a3bb 100644 --- a/unison-src/transcripts/emptyCodebase.md +++ b/unison-src/transcripts/emptyCodebase.md @@ -7,7 +7,7 @@ Not even `Nat` or `+`! BEHOLD!!! ```ucm:error -.> ls +scratch/main> ls ``` Technically, the definitions all exist, but they have no names. `builtins.merge` brings them into existence, under the current namespace: diff --git a/unison-src/transcripts/emptyCodebase.output.md b/unison-src/transcripts/emptyCodebase.output.md index 672ac4857a..efa0854ec0 100644 --- a/unison-src/transcripts/emptyCodebase.output.md +++ b/unison-src/transcripts/emptyCodebase.output.md @@ -7,7 +7,7 @@ Not even `Nat` or `+`! BEHOLD!!! ```ucm -.> ls +scratch/main> ls nothing to show diff --git a/unison-src/transcripts/error-messages.md b/unison-src/transcripts/error-messages.md index de58eb43b9..8490e491a2 100644 --- a/unison-src/transcripts/error-messages.md +++ b/unison-src/transcripts/error-messages.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This file contains programs with parse errors and type errors, for visual inspection of error message quality and to check for regressions or changes to error reporting. diff --git a/unison-src/transcripts/errors/missing-result-typed.md b/unison-src/transcripts/errors/missing-result-typed.md index 47a3eb7920..c61c2ccef7 100644 --- a/unison-src/transcripts/errors/missing-result-typed.md +++ b/unison-src/transcripts/errors/missing-result-typed.md @@ -6,7 +6,7 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide:all diff --git a/unison-src/transcripts/errors/ucm-hide-all-error.md b/unison-src/transcripts/errors/ucm-hide-all-error.md index dcf94d8d32..5952056f48 100644 --- a/unison-src/transcripts/errors/ucm-hide-all-error.md +++ b/unison-src/transcripts/errors/ucm-hide-all-error.md @@ -8,5 +8,5 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm:hide:all:error -.> history +scratch/main> history ``` diff --git a/unison-src/transcripts/errors/ucm-hide-all-error.output.md b/unison-src/transcripts/errors/ucm-hide-all-error.output.md index e3a9558abd..9b8c0b43ee 100644 --- a/unison-src/transcripts/errors/ucm-hide-all-error.output.md +++ b/unison-src/transcripts/errors/ucm-hide-all-error.output.md @@ -8,7 +8,7 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm -.> history +scratch/main> history ``` diff --git a/unison-src/transcripts/errors/ucm-hide-all.md b/unison-src/transcripts/errors/ucm-hide-all.md index 22950a9334..dd4b963dfa 100644 --- a/unison-src/transcripts/errors/ucm-hide-all.md +++ b/unison-src/transcripts/errors/ucm-hide-all.md @@ -8,5 +8,5 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm:hide:all -.> move.namespace foo bar +scratch/main> move.namespace foo bar ``` diff --git a/unison-src/transcripts/errors/ucm-hide-all.output.md b/unison-src/transcripts/errors/ucm-hide-all.output.md index 38ec6f09f5..56cf454d4c 100644 --- a/unison-src/transcripts/errors/ucm-hide-all.output.md +++ b/unison-src/transcripts/errors/ucm-hide-all.output.md @@ -8,7 +8,7 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm -.> move.namespace foo bar +scratch/main> move.namespace foo bar ``` diff --git a/unison-src/transcripts/errors/ucm-hide-error.md b/unison-src/transcripts/errors/ucm-hide-error.md index 68da57efc2..9b338dfd96 100644 --- a/unison-src/transcripts/errors/ucm-hide-error.md +++ b/unison-src/transcripts/errors/ucm-hide-error.md @@ -8,5 +8,5 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm:hide:error -.> history +scratch/main> history ``` diff --git a/unison-src/transcripts/errors/ucm-hide-error.output.md b/unison-src/transcripts/errors/ucm-hide-error.output.md index 0056a35888..3e80bd4a7b 100644 --- a/unison-src/transcripts/errors/ucm-hide-error.output.md +++ b/unison-src/transcripts/errors/ucm-hide-error.output.md @@ -8,7 +8,7 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm -.> history +scratch/main> history ``` diff --git a/unison-src/transcripts/errors/ucm-hide.md b/unison-src/transcripts/errors/ucm-hide.md index aa725ada4c..470c610b52 100644 --- a/unison-src/transcripts/errors/ucm-hide.md +++ b/unison-src/transcripts/errors/ucm-hide.md @@ -8,5 +8,5 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm:hide -.> move.namespace foo bar +scratch/main> move.namespace foo bar ``` diff --git a/unison-src/transcripts/errors/ucm-hide.output.md b/unison-src/transcripts/errors/ucm-hide.output.md index fe4faa583d..2c88db7f5a 100644 --- a/unison-src/transcripts/errors/ucm-hide.output.md +++ b/unison-src/transcripts/errors/ucm-hide.output.md @@ -8,7 +8,7 @@ then the transcript parser should print the stanza and surface a helpful message. ```ucm -.> move.namespace foo bar +scratch/main> move.namespace foo bar ``` diff --git a/unison-src/transcripts/find-by-type.md b/unison-src/transcripts/find-by-type.md index 009ad845e5..ec6dd3f954 100644 --- a/unison-src/transcripts/find-by-type.md +++ b/unison-src/transcripts/find-by-type.md @@ -1,5 +1,5 @@ ```ucm:hide -.> alias.type ##Text builtin.Text +scratch/main> alias.type ##Text builtin.Text ``` ```unison:hide @@ -17,11 +17,11 @@ baz = cases ``` ```ucm -.> add -.> find : Text -> A -.> find : A -> Text -.> find : A +scratch/main> add +scratch/main> find : Text -> A +scratch/main> find : A -> Text +scratch/main> find : A ``` ```ucm:error -.> find : Text +scratch/main> find : Text ``` diff --git a/unison-src/transcripts/find-by-type.output.md b/unison-src/transcripts/find-by-type.output.md index 0577051f92..4fcbf2d85a 100644 --- a/unison-src/transcripts/find-by-type.output.md +++ b/unison-src/transcripts/find-by-type.output.md @@ -13,7 +13,7 @@ baz = cases ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -22,25 +22,25 @@ baz = cases baz : A -> Text foo : A -.> find : Text -> A +scratch/main> find : Text -> A 1. bar : Text -> A 2. A.A : Text -> A -.> find : A -> Text +scratch/main> find : A -> Text 1. baz : A -> Text -.> find : A +scratch/main> find : A 1. foo : A ``` ```ucm -.> find : Text +scratch/main> find : Text ☝️ diff --git a/unison-src/transcripts/find-command.md b/unison-src/transcripts/find-command.md index 46f852dd35..43e06de137 100644 --- a/unison-src/transcripts/find-command.md +++ b/unison-src/transcripts/find-command.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge -.> move builtin lib.builtin +scratch/main> builtins.merge +scratch/main> move builtin lib.builtin ``` ```unison:hide @@ -14,21 +14,21 @@ somewhere.bar = 7 ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> find foo -.> view 1 -.> find.all foo -.> view 1 +scratch/main> find foo +scratch/main> view 1 +scratch/main> find.all foo +scratch/main> view 1 ``` ```ucm -.> find-in cat foo -.> view 1 -.> find-in.all cat foo -.> view 1 +scratch/main> find-in cat foo +scratch/main> view 1 +scratch/main> find-in.all cat foo +scratch/main> view 1 ``` ```ucm @@ -37,14 +37,14 @@ somewhere.bar = 7 ``` ```ucm -.> find bar -.> find-in somewhere bar +scratch/main> find bar +scratch/main> find-in somewhere bar ``` ```ucm:error -.> find baz +scratch/main> find baz ``` ```ucm:error -.> find.global notHere +scratch/main> find.global notHere ``` diff --git a/unison-src/transcripts/find-command.output.md b/unison-src/transcripts/find-command.output.md index f3a11b8913..2b7ffcf65b 100644 --- a/unison-src/transcripts/find-command.output.md +++ b/unison-src/transcripts/find-command.output.md @@ -9,18 +9,18 @@ somewhere.bar = 7 ``` ```ucm -.> find foo +scratch/main> find foo 1. cat.foo : Nat 2. foo : Nat -.> view 1 +scratch/main> view 1 cat.foo : Nat cat.foo = 4 -.> find.all foo +scratch/main> find.all foo 1. cat.foo : Nat 2. cat.lib.foo : Nat @@ -28,63 +28,39 @@ somewhere.bar = 7 4. foo : Nat -.> view 1 +scratch/main> view 1 cat.foo : Nat cat.foo = 4 ``` ```ucm -.> find-in cat foo +scratch/main> find-in cat foo 1. foo : Nat -.> view 1 +scratch/main> view 1 cat.foo : Nat cat.foo = 4 -.> find-in.all cat foo +scratch/main> find-in.all cat foo 1. lib.foo : Nat 2. foo : Nat -.> view 1 +scratch/main> view 1 cat.lib.foo : Nat cat.lib.foo = 5 ``` ```ucm -.somewhere> find bar - - 1. bar : ##Nat - - -.somewhere> find.global bar - - 1. .cat.lib.bar : Nat - 2. .lib.bar : Nat - 3. .somewhere.bar : Nat - - -``` -```ucm -.> find bar - - 1. somewhere.bar : Nat - - -.> find-in somewhere bar - - 1. bar : Nat - + ☝️ The namespace .somewhere is empty. -``` -```ucm -.> find baz +.somewhere> find bar ☝️ @@ -100,13 +76,22 @@ somewhere.bar = 7 namespace. ``` + ```ucm -.> find.global notHere +.somewhere> find bar.somewhere> find.global bar +``` + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + 😶 No results. Check your spelling, or try using tab completion to supply command arguments. + `find.global` can be used to search outside the current + namespace. -``` diff --git a/unison-src/transcripts/fix-1381-excess-propagate.md b/unison-src/transcripts/fix-1381-excess-propagate.md index 84da98c5bc..e7314c9bd7 100644 --- a/unison-src/transcripts/fix-1381-excess-propagate.md +++ b/unison-src/transcripts/fix-1381-excess-propagate.md @@ -7,7 +7,7 @@ X.foo = "a namespace" ``` ```ucm -.> add +scratch/main> add ``` Here is an update which should not affect `X`: @@ -15,14 +15,14 @@ Here is an update which should not affect `X`: a = "an update" ``` ```ucm -.> update +scratch/main> update ``` As of the time of this writing, the history for `X` should be a single node, `#4eeuo5bsfr`; ```ucm -.> history X +scratch/main> history X ``` however, as of release/M1i, we saw an extraneous node appear. If your `ucm` is fixed, you won't see it below: ```ucm:error -.> history #7nl6ppokhg +scratch/main> history #7nl6ppokhg ``` diff --git a/unison-src/transcripts/fix-1381-excess-propagate.output.md b/unison-src/transcripts/fix-1381-excess-propagate.output.md index f07217266b..d35a892620 100644 --- a/unison-src/transcripts/fix-1381-excess-propagate.output.md +++ b/unison-src/transcripts/fix-1381-excess-propagate.output.md @@ -7,7 +7,7 @@ X.foo = "a namespace" ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -21,7 +21,7 @@ a = "an update" ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -31,7 +31,7 @@ a = "an update" ``` As of the time of this writing, the history for `X` should be a single node, `#4eeuo5bsfr`; ```ucm -.> history X +scratch/main> history X Note: The most recent namespace hash is immediately below this message. @@ -43,7 +43,7 @@ As of the time of this writing, the history for `X` should be a single node, `#4 ``` however, as of release/M1i, we saw an extraneous node appear. If your `ucm` is fixed, you won't see it below: ```ucm -.> history #7nl6ppokhg +scratch/main> history #7nl6ppokhg 😶 diff --git a/unison-src/transcripts/fix-2258-if-as-list-element.md b/unison-src/transcripts/fix-2258-if-as-list-element.md index fbf9cc93dd..1ebc3a2250 100644 --- a/unison-src/transcripts/fix-2258-if-as-list-element.md +++ b/unison-src/transcripts/fix-2258-if-as-list-element.md @@ -1,7 +1,7 @@ Tests that `if` statements can appear as list and tuple elements. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide diff --git a/unison-src/transcripts/fix-big-list-crash.md b/unison-src/transcripts/fix-big-list-crash.md index 22be8f0cb1..70c056515d 100644 --- a/unison-src/transcripts/fix-big-list-crash.md +++ b/unison-src/transcripts/fix-big-list-crash.md @@ -1,7 +1,7 @@ #### Big list crash ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Big lists have been observed to crash, while in the garbage collection step. diff --git a/unison-src/transcripts/fix1063.md b/unison-src/transcripts/fix1063.md index a7160f3564..03ea62be7e 100644 --- a/unison-src/transcripts/fix1063.md +++ b/unison-src/transcripts/fix1063.md @@ -1,7 +1,7 @@ Tests that functions named `.` are rendered correctly. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ``` unison @@ -13,7 +13,7 @@ noop = not `.` not ``` ``` ucm -.> add -.> view noop +scratch/main> add +scratch/main> view noop ``` diff --git a/unison-src/transcripts/fix1063.output.md b/unison-src/transcripts/fix1063.output.md index 80a1cc8a26..d9d2e8380f 100644 --- a/unison-src/transcripts/fix1063.output.md +++ b/unison-src/transcripts/fix1063.output.md @@ -23,14 +23,14 @@ noop = not `.` not ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: `.` : (i1 ->{g1} o) -> (i ->{g} i1) -> i ->{g1, g} o noop : Boolean -> Boolean -.> view noop +scratch/main> view noop noop : Boolean -> Boolean noop = diff --git a/unison-src/transcripts/fix1334.md b/unison-src/transcripts/fix1334.md index 68e6967481..5ab5899aeb 100644 --- a/unison-src/transcripts/fix1334.md +++ b/unison-src/transcripts/fix1334.md @@ -5,6 +5,6 @@ With this PR, the source of an alias can be a short hash (even of a definition t Let's make some hash-only aliases, now that we can. :mad-with-power-emoji: ```ucm -.> alias.type ##Nat Cat -.> alias.term ##Nat.+ please_fix_763.+ +scratch/main> alias.type ##Nat Cat +scratch/main> alias.term ##Nat.+ please_fix_763.+ ``` diff --git a/unison-src/transcripts/fix1334.output.md b/unison-src/transcripts/fix1334.output.md index d397a51a1a..4e08c294b9 100644 --- a/unison-src/transcripts/fix1334.output.md +++ b/unison-src/transcripts/fix1334.output.md @@ -5,11 +5,11 @@ With this PR, the source of an alias can be a short hash (even of a definition t Let's make some hash-only aliases, now that we can. :mad-with-power-emoji: ```ucm -.> alias.type ##Nat Cat +scratch/main> alias.type ##Nat Cat Done. -.> alias.term ##Nat.+ please_fix_763.+ +scratch/main> alias.term ##Nat.+ please_fix_763.+ Done. diff --git a/unison-src/transcripts/fix1390.md b/unison-src/transcripts/fix1390.md index 807cb14d25..2ef5e8ac97 100644 --- a/unison-src/transcripts/fix1390.md +++ b/unison-src/transcripts/fix1390.md @@ -1,6 +1,6 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -13,8 +13,8 @@ List.map f = ``` ```ucm -.> add -.> view List.map +scratch/main> add +scratch/main> view List.map ``` ```unison diff --git a/unison-src/transcripts/fix1390.output.md b/unison-src/transcripts/fix1390.output.md index 67155bde52..164f3a8a61 100644 --- a/unison-src/transcripts/fix1390.output.md +++ b/unison-src/transcripts/fix1390.output.md @@ -1,6 +1,6 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. @@ -28,13 +28,13 @@ List.map f = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: List.map : (i ->{g} o) -> [i] ->{g} [o] -.> view List.map +scratch/main> view List.map List.map : (i ->{g} o) -> [i] ->{g} [o] List.map f = diff --git a/unison-src/transcripts/fix1532.md b/unison-src/transcripts/fix1532.md index 6b5a07c938..fc835cc46c 100644 --- a/unison-src/transcripts/fix1532.md +++ b/unison-src/transcripts/fix1532.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` First, lets create two namespaces. `foo` and `bar`, and add some definitions. @@ -11,30 +11,30 @@ bar.z = x + y ``` ```ucm -.> add +scratch/main> add ``` Let's see what we have created... ```ucm -.> ls +scratch/main> ls ``` Now, if we try deleting the namespace `foo`, we get an error, as expected. ```ucm:error -.> delete.namespace foo +scratch/main> delete.namespace foo ``` Any numbered arguments should refer to `bar.z`. ```ucm -.> debug.numberedArgs +scratch/main> debug.numberedArgs ``` We can then delete the dependent term, and then delete `foo`. ```ucm -.> delete.term 1 -.> delete.namespace foo +scratch/main> delete.term 1 +scratch/main> delete.namespace foo ``` diff --git a/unison-src/transcripts/fix1532.output.md b/unison-src/transcripts/fix1532.output.md index d2707bb51a..6b856b35e9 100644 --- a/unison-src/transcripts/fix1532.output.md +++ b/unison-src/transcripts/fix1532.output.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. @@ -28,7 +28,7 @@ bar.z = x + y ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -40,7 +40,7 @@ bar.z = x + y Let's see what we have created... ```ucm -.> ls +scratch/main> ls 1. bar/ (1 term) 2. builtin/ (469 terms, 74 types) @@ -50,7 +50,7 @@ Let's see what we have created... Now, if we try deleting the namespace `foo`, we get an error, as expected. ```ucm -.> delete.namespace foo +scratch/main> delete.namespace foo ⚠️ @@ -69,7 +69,7 @@ Now, if we try deleting the namespace `foo`, we get an error, as expected. Any numbered arguments should refer to `bar.z`. ```ucm -.> debug.numberedArgs +scratch/main> debug.numberedArgs 1. bar.z 2. bar.z @@ -78,11 +78,11 @@ Any numbered arguments should refer to `bar.z`. We can then delete the dependent term, and then delete `foo`. ```ucm -.> delete.term 1 +scratch/main> delete.term 1 Done. -.> delete.namespace foo +scratch/main> delete.namespace foo Done. diff --git a/unison-src/transcripts/fix1578.md b/unison-src/transcripts/fix1578.md index 8e2e7958f3..809af6c161 100644 --- a/unison-src/transcripts/fix1578.md +++ b/unison-src/transcripts/fix1578.md @@ -3,7 +3,7 @@ This transcript shows how suffix-based name resolution works when definitions in ## Setup ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` As setup, we'll add a data type `Day` and a definition `foo.bar : Nat`. @@ -16,7 +16,7 @@ foo.bar = 23 ``` ```ucm:hide -.> add +scratch/main> add ``` Suffix-based name resolution prefers to use names locally defined in the current file, then checks for matches in the codebase. Here are the precise rules, which will be explained below with examples: diff --git a/unison-src/transcripts/fix1696.md b/unison-src/transcripts/fix1696.md index c80b41a731..4abb83f185 100644 --- a/unison-src/transcripts/fix1696.md +++ b/unison-src/transcripts/fix1696.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:error diff --git a/unison-src/transcripts/fix1731.md b/unison-src/transcripts/fix1731.md index 81adcd8de2..82efd3cce9 100644 --- a/unison-src/transcripts/fix1731.md +++ b/unison-src/transcripts/fix1731.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -10,7 +10,7 @@ structural ability CLI where ``` ```ucm:hide -.> add +scratch/main> add ``` The `input` here should parse as a wildcard, not as `CLI.input`. diff --git a/unison-src/transcripts/fix1800.md b/unison-src/transcripts/fix1800.md index a35edb8a2d..533d95d847 100644 --- a/unison-src/transcripts/fix1800.md +++ b/unison-src/transcripts/fix1800.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -26,21 +26,21 @@ Testing a few variations here: * Should be able to run annotated and unannotated main functions from the codebase. ```ucm -.> run main1 -.> run main2 -.> run main3 -.> add -.> rename.term main1 code.main1 -.> rename.term main2 code.main2 -.> rename.term main3 code.main3 +scratch/main> run main1 +scratch/main> run main2 +scratch/main> run main3 +scratch/main> add +scratch/main> rename.term main1 code.main1 +scratch/main> rename.term main2 code.main2 +scratch/main> rename.term main3 code.main3 ``` The renaming just ensures that when running `code.main1`, it has to get that main from the codebase rather than the scratch file: ```ucm -.> run code.main1 -.> run code.main2 -.> run code.main3 +scratch/main> run code.main1 +scratch/main> run code.main2 +scratch/main> run code.main3 ``` Now testing a few variations that should NOT typecheck. @@ -56,9 +56,9 @@ main5 _ = () This shouldn't work since `main4` and `main5` don't have the right type. ```ucm:error -.> run main4 +scratch/main> run main4 ``` ```ucm:error -.> run main5 +scratch/main> run main5 ``` diff --git a/unison-src/transcripts/fix1800.output.md b/unison-src/transcripts/fix1800.output.md index 0a534138a4..915f50e70a 100644 --- a/unison-src/transcripts/fix1800.output.md +++ b/unison-src/transcripts/fix1800.output.md @@ -22,19 +22,19 @@ Testing a few variations here: * Should be able to run annotated and unannotated main functions from the codebase. ```ucm -.> run main1 +scratch/main> run main1 () -.> run main2 +scratch/main> run main2 () -.> run main3 +scratch/main> run main3 () -.> add +scratch/main> add ⍟ I've added these definitions: @@ -43,15 +43,15 @@ Testing a few variations here: main3 : '{IO} () printLine : Text ->{IO} () -.> rename.term main1 code.main1 +scratch/main> rename.term main1 code.main1 Done. -.> rename.term main2 code.main2 +scratch/main> rename.term main2 code.main2 Done. -.> rename.term main3 code.main3 +scratch/main> rename.term main3 code.main3 Done. @@ -59,15 +59,15 @@ Testing a few variations here: The renaming just ensures that when running `code.main1`, it has to get that main from the codebase rather than the scratch file: ```ucm -.> run code.main1 +scratch/main> run code.main1 () -.> run code.main2 +scratch/main> run code.main2 () -.> run code.main3 +scratch/main> run code.main3 () @@ -85,7 +85,7 @@ main5 _ = () This shouldn't work since `main4` and `main5` don't have the right type. ```ucm -.> run main4 +scratch/main> run main4 😶 @@ -99,7 +99,7 @@ This shouldn't work since `main4` and `main5` don't have the right type. ``` ```ucm -.> run main5 +scratch/main> run main5 😶 diff --git a/unison-src/transcripts/fix1926.md b/unison-src/transcripts/fix1926.md index 373cb0e95a..0ebe0e3c8f 100644 --- a/unison-src/transcripts/fix1926.md +++ b/unison-src/transcripts/fix1926.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix1926.output.md b/unison-src/transcripts/fix1926.output.md index 9eeb00583a..a325470e95 100644 --- a/unison-src/transcripts/fix1926.output.md +++ b/unison-src/transcripts/fix1926.output.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. diff --git a/unison-src/transcripts/fix2000.md b/unison-src/transcripts/fix2000.md index 812ec10df0..e72a573af2 100644 --- a/unison-src/transcripts/fix2000.md +++ b/unison-src/transcripts/fix2000.md @@ -2,7 +2,7 @@ Checks that squash and merge do the same thing, with nontrivial history that includes a merge conflict. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,11 +11,11 @@ x.a.q = "ef" ``` ```ucm -.> add -.> fork x y -.> fork x s -.> fork x m -.> delete.verbose y.a.p +scratch/main> add +scratch/main> fork x y +scratch/main> fork x s +scratch/main> fork x m +scratch/main> delete.verbose y.a.p ``` ```unison @@ -23,7 +23,7 @@ y.a.p = "fij" ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -33,11 +33,11 @@ y.b.p = "wie" Merge back into the ancestor. ```ucm -.> add -.> merge.old y.b y.a -.> delete.term.verbose 1 -.> merge.old y m -.> merge.old.squash y s +scratch/main> add +scratch/main> merge.old y.b y.a +scratch/main> delete.term.verbose 1 +scratch/main> merge.old y m +scratch/main> merge.old.squash y s .s> todo .m> todo ``` diff --git a/unison-src/transcripts/fix2000.output.md b/unison-src/transcripts/fix2000.output.md index cd388f7e55..38940b1a70 100644 --- a/unison-src/transcripts/fix2000.output.md +++ b/unison-src/transcripts/fix2000.output.md @@ -21,26 +21,26 @@ x.a.q = "ef" ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: x.a.p : Text x.a.q : Text -.> fork x y +scratch/main> fork x y Done. -.> fork x s +scratch/main> fork x s Done. -.> fork x m +scratch/main> fork x m Done. -.> delete.verbose y.a.p +scratch/main> delete.verbose y.a.p Name changes: @@ -71,7 +71,7 @@ y.a.p = "fij" ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -98,13 +98,13 @@ y.b.p = "wie" Merge back into the ancestor. ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: y.b.p : Text -.> merge.old y.b y.a +scratch/main> merge.old y.b y.a Here's what's changed in y.a after the merge: @@ -122,7 +122,7 @@ Merge back into the ancestor. Applying changes from patch... -.> delete.term.verbose 1 +scratch/main> delete.term.verbose 1 Resolved name conflicts: @@ -133,7 +133,7 @@ Merge back into the ancestor. Tip: You can use `undo` or `reflog` to undo this change. -.> merge.old y m +scratch/main> merge.old y m Here's what's changed in m after the merge: @@ -155,7 +155,7 @@ Merge back into the ancestor. Applying changes from patch... -.> merge.old.squash y s +scratch/main> merge.old.squash y s Here's what's changed in s after the merge: @@ -177,10 +177,14 @@ Merge back into the ancestor. Applying changes from patch... + ☝️ The namespace .s is empty. + .s> todo + ☝️ The namespace .m is empty. + .m> todo diff --git a/unison-src/transcripts/fix2004.md b/unison-src/transcripts/fix2004.md index ab33da9e7f..761218bb62 100644 --- a/unison-src/transcripts/fix2004.md +++ b/unison-src/transcripts/fix2004.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Here's the scenario that can produce bad empty namespace LCAs: @@ -23,42 +23,42 @@ So `j1` and `j2` have common history up through `v4`, then `j1` deletes some def First, we create some common history before a fork: ```ucm -.> alias.term builtin.Nat.+ a.delete1 -.> alias.term builtin.Nat.* a.delete2 -.> alias.term builtin.Nat.drop a.delete3 -.> alias.type builtin.Nat a.Delete4 +scratch/main> alias.term builtin.Nat.+ a.delete1 +scratch/main> alias.term builtin.Nat.* a.delete2 +scratch/main> alias.term builtin.Nat.drop a.delete3 +scratch/main> alias.type builtin.Nat a.Delete4 ``` Now we fork `a2` off of `a`. `a` continues on, deleting the terms it added previously and then adding one unrelated term via a merge with little history. It's this short history merge which will become a bad LCA of the empty namespace. ```ucm -.> fork a a2 -.> delete.term.verbose a.delete1 -.> delete.term.verbose a.delete2 -.> delete.term.verbose a.delete3 -.> delete.type.verbose a.Delete4 -.> alias.term .builtin.Float.+ newbranchA.dontDelete -.> merge.old newbranchA a +scratch/main> fork a a2 +scratch/main> delete.term.verbose a.delete1 +scratch/main> delete.term.verbose a.delete2 +scratch/main> delete.term.verbose a.delete3 +scratch/main> delete.type.verbose a.Delete4 +scratch/main> alias.term .builtin.Float.+ newbranchA.dontDelete +scratch/main> merge.old newbranchA a .a> find ``` Meanwhile, `a2` adds some other unrelated terms, some via merging in namespaces with little history. When merging `a2` back into `a`, the deletes from their common history should be respected. ```ucm -.> alias.term builtin.Text.take a2.keep1 -.> alias.term builtin.Text.take a2.keep2 -.> alias.term builtin.Text.take a2.keep3 -.> alias.term builtin.Text.take a2.keep4 -.> alias.term builtin.Text.take a2.keep5 -.> alias.term builtin.Text.take newbranchA2.keep6 -.> merge.old newbranchA2 a2 +scratch/main> alias.term builtin.Text.take a2.keep1 +scratch/main> alias.term builtin.Text.take a2.keep2 +scratch/main> alias.term builtin.Text.take a2.keep3 +scratch/main> alias.term builtin.Text.take a2.keep4 +scratch/main> alias.term builtin.Text.take a2.keep5 +scratch/main> alias.term builtin.Text.take newbranchA2.keep6 +scratch/main> merge.old newbranchA2 a2 .a2> find ``` ```ucm -.> fork a asquash -.> merge.old a2 a -.> merge.old.squash a2 asquash +scratch/main> fork a asquash +scratch/main> merge.old a2 a +scratch/main> merge.old.squash a2 asquash ``` At this point, all the things that `a` has deleted (`delete1`, `delete2`, etc) should be deleted in both the merged and squashed results. Let's verify this: @@ -69,14 +69,14 @@ At this point, all the things that `a` has deleted (`delete1`, `delete2`, etc) s ``` ```ucm:hide -.> view a.keep1 a.keep2 a.keep3 -.> view asquash.keep1 asquash.keep2 asquash.keep3 +scratch/main> view a.keep1 a.keep2 a.keep3 +scratch/main> view asquash.keep1 asquash.keep2 asquash.keep3 ``` ```ucm:error -.> view a.Delete4 +scratch/main> view a.Delete4 ``` ```ucm:error -.> view asquash.delete1 +scratch/main> view asquash.delete1 ``` diff --git a/unison-src/transcripts/fix2004.output.md b/unison-src/transcripts/fix2004.output.md index c8216d5e89..7cb48ed2ef 100644 --- a/unison-src/transcripts/fix2004.output.md +++ b/unison-src/transcripts/fix2004.output.md @@ -20,19 +20,19 @@ So `j1` and `j2` have common history up through `v4`, then `j1` deletes some def First, we create some common history before a fork: ```ucm -.> alias.term builtin.Nat.+ a.delete1 +scratch/main> alias.term builtin.Nat.+ a.delete1 Done. -.> alias.term builtin.Nat.* a.delete2 +scratch/main> alias.term builtin.Nat.* a.delete2 Done. -.> alias.term builtin.Nat.drop a.delete3 +scratch/main> alias.term builtin.Nat.drop a.delete3 Done. -.> alias.type builtin.Nat a.Delete4 +scratch/main> alias.type builtin.Nat a.Delete4 Done. @@ -40,11 +40,11 @@ First, we create some common history before a fork: Now we fork `a2` off of `a`. `a` continues on, deleting the terms it added previously and then adding one unrelated term via a merge with little history. It's this short history merge which will become a bad LCA of the empty namespace. ```ucm -.> fork a a2 +scratch/main> fork a a2 Done. -.> delete.term.verbose a.delete1 +scratch/main> delete.term.verbose a.delete1 Name changes: @@ -55,7 +55,7 @@ Now we fork `a2` off of `a`. `a` continues on, deleting the terms it added previ Tip: You can use `undo` or `reflog` to undo this change. -.> delete.term.verbose a.delete2 +scratch/main> delete.term.verbose a.delete2 Name changes: @@ -66,7 +66,7 @@ Now we fork `a2` off of `a`. `a` continues on, deleting the terms it added previ Tip: You can use `undo` or `reflog` to undo this change. -.> delete.term.verbose a.delete3 +scratch/main> delete.term.verbose a.delete3 Name changes: @@ -77,7 +77,7 @@ Now we fork `a2` off of `a`. `a` continues on, deleting the terms it added previ Tip: You can use `undo` or `reflog` to undo this change. -.> delete.type.verbose a.Delete4 +scratch/main> delete.type.verbose a.Delete4 Name changes: @@ -88,180 +88,25 @@ Now we fork `a2` off of `a`. `a` continues on, deleting the terms it added previ Tip: You can use `undo` or `reflog` to undo this change. -.> alias.term .builtin.Float.+ newbranchA.dontDelete +scratch/main> alias.term .builtin.Float.+ newbranchA.dontDelete - Done. - -.> merge.old newbranchA a - - Here's what's changed in a after the merge: - - Added definitions: - - 1. dontDelete : Float -> Float -> Float - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.a> find - - 1. dontDelete : ##Float -> ##Float -> ##Float + ⚠️ + I don't know about that term. ``` -Meanwhile, `a2` adds some other unrelated terms, some via merging in namespaces with little history. When merging `a2` back into `a`, the deletes from their common history should be respected. - -```ucm -.> alias.term builtin.Text.take a2.keep1 - - Done. - -.> alias.term builtin.Text.take a2.keep2 - - Done. - -.> alias.term builtin.Text.take a2.keep3 - - Done. - -.> alias.term builtin.Text.take a2.keep4 - - Done. - -.> alias.term builtin.Text.take a2.keep5 - - Done. - -.> alias.term builtin.Text.take newbranchA2.keep6 - - Done. - -.> merge.old newbranchA2 a2 - - Here's what's changed in a2 after the merge: - - Name changes: - - Original Changes - 1. keep1 ┐ 2. keep6 (added) - 3. keep2 │ - 4. keep3 │ - 5. keep4 │ - 6. keep5 ┘ - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.a2> find - - 1. delete1 : Delete4 -> Delete4 -> Delete4 - 2. delete2 : Delete4 -> Delete4 -> Delete4 - 3. delete3 : Delete4 -> Delete4 -> Delete4 - 4. builtin type Delete4 - 5. keep1 : Delete4 -> ##Text -> ##Text - 6. keep2 : Delete4 -> ##Text -> ##Text - 7. keep3 : Delete4 -> ##Text -> ##Text - 8. keep4 : Delete4 -> ##Text -> ##Text - 9. keep5 : Delete4 -> ##Text -> ##Text - 10. keep6 : Delete4 -> ##Text -> ##Text - -``` ```ucm -.> fork a asquash - - Done. - -.> merge.old a2 a - - Here's what's changed in a after the merge: - - Added definitions: - - 1. ┌ keep1 : Delete4 -> Text -> Text - 2. │ keep2 : Delete4 -> Text -> Text - 3. │ keep3 : Delete4 -> Text -> Text - 4. │ keep4 : Delete4 -> Text -> Text - 5. │ keep5 : Delete4 -> Text -> Text - 6. └ keep6 : Delete4 -> Text -> Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> merge.old.squash a2 asquash - - Here's what's changed in asquash after the merge: - - Added definitions: - - 1. ┌ keep1 : Delete4 -> Text -> Text - 2. │ keep2 : Delete4 -> Text -> Text - 3. │ keep3 : Delete4 -> Text -> Text - 4. │ keep4 : Delete4 -> Text -> Text - 5. │ keep5 : Delete4 -> Text -> Text - 6. └ keep6 : Delete4 -> Text -> Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - +scratch/main> fork a a2scratch/main> delete.term.verbose a.delete1scratch/main> delete.term.verbose a.delete2scratch/main> delete.term.verbose a.delete3scratch/main> delete.type.verbose a.Delete4scratch/main> alias.term .builtin.Float.+ newbranchA.dontDeletescratch/main> merge.old newbranchA a.a> find ``` -At this point, all the things that `a` has deleted (`delete1`, `delete2`, etc) should be deleted in both the merged and squashed results. Let's verify this: - -```ucm -.a> find - - 1. dontDelete : ##Float -> ##Float -> ##Float - 2. keep1 : ##Nat -> ##Text -> ##Text - 3. keep2 : ##Nat -> ##Text -> ##Text - 4. keep3 : ##Nat -> ##Text -> ##Text - 5. keep4 : ##Nat -> ##Text -> ##Text - 6. keep5 : ##Nat -> ##Text -> ##Text - 7. keep6 : ##Nat -> ##Text -> ##Text - - -.asquash> find - 1. dontDelete : ##Float -> ##Float -> ##Float - 2. keep1 : ##Nat -> ##Text -> ##Text - 3. keep2 : ##Nat -> ##Text -> ##Text - 4. keep3 : ##Nat -> ##Text -> ##Text - 5. keep4 : ##Nat -> ##Text -> ##Text - 6. keep5 : ##Nat -> ##Text -> ##Text - 7. keep6 : ##Nat -> ##Text -> ##Text - -``` -```ucm -.> view a.Delete4 +🛑 - ⚠️ - - The following names were not found in the codebase. Check your spelling. - a.Delete4 +The transcript failed due to an error in the stanza above. The error is: -``` -```ucm -.> view asquash.delete1 ⚠️ - The following names were not found in the codebase. Check your spelling. - asquash.delete1 + I don't know about that term. -``` diff --git a/unison-src/transcripts/fix2026.md b/unison-src/transcripts/fix2026.md index 819a579e2f..df2a51f457 100644 --- a/unison-src/transcripts/fix2026.md +++ b/unison-src/transcripts/fix2026.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison @@ -40,5 +40,5 @@ Exception.unsafeRun! e _ = ``` ```ucm -.> run ex +scratch/main> run ex ``` \ No newline at end of file diff --git a/unison-src/transcripts/fix2026.output.md b/unison-src/transcripts/fix2026.output.md index 1391a35c6b..e4f9d8d17b 100644 --- a/unison-src/transcripts/fix2026.output.md +++ b/unison-src/transcripts/fix2026.output.md @@ -64,7 +64,7 @@ Exception.unsafeRun! e _ = ``` ```ucm -.> run ex +scratch/main> run ex () diff --git a/unison-src/transcripts/fix2027.md b/unison-src/transcripts/fix2027.md index bcc0824566..2a386ae315 100644 --- a/unison-src/transcripts/fix2027.md +++ b/unison-src/transcripts/fix2027.md @@ -1,7 +1,7 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -51,5 +51,5 @@ myServer = unsafeRun! '(hello "127.0.0.1" "0") ``` ```ucm:error -.> run myServer +scratch/main> run myServer ``` diff --git a/unison-src/transcripts/fix2027.output.md b/unison-src/transcripts/fix2027.output.md index b69a8b31bb..2a7b30deca 100644 --- a/unison-src/transcripts/fix2027.output.md +++ b/unison-src/transcripts/fix2027.output.md @@ -80,7 +80,7 @@ myServer = unsafeRun! '(hello "127.0.0.1" "0") ``` ```ucm -.> run myServer +scratch/main> run myServer 💔💥 diff --git a/unison-src/transcripts/fix2049.md b/unison-src/transcripts/fix2049.md index ab1983e95b..c0cfc4fdb2 100644 --- a/unison-src/transcripts/fix2049.md +++ b/unison-src/transcripts/fix2049.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -74,6 +74,6 @@ tests _ = ``` ```ucm -.> add -.> io.test tests +scratch/main> add +scratch/main> io.test tests ``` diff --git a/unison-src/transcripts/fix2049.output.md b/unison-src/transcripts/fix2049.output.md index 7e18e1f6c9..f12f90d1cf 100644 --- a/unison-src/transcripts/fix2049.output.md +++ b/unison-src/transcripts/fix2049.output.md @@ -121,14 +121,14 @@ tests _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: catcher : '{IO} () ->{IO} Result tests : ∀ _. _ ->{IO} [Result] -.> io.test tests +scratch/main> io.test tests New test results: diff --git a/unison-src/transcripts/fix2053.md b/unison-src/transcripts/fix2053.md index 120bbed317..71f36094cb 100644 --- a/unison-src/transcripts/fix2053.md +++ b/unison-src/transcripts/fix2053.md @@ -1,7 +1,7 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```ucm -.> display List.map +scratch/main> display List.map ``` diff --git a/unison-src/transcripts/fix2053.output.md b/unison-src/transcripts/fix2053.output.md index d1cf4ec78e..39766e272d 100644 --- a/unison-src/transcripts/fix2053.output.md +++ b/unison-src/transcripts/fix2053.output.md @@ -1,5 +1,5 @@ ```ucm -.> display List.map +scratch/main> display List.map f a -> let diff --git a/unison-src/transcripts/fix2156.md b/unison-src/transcripts/fix2156.md index 2bc440b149..f18d03fd13 100644 --- a/unison-src/transcripts/fix2156.md +++ b/unison-src/transcripts/fix2156.md @@ -3,7 +3,7 @@ Tests for a case where bad eta reduction was causing erroneous watch output/caching. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2167.md b/unison-src/transcripts/fix2167.md index 4e65ddb6f6..5d0381f70e 100644 --- a/unison-src/transcripts/fix2167.md +++ b/unison-src/transcripts/fix2167.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This is just a simple transcript to regression check an ability diff --git a/unison-src/transcripts/fix2187.md b/unison-src/transcripts/fix2187.md index f519c30de4..2d0eb3fe7a 100644 --- a/unison-src/transcripts/fix2187.md +++ b/unison-src/transcripts/fix2187.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2231.md b/unison-src/transcripts/fix2231.md index 0b1ed16419..2fe2660b13 100644 --- a/unison-src/transcripts/fix2231.md +++ b/unison-src/transcripts/fix2231.md @@ -7,7 +7,7 @@ the choices may not work equally well with the type checking strategies. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -25,5 +25,5 @@ txt = foldl (Text.++) "" ["a", "b", "c"] ``` ```ucm -.> add +scratch/main> add ``` diff --git a/unison-src/transcripts/fix2231.output.md b/unison-src/transcripts/fix2231.output.md index 2ff24e5bcf..b94ff2c9db 100644 --- a/unison-src/transcripts/fix2231.output.md +++ b/unison-src/transcripts/fix2231.output.md @@ -37,7 +37,7 @@ txt = foldl (Text.++) "" ["a", "b", "c"] ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix2238.md b/unison-src/transcripts/fix2238.md index 3562096397..37a948c0f0 100644 --- a/unison-src/transcripts/fix2238.md +++ b/unison-src/transcripts/fix2238.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` This should not typecheck - the inline `@eval` expression uses abilities. @@ -14,5 +14,5 @@ ex = {{ @eval{abort} }} This file should also not typecheck - it has a triple backticks block that uses abilities. ```ucm:error -.> load unison-src/transcripts/fix2238.u +scratch/main> load unison-src/transcripts/fix2238.u ``` diff --git a/unison-src/transcripts/fix2238.output.md b/unison-src/transcripts/fix2238.output.md index 31a4aca9f0..b9594f0150 100644 --- a/unison-src/transcripts/fix2238.output.md +++ b/unison-src/transcripts/fix2238.output.md @@ -20,7 +20,7 @@ ex = {{ @eval{abort} }} This file should also not typecheck - it has a triple backticks block that uses abilities. ```ucm -.> load unison-src/transcripts/fix2238.u +scratch/main> load unison-src/transcripts/fix2238.u Loading changes detected in unison-src/transcripts/fix2238.u. diff --git a/unison-src/transcripts/fix2244.md b/unison-src/transcripts/fix2244.md index e270dc5f27..e1dba0b05e 100644 --- a/unison-src/transcripts/fix2244.md +++ b/unison-src/transcripts/fix2244.md @@ -1,13 +1,13 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` Ensure closing token is emitted by closing brace in doc eval block. ```ucm -.> load ./unison-src/transcripts/fix2244.u +scratch/main> load ./unison-src/transcripts/fix2244.u ``` ```ucm:hide -.> add +scratch/main> add ``` diff --git a/unison-src/transcripts/fix2244.output.md b/unison-src/transcripts/fix2244.output.md index 44b65347d9..63ac780c2c 100644 --- a/unison-src/transcripts/fix2244.output.md +++ b/unison-src/transcripts/fix2244.output.md @@ -1,7 +1,7 @@ Ensure closing token is emitted by closing brace in doc eval block. ```ucm -.> load ./unison-src/transcripts/fix2244.u +scratch/main> load ./unison-src/transcripts/fix2244.u Loading changes detected in ./unison-src/transcripts/fix2244.u. diff --git a/unison-src/transcripts/fix2254.md b/unison-src/transcripts/fix2254.md index 3b6dd15e6c..6f0ae20f01 100644 --- a/unison-src/transcripts/fix2254.md +++ b/unison-src/transcripts/fix2254.md @@ -39,7 +39,7 @@ We'll make our edits in a fork of the `a` namespace: ```ucm .a> add -.> fork a a2 +scratch/main> fork a a2 ``` First let's edit the `A` type, adding another constructor `E`. Note that the functions written against the old type have a wildcard in their pattern match, so they should work fine after the update. @@ -90,7 +90,7 @@ structural type Rec = { uno : Nat, dos : Nat, tres : Text } And checking that after updating this record, there's nothing `todo`: ```ucm -.> fork a3 a4 +scratch/main> fork a3 a4 .a4> update.old .a4> todo ``` diff --git a/unison-src/transcripts/fix2254.output.md b/unison-src/transcripts/fix2254.output.md index dbbdf46852..8b4aaa3153 100644 --- a/unison-src/transcripts/fix2254.output.md +++ b/unison-src/transcripts/fix2254.output.md @@ -37,7 +37,7 @@ We'll make our edits in a fork of the `a` namespace: .a> add ⍟ I've added these definitions: - + type A a b c d structural type NeedsA a b f : A Nat Nat Nat Nat -> Nat @@ -45,172 +45,22 @@ We'll make our edits in a fork of the `a` namespace: f3 : NeedsA Nat Nat -> Nat g : A Nat Nat Nat Nat -> Nat -.> fork a a2 - - Done. - -``` -First let's edit the `A` type, adding another constructor `E`. Note that the functions written against the old type have a wildcard in their pattern match, so they should work fine after the update. - -```unison -unique type A a b c d - = A a - | B b - | C c - | D d - | E a d -``` - -Let's do the update now, and verify that the definitions all look good and there's nothing `todo`: - -```ucm -.a2> update.old - - ⍟ I've updated these names to your new definition: - - type A a b c d - -.a2> view A NeedsA f f2 f3 g - - type A a b c d - = B b - | D d - | E a d - | C c - | A a - - structural type NeedsA a b - = Zoink Text - | NeedsA (A a b Nat Nat) - - f : A Nat Nat Nat Nat -> Nat - f = cases - A n -> n - _ -> 42 - - f2 : A Nat Nat Nat Nat -> Nat - f2 a = - use Nat + - n = f a - n + 1 - - f3 : NeedsA Nat Nat -> Nat - f3 = cases - NeedsA a -> f a Nat.+ 20 - _ -> 0 - - g : A Nat Nat Nat Nat -> Nat - g = cases - D n -> n - _ -> 43 - -.a2> todo - - - -``` -## Record updates +scratch/main> fork a a2 -Here's a test of updating a record: + ⚠️ -```unison -structural type Rec = { uno : Nat, dos : Nat } + The namespace .__projects._ae607e42_8e50_43fc_bd62_57e211b16316.branches._04b92376_f428_4b46_8d52_c83ba75c6a15.a doesn't exist. -combine r = uno r + dos r ``` -```ucm - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec - combine : Rec -> Nat -``` -```ucm -.a3> add +🛑 - ⍟ I've added these definitions: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec - combine : Rec -> Nat +The transcript failed due to an error in the stanza above. The error is: -``` -```unison -structural type Rec = { uno : Nat, dos : Nat, tres : Text } -``` -```ucm + ⚠️ - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - Rec.tres : Rec -> Text - Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec - Rec.tres.set : Text -> Rec -> Rec - - ⍟ These names already exist. You can `update` them to your - new definition: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec + The namespace .__projects._ae607e42_8e50_43fc_bd62_57e211b16316.branches._04b92376_f428_4b46_8d52_c83ba75c6a15.a doesn't exist. -``` -And checking that after updating this record, there's nothing `todo`: - -```ucm -.> fork a3 a4 - - Done. - -.a4> update.old - - ⍟ I've added these definitions: - - Rec.tres : Rec -> Text - Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec - Rec.tres.set : Text -> Rec -> Rec - - ⍟ I've updated these names to your new definition: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec - -.a4> todo - - - -``` diff --git a/unison-src/transcripts/fix2268.md b/unison-src/transcripts/fix2268.md index 504e2da734..0892d924e7 100644 --- a/unison-src/transcripts/fix2268.md +++ b/unison-src/transcripts/fix2268.md @@ -3,7 +3,7 @@ inferred types that didn't contain arrows, so effects that just yield a value weren't getting disambiguated. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2334.md b/unison-src/transcripts/fix2334.md index 0bc9a2d7d3..9044000b5e 100644 --- a/unison-src/transcripts/fix2334.md +++ b/unison-src/transcripts/fix2334.md @@ -3,7 +3,7 @@ Tests an issue where pattern matching matrices involving built-in types was discarding default cases in some branches. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2344.md b/unison-src/transcripts/fix2344.md index 6dd1e0ca21..2593c2f18e 100644 --- a/unison-src/transcripts/fix2344.md +++ b/unison-src/transcripts/fix2344.md @@ -5,7 +5,7 @@ The binds were causing some sequences of lets to be unnecessarily recursive. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2353.md b/unison-src/transcripts/fix2353.md index 50d0827a6d..f9662633cd 100644 --- a/unison-src/transcripts/fix2353.md +++ b/unison-src/transcripts/fix2353.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2354.md b/unison-src/transcripts/fix2354.md index 7346e368cf..f8a637022d 100644 --- a/unison-src/transcripts/fix2354.md +++ b/unison-src/transcripts/fix2354.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Tests that delaying an un-annotated higher-rank type gives a normal diff --git a/unison-src/transcripts/fix2355.md b/unison-src/transcripts/fix2355.md index 25f4840b31..a9b22fc3f3 100644 --- a/unison-src/transcripts/fix2355.md +++ b/unison-src/transcripts/fix2355.md @@ -2,7 +2,7 @@ Tests for a loop that was previously occurring in the type checker. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:error diff --git a/unison-src/transcripts/fix2378.md b/unison-src/transcripts/fix2378.md index d4358c26e9..586e6335c3 100644 --- a/unison-src/transcripts/fix2378.md +++ b/unison-src/transcripts/fix2378.md @@ -4,7 +4,7 @@ checking wanted vs. provided abilities. It was necessary to re-check rows until a fixed point is reached. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2423.md b/unison-src/transcripts/fix2423.md index 4f5d073c0a..72b3450557 100644 --- a/unison-src/transcripts/fix2423.md +++ b/unison-src/transcripts/fix2423.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2474.md b/unison-src/transcripts/fix2474.md index a718719bd9..3d48be95b5 100644 --- a/unison-src/transcripts/fix2474.md +++ b/unison-src/transcripts/fix2474.md @@ -18,7 +18,7 @@ should be typed in the following way: the ability that contains `e`. ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2474.output.md b/unison-src/transcripts/fix2474.output.md index 7f6472f094..f023e162b8 100644 --- a/unison-src/transcripts/fix2474.output.md +++ b/unison-src/transcripts/fix2474.output.md @@ -18,7 +18,7 @@ should be typed in the following way: the ability that contains `e`. ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. diff --git a/unison-src/transcripts/fix2628.md b/unison-src/transcripts/fix2628.md index 5c3ec8df50..3e111226b5 100644 --- a/unison-src/transcripts/fix2628.md +++ b/unison-src/transcripts/fix2628.md @@ -1,5 +1,5 @@ ```ucm:hide -.> alias.type ##Nat .base.Nat +scratch/main> alias.type ##Nat .base.Nat ``` ```unison:hide @@ -9,7 +9,7 @@ unique type foo.bar.baz.MyRecord = { ``` ```ucm -.> add +scratch/main> add -.> find : Nat -> MyRecord +scratch/main> find : Nat -> MyRecord ``` diff --git a/unison-src/transcripts/fix2628.output.md b/unison-src/transcripts/fix2628.output.md index 64b45ed29b..93e2bb13af 100644 --- a/unison-src/transcripts/fix2628.output.md +++ b/unison-src/transcripts/fix2628.output.md @@ -4,23 +4,23 @@ unique type foo.bar.baz.MyRecord = { } ``` -```ucm -.> add - ⍟ I've added these definitions: - - type foo.bar.baz.MyRecord - foo.bar.baz.MyRecord.value : MyRecord -> Nat - foo.bar.baz.MyRecord.value.modify : (Nat ->{g} Nat) - -> MyRecord - ->{g} MyRecord - foo.bar.baz.MyRecord.value.set : Nat - -> MyRecord - -> MyRecord -.> find : Nat -> MyRecord +🛑 + +The transcript failed due to an error in the stanza above. The error is: + - 1. foo.bar.baz.MyRecord.MyRecord : Nat -> MyRecord + + ❓ + + I couldn't resolve any of these symbols: + + 2 | value : Nat + + + Symbol Suggestions + + Nat No matches -``` diff --git a/unison-src/transcripts/fix2663.md b/unison-src/transcripts/fix2663.md index 6d2ccd7242..e3b88b0622 100644 --- a/unison-src/transcripts/fix2663.md +++ b/unison-src/transcripts/fix2663.md @@ -8,7 +8,7 @@ After pattern compilation, the match would end up: and z would end up referring to the first p3 rather than the second. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2693.md b/unison-src/transcripts/fix2693.md index 947e35b701..2bd2a0082e 100644 --- a/unison-src/transcripts/fix2693.md +++ b/unison-src/transcripts/fix2693.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -14,7 +14,7 @@ range = loop [] ``` ```ucm -.> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts/fix2693.output.md b/unison-src/transcripts/fix2693.output.md index 22a46bec21..7bb6d60889 100644 --- a/unison-src/transcripts/fix2693.output.md +++ b/unison-src/transcripts/fix2693.output.md @@ -24,7 +24,7 @@ range = loop [] ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix2712.md b/unison-src/transcripts/fix2712.md index fce7511665..4483f00bd1 100644 --- a/unison-src/transcripts/fix2712.md +++ b/unison-src/transcripts/fix2712.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -10,7 +10,7 @@ mapWithKey f m = Tip ``` ```ucm -.> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts/fix2712.output.md b/unison-src/transcripts/fix2712.output.md index 08cdb89a30..f691d22dca 100644 --- a/unison-src/transcripts/fix2712.output.md +++ b/unison-src/transcripts/fix2712.output.md @@ -20,7 +20,7 @@ mapWithKey f m = Tip ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix2795.md b/unison-src/transcripts/fix2795.md index d4b61c99b3..1e2ca1764d 100644 --- a/unison-src/transcripts/fix2795.md +++ b/unison-src/transcripts/fix2795.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.mergeio -.> load unison-src/transcripts/fix2795/docs.u -.> display test +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts/fix2795/docs.u +scratch/main> display test ``` diff --git a/unison-src/transcripts/fix2795.output.md b/unison-src/transcripts/fix2795.output.md index 13a789f037..09ae558fca 100644 --- a/unison-src/transcripts/fix2795.output.md +++ b/unison-src/transcripts/fix2795.output.md @@ -1,9 +1,9 @@ ```ucm -.> builtins.mergeio +scratch/main> builtins.mergeio Done. -.> load unison-src/transcripts/fix2795/docs.u +scratch/main> load unison-src/transcripts/fix2795/docs.u Loading changes detected in unison-src/transcripts/fix2795/docs.u. @@ -17,7 +17,7 @@ t1 : Text test : Doc2 -.> display test +scratch/main> display test t : Text t = "hi" diff --git a/unison-src/transcripts/fix2840.md b/unison-src/transcripts/fix2840.md index be481b5bbd..518f90c45e 100644 --- a/unison-src/transcripts/fix2840.md +++ b/unison-src/transcripts/fix2840.md @@ -1,7 +1,7 @@ This bugfix addresses an issue where embedded Unison code in UCM was expected to be present in the active codebase when the `display` command was used render `Doc` values. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` First, a few \[hidden] definitions necessary for typechecking a simple Doc2. @@ -63,7 +63,7 @@ syntax.docWord = Word ``` ```ucm -.> add +scratch/main> add ``` Next, define and display a simple Doc: @@ -74,7 +74,7 @@ Hi ``` ```ucm -.> display README +scratch/main> display README ``` Previously, the error was: diff --git a/unison-src/transcripts/fix2840.output.md b/unison-src/transcripts/fix2840.output.md index c47df9a2c7..ab59e8f1eb 100644 --- a/unison-src/transcripts/fix2840.output.md +++ b/unison-src/transcripts/fix2840.output.md @@ -3,7 +3,7 @@ This bugfix addresses an issue where embedded Unison code in UCM was expected to First, a few \[hidden] definitions necessary for typechecking a simple Doc2. ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -25,7 +25,7 @@ Hi ``` ```ucm -.> display README +scratch/main> display README Hi diff --git a/unison-src/transcripts/fix2970.md b/unison-src/transcripts/fix2970.md index d9a6a6b532..efcd59f181 100644 --- a/unison-src/transcripts/fix2970.md +++ b/unison-src/transcripts/fix2970.md @@ -1,7 +1,7 @@ Also fixes #1519 (it's the same issue). ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix2970.output.md b/unison-src/transcripts/fix2970.output.md index 904508e2cd..52d017e842 100644 --- a/unison-src/transcripts/fix2970.output.md +++ b/unison-src/transcripts/fix2970.output.md @@ -1,7 +1,7 @@ Also fixes #1519 (it's the same issue). ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. diff --git a/unison-src/transcripts/fix3037.md b/unison-src/transcripts/fix3037.md index c16c1f284f..af8fed9816 100644 --- a/unison-src/transcripts/fix3037.md +++ b/unison-src/transcripts/fix3037.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Tests for an unsound case of ability checking that was erroneously being diff --git a/unison-src/transcripts/fix3171.md b/unison-src/transcripts/fix3171.md index 62790dd1aa..ad166c7f5e 100644 --- a/unison-src/transcripts/fix3171.md +++ b/unison-src/transcripts/fix3171.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Tests an case where decompiling could cause function arguments to occur in the diff --git a/unison-src/transcripts/fix3196.md b/unison-src/transcripts/fix3196.md index d04592aa6c..46755570e5 100644 --- a/unison-src/transcripts/fix3196.md +++ b/unison-src/transcripts/fix3196.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Tests ability checking in scenarios where one side is concrete and the other is diff --git a/unison-src/transcripts/fix3215.md b/unison-src/transcripts/fix3215.md index af0e67e868..a0d1715a14 100644 --- a/unison-src/transcripts/fix3215.md +++ b/unison-src/transcripts/fix3215.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Tests a case where concrete abilities were appearing multiple times in an diff --git a/unison-src/transcripts/fix3244.md b/unison-src/transcripts/fix3244.md index 0ae745e897..e07581e2e2 100644 --- a/unison-src/transcripts/fix3244.md +++ b/unison-src/transcripts/fix3244.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This tests an previously erroneous case in the pattern compiler. It was assuming diff --git a/unison-src/transcripts/fix3265.md b/unison-src/transcripts/fix3265.md index fcf9ce8fb9..5b06551112 100644 --- a/unison-src/transcripts/fix3265.md +++ b/unison-src/transcripts/fix3265.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Tests cases that produced bad decompilation output previously. There diff --git a/unison-src/transcripts/fix3634.md b/unison-src/transcripts/fix3634.md index 0cb5f88dd9..fd1654739a 100644 --- a/unison-src/transcripts/fix3634.md +++ b/unison-src/transcripts/fix3634.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` @@ -16,6 +16,6 @@ d = {{ ``` ```ucm -.> add -.> display d +scratch/main> add +scratch/main> display d ``` \ No newline at end of file diff --git a/unison-src/transcripts/fix3634.output.md b/unison-src/transcripts/fix3634.output.md index 46f009f8cd..8648dd1cf3 100644 --- a/unison-src/transcripts/fix3634.output.md +++ b/unison-src/transcripts/fix3634.output.md @@ -26,7 +26,7 @@ d = {{ ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -34,7 +34,7 @@ d = {{ (also named builtin.Optional) d : Doc2 -.> display d +scratch/main> display d `x -> J x` diff --git a/unison-src/transcripts/fix3678.md b/unison-src/transcripts/fix3678.md index 13bed5d26c..59ecfe787e 100644 --- a/unison-src/transcripts/fix3678.md +++ b/unison-src/transcripts/fix3678.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Array comparison was indexing out of bounds. diff --git a/unison-src/transcripts/fix3752.md b/unison-src/transcripts/fix3752.md index 72979087f5..90fc207437 100644 --- a/unison-src/transcripts/fix3752.md +++ b/unison-src/transcripts/fix3752.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` These were failing to type check before, because id was not diff --git a/unison-src/transcripts/fix3759.md b/unison-src/transcripts/fix3759.md index 63047bc914..212bae6659 100644 --- a/unison-src/transcripts/fix3759.md +++ b/unison-src/transcripts/fix3759.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -14,7 +14,7 @@ Woot.frobnicate = 43 ``` ```ucm:hide -.> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts/fix3773.md b/unison-src/transcripts/fix3773.md index 1a0ab22c78..991db6991f 100644 --- a/unison-src/transcripts/fix3773.md +++ b/unison-src/transcripts/fix3773.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix4172.md b/unison-src/transcripts/fix4172.md index 2c7d6c3b14..faaa934756 100644 --- a/unison-src/transcripts/fix4172.md +++ b/unison-src/transcripts/fix4172.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -17,8 +17,8 @@ allowDebug = debug [1,2,3] ``` ```ucm -.> add -.> test +scratch/main> add +scratch/main> test ``` ```unison @@ -26,6 +26,6 @@ bool = false ``` ```ucm:error -.> update.old -.> test +scratch/main> update.old +scratch/main> test ``` diff --git a/unison-src/transcripts/fix4172.output.md b/unison-src/transcripts/fix4172.output.md index 59a5d83b87..91614ccfe4 100644 --- a/unison-src/transcripts/fix4172.output.md +++ b/unison-src/transcripts/fix4172.output.md @@ -36,7 +36,7 @@ allowDebug = debug [1,2,3] ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -45,7 +45,7 @@ allowDebug = debug [1,2,3] debug : a -> Text t1 : [Result] -.> test +scratch/main> test Cached test results (`help testcache` to learn more) @@ -75,13 +75,13 @@ bool = false ``` ```ucm -.> update.old +scratch/main> update.old ⍟ I've updated these names to your new definition: bool : Boolean -.> test +scratch/main> test ✅ diff --git a/unison-src/transcripts/fix4280.md b/unison-src/transcripts/fix4280.md index f4cf09a011..d994a42595 100644 --- a/unison-src/transcripts/fix4280.md +++ b/unison-src/transcripts/fix4280.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix4424.md b/unison-src/transcripts/fix4424.md index 19963478f0..8fb4d14bab 100644 --- a/unison-src/transcripts/fix4424.md +++ b/unison-src/transcripts/fix4424.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Some basics: @@ -13,7 +13,7 @@ countCat = cases ``` ```ucm -.> add +scratch/main> add ``` Now I want to add a constructor. @@ -23,5 +23,5 @@ unique type Rat.Dog = Bird | Mouse ``` ```ucm -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/fix4424.output.md b/unison-src/transcripts/fix4424.output.md index bb00ce7303..dbf505cedb 100644 --- a/unison-src/transcripts/fix4424.output.md +++ b/unison-src/transcripts/fix4424.output.md @@ -9,7 +9,7 @@ countCat = cases ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -25,7 +25,7 @@ unique type Rat.Dog = Bird | Mouse ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/fix4498.md b/unison-src/transcripts/fix4498.md index d1781e2e33..5e8918b300 100644 --- a/unison-src/transcripts/fix4498.md +++ b/unison-src/transcripts/fix4498.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -10,7 +10,7 @@ myterm = foo + 2 ``` ```ucm -.> add -.> view myterm +scratch/main> add +scratch/main> view myterm ``` diff --git a/unison-src/transcripts/fix4498.output.md b/unison-src/transcripts/fix4498.output.md index e13c5f8f09..fb5bbd771b 100644 --- a/unison-src/transcripts/fix4498.output.md +++ b/unison-src/transcripts/fix4498.output.md @@ -22,7 +22,7 @@ myterm = foo + 2 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -31,7 +31,7 @@ myterm = foo + 2 lib.dep0.zonk.foo : Text myterm : Nat -.> view myterm +scratch/main> view myterm myterm : Nat myterm = diff --git a/unison-src/transcripts/fix4556.md b/unison-src/transcripts/fix4556.md index d4775b587b..1a0bbe25d7 100644 --- a/unison-src/transcripts/fix4556.md +++ b/unison-src/transcripts/fix4556.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -10,7 +10,7 @@ hey = foo.hello ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -18,5 +18,5 @@ thing = 2 ``` ```ucm -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/fix4556.output.md b/unison-src/transcripts/fix4556.output.md index d65321a311..2b4add6caa 100644 --- a/unison-src/transcripts/fix4556.output.md +++ b/unison-src/transcripts/fix4556.output.md @@ -22,7 +22,7 @@ hey = foo.hello ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -51,7 +51,7 @@ thing = 2 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/fix4592.md b/unison-src/transcripts/fix4592.md index cf272e1948..1118a281fb 100644 --- a/unison-src/transcripts/fix4592.md +++ b/unison-src/transcripts/fix4592.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison diff --git a/unison-src/transcripts/fix4618.md b/unison-src/transcripts/fix4618.md index 3755f10996..1d69f1ac52 100644 --- a/unison-src/transcripts/fix4618.md +++ b/unison-src/transcripts/fix4618.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -8,7 +8,7 @@ unique type Bugs.Zonk = Bugs ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -17,5 +17,5 @@ unique type Bugs = ``` ```ucm -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/fix4618.output.md b/unison-src/transcripts/fix4618.output.md index ee988cf57f..0b6a3921d8 100644 --- a/unison-src/transcripts/fix4618.output.md +++ b/unison-src/transcripts/fix4618.output.md @@ -18,7 +18,7 @@ unique type Bugs.Zonk = Bugs ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -50,7 +50,7 @@ unique type Bugs = ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/fix4722.md b/unison-src/transcripts/fix4722.md index e674df56b6..983e324f74 100644 --- a/unison-src/transcripts/fix4722.md +++ b/unison-src/transcripts/fix4722.md @@ -9,7 +9,7 @@ expected type into each case, allowing top-level annotations to act like annotations on each case. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/fix4780.md b/unison-src/transcripts/fix4780.md index a8fad41440..f1ebdad567 100644 --- a/unison-src/transcripts/fix4780.md +++ b/unison-src/transcripts/fix4780.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Just a simple test case to see whether partially applied diff --git a/unison-src/transcripts/fix4898.md b/unison-src/transcripts/fix4898.md index 9bc68041b2..6d618d82b0 100644 --- a/unison-src/transcripts/fix4898.md +++ b/unison-src/transcripts/fix4898.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,7 +11,7 @@ redouble x = double x + double x ``` ```ucm -.> add -.> dependents double -.> delete.term 1 +scratch/main> add +scratch/main> dependents double +scratch/main> delete.term 1 ``` diff --git a/unison-src/transcripts/fix4898.output.md b/unison-src/transcripts/fix4898.output.md index dceafc4cb3..c348778f25 100644 --- a/unison-src/transcripts/fix4898.output.md +++ b/unison-src/transcripts/fix4898.output.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. @@ -27,14 +27,14 @@ redouble x = double x + double x ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: double : Int -> Int redouble : Int -> Int -.> dependents double +scratch/main> dependents double Dependents of: double @@ -45,7 +45,7 @@ redouble x = double x + double x Tip: Try `view 1` to see the source of any numbered item in the above list. -.> delete.term 1 +scratch/main> delete.term 1 Done. diff --git a/unison-src/transcripts/fix614.md b/unison-src/transcripts/fix614.md index 3e0ad6c76b..3bc69c27c9 100644 --- a/unison-src/transcripts/fix614.md +++ b/unison-src/transcripts/fix614.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This transcript demonstrates that Unison forces actions in blocks to have a return type of `()`. @@ -16,7 +16,7 @@ ex1 = do ``` ```ucm:hide -.> add +scratch/main> add ``` This does not typecheck, we've accidentally underapplied `Stream.emit`: diff --git a/unison-src/transcripts/fix689.md b/unison-src/transcripts/fix689.md index b22106eed4..a75468b281 100644 --- a/unison-src/transcripts/fix689.md +++ b/unison-src/transcripts/fix689.md @@ -1,7 +1,7 @@ Tests the fix for https://github.com/unisonweb/unison/issues/689 ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ``` unison diff --git a/unison-src/transcripts/fix693.md b/unison-src/transcripts/fix693.md index bcb714af97..f45d2eab15 100644 --- a/unison-src/transcripts/fix693.md +++ b/unison-src/transcripts/fix693.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -12,7 +12,7 @@ structural ability Abort where ``` ```ucm -.> add +scratch/main> add ``` This code should not type check. The match on X.x ought to introduce a diff --git a/unison-src/transcripts/fix693.output.md b/unison-src/transcripts/fix693.output.md index 6d869d63a1..a5d0377374 100644 --- a/unison-src/transcripts/fix693.output.md +++ b/unison-src/transcripts/fix693.output.md @@ -22,7 +22,7 @@ structural ability Abort where ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix845.md b/unison-src/transcripts/fix845.md index 4e361ca7cc..99e4262455 100644 --- a/unison-src/transcripts/fix845.md +++ b/unison-src/transcripts/fix845.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Add `List.zonk` to the codebase: @@ -14,7 +14,7 @@ Text.zonk txt = txt ++ "!! " ``` ```ucm:hide -.> add +scratch/main> add ``` Now, typecheck a file with a reference to `Blah.zonk` (which doesn't exist in the codebase). This should fail: diff --git a/unison-src/transcripts/fix849.md b/unison-src/transcripts/fix849.md index 4d111f9cc1..63c40e8212 100644 --- a/unison-src/transcripts/fix849.md +++ b/unison-src/transcripts/fix849.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` See [this ticket](https://github.com/unisonweb/unison/issues/849). diff --git a/unison-src/transcripts/fix942.md b/unison-src/transcripts/fix942.md index 5c12cb8c06..5cbf16ffb1 100644 --- a/unison-src/transcripts/fix942.md +++ b/unison-src/transcripts/fix942.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` First we add some code: @@ -11,7 +11,7 @@ z = y + 2 ``` ```ucm -.> add +scratch/main> add ``` Now we edit `x` to be `7`, which should make `z` equal `10`: @@ -21,8 +21,8 @@ x = 7 ``` ```ucm -.> update -.> view x y z +scratch/main> update +scratch/main> view x y z ``` Uh oh! `z` is still referencing the old version. Just to confirm: @@ -32,6 +32,6 @@ test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] ``` ```ucm -.> add -.> test +scratch/main> add +scratch/main> test ``` diff --git a/unison-src/transcripts/fix942.output.md b/unison-src/transcripts/fix942.output.md index fd5f055d22..67d550311b 100644 --- a/unison-src/transcripts/fix942.output.md +++ b/unison-src/transcripts/fix942.output.md @@ -22,7 +22,7 @@ z = y + 2 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -52,7 +52,7 @@ x = 7 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -63,7 +63,7 @@ x = 7 Done. -.> view x y z +scratch/main> view x y z x : Nat x = 7 @@ -106,13 +106,13 @@ test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: t1 : [Result] -.> test +scratch/main> test Cached test results (`help testcache` to learn more) diff --git a/unison-src/transcripts/fix987.md b/unison-src/transcripts/fix987.md index 0db69b1d78..5eb2a73bbc 100644 --- a/unison-src/transcripts/fix987.md +++ b/unison-src/transcripts/fix987.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` First we'll add a definition: @@ -18,7 +18,7 @@ spaceAttack1 x = Add it to the codebase: ```ucm -.> add +scratch/main> add ``` Now we'll try to add a different definition that runs the actions in a different order. This should work fine: @@ -31,7 +31,7 @@ spaceAttack2 x = ``` ```ucm -.> add +scratch/main> add ``` Previously, this would fail because the hashing algorithm was being given one big let rec block whose binding order was normalized. diff --git a/unison-src/transcripts/fix987.output.md b/unison-src/transcripts/fix987.output.md index 5f6119c225..50d747862f 100644 --- a/unison-src/transcripts/fix987.output.md +++ b/unison-src/transcripts/fix987.output.md @@ -28,7 +28,7 @@ spaceAttack1 x = Add it to the codebase: ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -59,7 +59,7 @@ spaceAttack2 x = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/formatter.md b/unison-src/transcripts/formatter.md index 3848c0ba99..d2a921b2fc 100644 --- a/unison-src/transcripts/formatter.md +++ b/unison-src/transcripts/formatter.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -88,7 +88,7 @@ with a strike-through block~ ``` ```ucm -.> debug.format +scratch/main> debug.format ``` Formatter should leave things alone if the file doesn't typecheck. @@ -98,5 +98,5 @@ brokenDoc = {{ hello }} + 1 ``` ```ucm -.> debug.format +scratch/main> debug.format ``` diff --git a/unison-src/transcripts/formatter.output.md b/unison-src/transcripts/formatter.output.md index 95af2a545d..aac0d12aac 100644 --- a/unison-src/transcripts/formatter.output.md +++ b/unison-src/transcripts/formatter.output.md @@ -84,7 +84,7 @@ with a strike-through block~ ``` ```ucm -.> debug.format +scratch/main> debug.format ``` ```unison:added-by-ucm scratch.u @@ -200,6 +200,6 @@ brokenDoc = {{ hello }} + 1 ``` ```ucm -.> debug.format +scratch/main> debug.format ``` diff --git a/unison-src/transcripts/fuzzy-options.md b/unison-src/transcripts/fuzzy-options.md index 13d953c938..96e274f9a6 100644 --- a/unison-src/transcripts/fuzzy-options.md +++ b/unison-src/transcripts/fuzzy-options.md @@ -5,7 +5,7 @@ If an argument is required but doesn't have a fuzzy resolver, the command should ```ucm:error -- The second argument of move.term is a 'new-name' and doesn't have a fuzzy resolver -.> move.term +scratch/main> move.term ``` If a fuzzy resolver doesn't have any options available it should print a message instead of @@ -25,21 +25,21 @@ nested.optionTwo = 2 Definition args ```ucm -.> add -.> debug.fuzzy-options view _ +scratch/main> add +scratch/main> debug.fuzzy-options view _ ``` Namespace args ```ucm -.> add -.> debug.fuzzy-options find-in _ +scratch/main> add +scratch/main> debug.fuzzy-options find-in _ ``` Project Branch args ```ucm myproject/main> branch mybranch -.> debug.fuzzy-options switch _ +scratch/main> debug.fuzzy-options switch _ ``` diff --git a/unison-src/transcripts/fuzzy-options.output.md b/unison-src/transcripts/fuzzy-options.output.md index f48f5cd6fb..1eb893cb8f 100644 --- a/unison-src/transcripts/fuzzy-options.output.md +++ b/unison-src/transcripts/fuzzy-options.output.md @@ -5,7 +5,7 @@ If an argument is required but doesn't have a fuzzy resolver, the command should ```ucm -- The second argument of move.term is a 'new-name' and doesn't have a fuzzy resolver -.> move.term +scratch/main> move.term `move.term foo bar` renames `foo` to `bar`. @@ -32,16 +32,14 @@ nested.optionTwo = 2 Definition args ```ucm - ☝️ The namespace . is empty. - -.> add +scratch/main> add ⍟ I've added these definitions: nested.optionTwo : ##Nat optionOne : ##Nat -.> debug.fuzzy-options view _ +scratch/main> debug.fuzzy-options view _ Select a definition to view: * optionOne @@ -51,12 +49,12 @@ Definition args Namespace args ```ucm -.> add +scratch/main> add ⊡ Ignored previously added definitions: nested.optionTwo optionOne -.> debug.fuzzy-options find-in _ +scratch/main> debug.fuzzy-options find-in _ Select a namespace: * nested @@ -72,11 +70,13 @@ myproject/main> branch mybranch Tip: To merge your work back into the main branch, first `switch /main` then `merge /mybranch`. -.> debug.fuzzy-options switch _ +scratch/main> debug.fuzzy-options switch _ Select a project or branch to switch to: * myproject/main * myproject/mybranch + * scratch/main * myproject + * scratch ``` diff --git a/unison-src/transcripts/hello.md b/unison-src/transcripts/hello.md index 187eb86ec3..4c72096ffa 100644 --- a/unison-src/transcripts/hello.md +++ b/unison-src/transcripts/hello.md @@ -2,7 +2,7 @@ # Hello! ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This markdown file is also a Unison transcript file. Transcript files are an easy way to create self-documenting Unison programs, libraries, and tutorials. @@ -33,8 +33,8 @@ x = 42 Let's go ahead and add that to the codebase, then make sure it's there: ```ucm -.> add -.> view x +scratch/main> add +scratch/main> view x ``` If `view` returned no results, the transcript would fail at this point. @@ -50,7 +50,7 @@ y = 99 This works for `ucm` blocks as well. ```ucm:hide -.> rename.term x answerToUltimateQuestionOfLife +scratch/main> rename.term x answerToUltimateQuestionOfLife ``` Doing `unison:hide:all` hides the block altogether, both input and output - this is useful for doing behind-the-scenes control of `ucm`'s state. diff --git a/unison-src/transcripts/hello.output.md b/unison-src/transcripts/hello.output.md index 8104114e03..e6d03ea95e 100644 --- a/unison-src/transcripts/hello.output.md +++ b/unison-src/transcripts/hello.output.md @@ -48,13 +48,13 @@ x = 42 Let's go ahead and add that to the codebase, then make sure it's there: ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: x : Nat -.> view x +scratch/main> view x x : Nat x = 42 diff --git a/unison-src/transcripts/higher-rank.md b/unison-src/transcripts/higher-rank.md index 7fe63de504..6645e456aa 100644 --- a/unison-src/transcripts/higher-rank.md +++ b/unison-src/transcripts/higher-rank.md @@ -2,9 +2,9 @@ This transcript does some testing of higher-rank types. Regression tests related to higher-rank types can be added here. ```ucm:hide -.> alias.type ##Nat Nat -.> alias.type ##Text Text -.> alias.type ##IO IO +scratch/main> alias.type ##Nat Nat +scratch/main> alias.type ##Text Text +scratch/main> alias.type ##IO IO ``` In this example, a higher-rank function is defined, `f`. No annotation is needed at the call-site of `f`, because the lambda is being checked against the polymorphic type `forall a . a -> a`, rather than inferred: diff --git a/unison-src/transcripts/io-test-command.md b/unison-src/transcripts/io-test-command.md index 98d55a3da3..f10259137e 100644 --- a/unison-src/transcripts/io-test-command.md +++ b/unison-src/transcripts/io-test-command.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` The `io.test` command should run all of the tests within the current namespace, excluding libs. @@ -20,24 +20,24 @@ lib.ioAndExceptionTestInLib = do ``` ```ucm:hide -.> add +scratch/main> add ``` Run a IO tests one by one ```ucm -.> io.test ioAndExceptionTest -.> io.test ioTest +scratch/main> io.test ioAndExceptionTest +scratch/main> io.test ioTest ``` `io.test` doesn't cache results ```ucm -.> io.test ioAndExceptionTest +scratch/main> io.test ioAndExceptionTest ``` `io.test.all` will run all matching tests except those in the `lib` namespace. ```ucm -.> io.test.all +scratch/main> io.test.all ``` diff --git a/unison-src/transcripts/io-test-command.output.md b/unison-src/transcripts/io-test-command.output.md index 840d72b4f7..220addbcd3 100644 --- a/unison-src/transcripts/io-test-command.output.md +++ b/unison-src/transcripts/io-test-command.output.md @@ -18,7 +18,7 @@ lib.ioAndExceptionTestInLib = do Run a IO tests one by one ```ucm -.> io.test ioAndExceptionTest +scratch/main> io.test ioAndExceptionTest New test results: @@ -28,7 +28,7 @@ Run a IO tests one by one Tip: Use view ioAndExceptionTest to view the source of a test. -.> io.test ioTest +scratch/main> io.test ioTest New test results: @@ -42,7 +42,7 @@ Run a IO tests one by one `io.test` doesn't cache results ```ucm -.> io.test ioAndExceptionTest +scratch/main> io.test ioAndExceptionTest New test results: @@ -56,7 +56,7 @@ Run a IO tests one by one `io.test.all` will run all matching tests except those in the `lib` namespace. ```ucm -.> io.test.all +scratch/main> io.test.all diff --git a/unison-src/transcripts/io.md b/unison-src/transcripts/io.md index 4caedaef05..0051c7aa69 100644 --- a/unison-src/transcripts/io.md +++ b/unison-src/transcripts/io.md @@ -1,10 +1,10 @@ # tests for built-in IO functions ```ucm:hide -.> builtins.merge -.> builtins.mergeio -.> load unison-src/transcripts-using-base/base.u -.> add +scratch/main> builtins.merge +scratch/main> builtins.mergeio +scratch/main> load unison-src/transcripts-using-base/base.u +scratch/main> add ``` Tests for IO builtins which wired to foreign haskell calls. @@ -17,7 +17,7 @@ TempDirs/autoCleaned is an ability/hanlder which allows you to easily create a scratch directory which will automatically get cleaned up. ```ucm:hide -.> add +scratch/main> add ``` ## Basic File Functions @@ -57,8 +57,8 @@ testCreateRename _ = ``` ```ucm -.> add -.> io.test testCreateRename +scratch/main> add +scratch/main> io.test testCreateRename ``` ### Opening / Closing files @@ -107,8 +107,8 @@ testOpenClose _ = ``` ```ucm -.> add -.> io.test testOpenClose +scratch/main> add +scratch/main> io.test testOpenClose ``` ### Reading files with getSomeBytes @@ -166,8 +166,8 @@ testGetSomeBytes _ = ``` ```ucm -.> add -.> io.test testGetSomeBytes +scratch/main> add +scratch/main> io.test testGetSomeBytes ``` ### Seeking in open files @@ -240,9 +240,9 @@ testAppend _ = ``` ```ucm -.> add -.> io.test testSeek -.> io.test testAppend +scratch/main> add +scratch/main> io.test testSeek +scratch/main> io.test testAppend ``` ### SystemTime @@ -257,8 +257,8 @@ testSystemTime _ = ``` ```ucm -.> add -.> io.test testSystemTime +scratch/main> add +scratch/main> io.test testSystemTime ``` ### Get temp directory @@ -274,8 +274,8 @@ testGetTempDirectory _ = ``` ```ucm -.> add -.> io.test testGetTempDirectory +scratch/main> add +scratch/main> io.test testGetTempDirectory ``` ### Get current directory @@ -291,8 +291,8 @@ testGetCurrentDirectory _ = ``` ```ucm -.> add -.> io.test testGetCurrentDirectory +scratch/main> add +scratch/main> io.test testGetCurrentDirectory ``` ### Get directory contents @@ -310,8 +310,8 @@ testDirContents _ = ``` ```ucm -.> add -.> io.test testDirContents +scratch/main> add +scratch/main> io.test testDirContents ``` ### Read environment variables @@ -328,8 +328,8 @@ testGetEnv _ = runTest test ``` ```ucm -.> add -.> io.test testGetEnv +scratch/main> add +scratch/main> io.test testGetEnv ``` ### Read command line args @@ -368,27 +368,27 @@ testGetArgs.runMeWithTwoArgs = 'let Test that they can be run with the right number of args. ```ucm -.> add -.> run runMeWithNoArgs -.> run runMeWithOneArg foo -.> run runMeWithTwoArgs foo bar +scratch/main> add +scratch/main> run runMeWithNoArgs +scratch/main> run runMeWithOneArg foo +scratch/main> run runMeWithTwoArgs foo bar ``` Calling our examples with the wrong number of args will error. ```ucm:error -.> run runMeWithNoArgs foo +scratch/main> run runMeWithNoArgs foo ``` ```ucm:error -.> run runMeWithOneArg +scratch/main> run runMeWithOneArg ``` ```ucm:error -.> run runMeWithOneArg foo bar +scratch/main> run runMeWithOneArg foo bar ``` ```ucm:error -.> run runMeWithTwoArgs +scratch/main> run runMeWithTwoArgs ``` ### Get the time zone @@ -401,8 +401,8 @@ testTimeZone = do ``` ```ucm -.> add -.> run testTimeZone +scratch/main> add +scratch/main> run testTimeZone ``` ### Get some random bytes @@ -417,6 +417,6 @@ testRandom = do ``` ```ucm -.> add -.> io.test testGetEnv +scratch/main> add +scratch/main> io.test testGetEnv ``` diff --git a/unison-src/transcripts/io.output.md b/unison-src/transcripts/io.output.md index 3a7d44d4db..469507a6da 100644 --- a/unison-src/transcripts/io.output.md +++ b/unison-src/transcripts/io.output.md @@ -59,13 +59,13 @@ testCreateRename _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testCreateRename : '{IO} [Result] -.> io.test testCreateRename +scratch/main> io.test testCreateRename New test results: @@ -141,13 +141,13 @@ testOpenClose _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testOpenClose : '{IO} [Result] -.> io.test testOpenClose +scratch/main> io.test testOpenClose New test results: @@ -231,13 +231,13 @@ testGetSomeBytes _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testGetSomeBytes : '{IO} [Result] -.> io.test testGetSomeBytes +scratch/main> io.test testGetSomeBytes New test results: @@ -339,14 +339,14 @@ testAppend _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testAppend : '{IO} [Result] testSeek : '{IO} [Result] -.> io.test testSeek +scratch/main> io.test testSeek New test results: @@ -362,7 +362,7 @@ testAppend _ = Tip: Use view testSeek to view the source of a test. -.> io.test testAppend +scratch/main> io.test testAppend New test results: @@ -398,13 +398,13 @@ testSystemTime _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testSystemTime : '{IO} [Result] -.> io.test testSystemTime +scratch/main> io.test testSystemTime New test results: @@ -428,13 +428,13 @@ testGetTempDirectory _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testGetTempDirectory : '{IO} [Result] -.> io.test testGetTempDirectory +scratch/main> io.test testGetTempDirectory New test results: @@ -460,13 +460,13 @@ testGetCurrentDirectory _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testGetCurrentDirectory : '{IO} [Result] -.> io.test testGetCurrentDirectory +scratch/main> io.test testGetCurrentDirectory New test results: @@ -494,13 +494,13 @@ testDirContents _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testDirContents : '{IO} [Result] -.> io.test testDirContents +scratch/main> io.test testDirContents New test results: @@ -527,13 +527,13 @@ testGetEnv _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testGetEnv : '{IO} [Result] -.> io.test testGetEnv +scratch/main> io.test testGetEnv New test results: @@ -581,7 +581,7 @@ testGetArgs.runMeWithTwoArgs = 'let Test that they can be run with the right number of args. ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -590,15 +590,15 @@ Test that they can be run with the right number of args. testGetArgs.runMeWithOneArg : '{IO, Exception} () testGetArgs.runMeWithTwoArgs : '{IO, Exception} () -.> run runMeWithNoArgs +scratch/main> run runMeWithNoArgs () -.> run runMeWithOneArg foo +scratch/main> run runMeWithOneArg foo () -.> run runMeWithTwoArgs foo bar +scratch/main> run runMeWithTwoArgs foo bar () @@ -606,7 +606,7 @@ Test that they can be run with the right number of args. Calling our examples with the wrong number of args will error. ```ucm -.> run runMeWithNoArgs foo +scratch/main> run runMeWithNoArgs foo 💔💥 @@ -619,7 +619,7 @@ Calling our examples with the wrong number of args will error. ``` ```ucm -.> run runMeWithOneArg +scratch/main> run runMeWithOneArg 💔💥 @@ -632,7 +632,7 @@ Calling our examples with the wrong number of args will error. ``` ```ucm -.> run runMeWithOneArg foo bar +scratch/main> run runMeWithOneArg foo bar 💔💥 @@ -646,7 +646,7 @@ Calling our examples with the wrong number of args will error. ``` ```ucm -.> run runMeWithTwoArgs +scratch/main> run runMeWithTwoArgs 💔💥 @@ -668,13 +668,13 @@ testTimeZone = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testTimeZone : '{IO} () -.> run testTimeZone +scratch/main> run testTimeZone () @@ -691,13 +691,13 @@ testRandom = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: testRandom : '{IO} [Result] -.> io.test testGetEnv +scratch/main> io.test testGetEnv New test results: diff --git a/unison-src/transcripts/kind-inference.md b/unison-src/transcripts/kind-inference.md index f81a3bf95c..3af86ae854 100644 --- a/unison-src/transcripts/kind-inference.md +++ b/unison-src/transcripts/kind-inference.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ## A type param cannot have conflicting kind constraints within a single decl diff --git a/unison-src/transcripts/lambdacase.md b/unison-src/transcripts/lambdacase.md index e2e3a557ef..a4d1ba96f1 100644 --- a/unison-src/transcripts/lambdacase.md +++ b/unison-src/transcripts/lambdacase.md @@ -1,7 +1,7 @@ # Lambda case syntax ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This function takes a single argument and immediately pattern matches on it. As we'll see below, it can be written using `cases` syntax: @@ -13,7 +13,7 @@ isEmpty x = match x with ``` ```ucm:hide -.> add +scratch/main> add ``` Here's the same function written using `cases` syntax: @@ -27,7 +27,7 @@ isEmpty2 = cases Notice that Unison detects this as an alias of `isEmpty`, and if we view `isEmpty` ```ucm -.> view isEmpty +scratch/main> view isEmpty ``` it shows the definition using `cases` syntax opportunistically, even though the code was originally written without that syntax. @@ -47,7 +47,7 @@ merge xs ys = match (xs, ys) with ``` ```ucm -.> add +scratch/main> add ``` And here's a version using `cases`. The patterns are separated by commas: @@ -65,7 +65,7 @@ merge2 = cases Notice that Unison detects this as an alias of `merge`, and if we view `merge` ```ucm -.> view merge +scratch/main> view merge ``` it again shows the definition using the multi-argument `cases` syntax opportunistically, even though the code was originally written without that syntax. @@ -101,8 +101,8 @@ merge3 = cases ``` ```ucm -.> add -.> view merge3 +scratch/main> add +scratch/main> view merge3 ``` This is the same definition written with multiple patterns and not using the `cases` syntax; notice it is considered an alias of `merge3` above. diff --git a/unison-src/transcripts/lambdacase.output.md b/unison-src/transcripts/lambdacase.output.md index efb41cdce8..2e55001a98 100644 --- a/unison-src/transcripts/lambdacase.output.md +++ b/unison-src/transcripts/lambdacase.output.md @@ -46,7 +46,7 @@ isEmpty2 = cases Notice that Unison detects this as an alias of `isEmpty`, and if we view `isEmpty` ```ucm -.> view isEmpty +scratch/main> view isEmpty isEmpty : [t] -> Boolean isEmpty = cases @@ -71,7 +71,7 @@ merge xs ys = match (xs, ys) with ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -107,7 +107,7 @@ merge2 = cases Notice that Unison detects this as an alias of `merge`, and if we view `merge` ```ucm -.> view merge +scratch/main> view merge merge : [a] -> [a] -> [a] merge = cases @@ -194,13 +194,13 @@ merge3 = cases ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: merge3 : [a] -> [a] -> [a] -.> view merge3 +scratch/main> view merge3 merge3 : [a] -> [a] -> [a] merge3 = cases diff --git a/unison-src/transcripts/ls-pretty-print-scope-bug.md b/unison-src/transcripts/ls-pretty-print-scope-bug.md index a8d4cf5ed4..af7ff0a0ea 100644 --- a/unison-src/transcripts/ls-pretty-print-scope-bug.md +++ b/unison-src/transcripts/ls-pretty-print-scope-bug.md @@ -4,7 +4,7 @@ unique type Foo = Foo ```ucm .a.b> add -.> fork .a.b .c.d.f +scratch/main> fork .a.b .c.d.f .c.g.f> ``` @@ -31,14 +31,14 @@ At this point we have: `.c.g.f.Foo` which is distinct from the other `Foo` types ```ucm -.> delete .c.d.f.Foo +scratch/main> delete .c.d.f.Foo ``` Once `.c.d.f.Foo` is deleted `.c.foo` should have the type `.a.b.Foo` -when viewed from `.>`, but an unnamed type when viewed from `.c>`, +when viewed from `scratch/main>`, but an unnamed type when viewed from `.c>`, since referencing `.a.b.Foo` would reference names outside of the namespace rooted at `.c`. ```ucm -.> ls c +scratch/main> ls c .c> ls ``` diff --git a/unison-src/transcripts/ls-pretty-print-scope-bug.output.md b/unison-src/transcripts/ls-pretty-print-scope-bug.output.md index 567a176b64..5c0eab0b7b 100644 --- a/unison-src/transcripts/ls-pretty-print-scope-bug.output.md +++ b/unison-src/transcripts/ls-pretty-print-scope-bug.output.md @@ -24,7 +24,7 @@ unique type Foo = Foo type Foo -.> fork .a.b .c.d.f +scratch/main> fork .a.b .c.d.f Done. @@ -87,27 +87,29 @@ At this point we have: `.c.g.f.Foo` which is distinct from the other `Foo` types ```ucm -.> delete .c.d.f.Foo +scratch/main> delete .c.d.f.Foo Done. ``` Once `.c.d.f.Foo` is deleted `.c.foo` should have the type `.a.b.Foo` -when viewed from `.>`, but an unnamed type when viewed from `.c>`, +when viewed from `scratch/main>`, but an unnamed type when viewed from `.c>`, since referencing `.a.b.Foo` would reference names outside of the namespace rooted at `.c`. ```ucm -.> ls c +scratch/main> ls c - 1. d/ (1 term) - 2. foo (b.Foo) - 3. g/ (1 term, 1 type) + nothing to show -.c> ls +``` - 1. d/ (1 term) - 2. foo (#uj8oalgadr) - 3. g/ (1 term, 1 type) -``` + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + + + nothing to show + diff --git a/unison-src/transcripts/lsp-fold-ranges.md b/unison-src/transcripts/lsp-fold-ranges.md index 377c9170dd..20dddc3861 100644 --- a/unison-src/transcripts/lsp-fold-ranges.md +++ b/unison-src/transcripts/lsp-fold-ranges.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison:hide @@ -29,5 +29,5 @@ test> z = let ``` ```ucm -.> debug.lsp.fold-ranges +scratch/main> debug.lsp.fold-ranges ``` diff --git a/unison-src/transcripts/lsp-fold-ranges.output.md b/unison-src/transcripts/lsp-fold-ranges.output.md index 51f8b4ae9e..2b76b3ff43 100644 --- a/unison-src/transcripts/lsp-fold-ranges.output.md +++ b/unison-src/transcripts/lsp-fold-ranges.output.md @@ -24,7 +24,7 @@ test> z = let ``` ```ucm -.> debug.lsp.fold-ranges +scratch/main> debug.lsp.fold-ranges 《{{ Type doc }}》 《structural type Optional a = diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 1334df76d8..c9ccf0c623 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -48,7 +48,7 @@ project/alice> view foo bar ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Basic merge: two identical adds @@ -89,7 +89,7 @@ project/alice> view foo bar ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Simple update propagation @@ -142,7 +142,7 @@ project/alice> display bar ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Update propagation with common dependent @@ -208,7 +208,7 @@ project/alice> display foo ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Propagating an update to an update @@ -278,7 +278,7 @@ project/alice> display foo ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Update + delete isn't (currently) a conflict @@ -323,7 +323,7 @@ project/alice> view foo ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` In a future version, we'd like to give the user a warning at least. @@ -379,7 +379,7 @@ project/alice> view foo bar baz ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## No-op merge (Bob = Alice) @@ -397,7 +397,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## No-op merge (Bob < Alice) @@ -425,7 +425,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Fast-forward merge (Bob > Alice) @@ -453,7 +453,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: someone deleted something @@ -498,7 +498,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: type error @@ -548,7 +548,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: simple term conflict @@ -613,7 +613,7 @@ project/merge-bob-into-alice> view bar baz ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: simple type conflict @@ -656,7 +656,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: type-update + constructor-rename conflict @@ -699,7 +699,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: constructor-rename conflict @@ -737,7 +737,7 @@ project/alice> merge bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: non-constructor/constructor conflict @@ -778,7 +778,7 @@ project/alice> merge bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: type/type conflict with term/constructor conflict @@ -829,7 +829,7 @@ project/alice> merge bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` Here's a more involved example that demonstrates the same idea. @@ -902,7 +902,7 @@ project/alice> merge bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge algorithm quirk: add/add unique types @@ -960,7 +960,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Conflict involving builtin @@ -1001,7 +1001,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Constructor alias @@ -1047,7 +1047,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Missing constructor name @@ -1094,7 +1094,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Nested decl alias @@ -1142,7 +1142,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Stray constructor alias @@ -1186,7 +1186,7 @@ project/alice> merge bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Term or type in `lib` @@ -1227,7 +1227,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## LCA precondition violations @@ -1293,7 +1293,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Regression tests @@ -1338,7 +1338,7 @@ project/alice> merge /bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Delete a constructor diff --git a/unison-src/transcripts/mergeloop.md b/unison-src/transcripts/mergeloop.md index fd1b25fa8e..455e1ac783 100644 --- a/unison-src/transcripts/mergeloop.md +++ b/unison-src/transcripts/mergeloop.md @@ -43,9 +43,9 @@ b = 2 ```ucm .z> add -.> merge.old x y -.> merge.old y z -.> history z +scratch/main> merge.old x y +scratch/main> merge.old y z +scratch/main> history z ``` diff --git a/unison-src/transcripts/mergeloop.output.md b/unison-src/transcripts/mergeloop.output.md index faa084764b..566c1b1160 100644 --- a/unison-src/transcripts/mergeloop.output.md +++ b/unison-src/transcripts/mergeloop.output.md @@ -126,32 +126,25 @@ b = 2 a : ##Nat b : ##Nat -.> merge.old x y +scratch/main> merge.old x y - Nothing changed as a result of the merge. + ⚠️ + + The namespace x doesn't exist. - Applying changes from patch... +``` -.> merge.old y z +```ucm +.z> addscratch/main> merge.old x yscratch/main> merge.old y zscratch/main> history z +``` - Nothing changed as a result of the merge. - Applying changes from patch... +🛑 -.> history z +The transcript failed due to an error in the stanza above. The error is: - Note: The most recent namespace hash is immediately below this - message. - - - - This segment of history starts with a merge. Use - `history #som3n4m3space` to view history starting from a given - namespace hash. + + ⚠️ - ⊙ 1. #b7fr6ifj87 - ⑃ - 2. #9npggauqo9 - 3. #dm4u1eokg1 + The namespace x doesn't exist. -``` diff --git a/unison-src/transcripts/merges.md b/unison-src/transcripts/merges.md index 330e46857b..659c6059d2 100644 --- a/unison-src/transcripts/merges.md +++ b/unison-src/transcripts/merges.md @@ -11,13 +11,13 @@ x = 42 ``` ```ucm -.> add +scratch/main> add ``` Let's move `x` into a new namespace, `master`: ```ucm -.> rename.term x master.x +scratch/main> rename.term x master.x ``` If you want to do some experimental work in a namespace without disturbing anyone else, you can `fork` it (which is a shorthand for `copy.namespace`). This creates a copy of it, preserving its history. @@ -27,9 +27,9 @@ If you want to do some experimental work in a namespace without disturbing anyon Let's go ahead and do this: ``` -.> fork master feature1 -.> view master.x -.> view feature1.x +scratch/main> fork master feature1 +scratch/main> view master.x +scratch/main> view feature1.x ``` Great! We can now do some further work in the `feature1` branch, then merge it back into `master` when we're ready. @@ -52,9 +52,9 @@ We can also delete the fork if we're done with it. (Don't worry, even though the it's still in the `history` of the parent namespace and can be resurrected at any time.) ```ucm -.> delete.namespace feature1 -.> history .feature1 -.> history +scratch/main> delete.namespace feature1 +scratch/main> history .feature1 +scratch/main> history ``` To resurrect an old version of a namespace, you can learn its hash via the `history` command, then use `fork #namespacehash .newname`. @@ -68,7 +68,7 @@ In the above scenario the destination namespace (`master`) was strictly behind t Let's see how this works. We are going to create a copy of `master`, add and delete some definitions in `master` and in the fork, then merge. ```ucm -.> fork master feature2 +scratch/main> fork master feature2 ``` Here's one fork, we add `z` and delete `x`: @@ -90,29 +90,29 @@ master.frobnicate n = n + 1 ``` ```ucm -.> update -.> view master.y -.> view master.frobnicate +scratch/main> update +scratch/main> view master.y +scratch/main> view master.frobnicate ``` At this point, `master` and `feature2` both have some changes the other doesn't know about. Let's merge them. ```ucm -.> merge.old feature2 master +scratch/main> merge.old feature2 master ``` Notice that `x` is deleted in the merged branch (it was deleted in `feature2` and untouched by `master`): ```ucm:error -.> view master.x +scratch/main> view master.x ``` And notice that `y` has the most recent value, and that `z` and `frobnicate` both exist as well: ```ucm -.> view master.y -.> view master.z -.> view master.frobnicate +scratch/main> view master.y +scratch/main> view master.z +scratch/main> view master.frobnicate ``` ## FAQ diff --git a/unison-src/transcripts/merges.output.md b/unison-src/transcripts/merges.output.md index 8bfbb170fb..8b3694a569 100644 --- a/unison-src/transcripts/merges.output.md +++ b/unison-src/transcripts/merges.output.md @@ -20,17 +20,17 @@ x = 42 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: - x : Nat + x : ##Nat ``` Let's move `x` into a new namespace, `master`: ```ucm -.> rename.term x master.x +scratch/main> rename.term x master.x Done. @@ -41,10 +41,10 @@ If you want to do some experimental work in a namespace without disturbing anyon Let's go ahead and do this: -``` -.> fork master feature1 -.> view master.x -.> view feature1.x +```scratch +/main> fork master feature1 +scratch/main> view master.x +scratch/main> view feature1.x ``` @@ -64,7 +64,7 @@ y = "hello" ⍟ These new definitions are ok to `add`: - y : Text + y : ##Text ``` ```ucm @@ -106,207 +106,25 @@ We can also delete the fork if we're done with it. (Don't worry, even though the it's still in the `history` of the parent namespace and can be resurrected at any time.) ```ucm -.> delete.namespace feature1 - - Done. - -.> history .feature1 - - ☝️ The namespace .feature1 is empty. - -.> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #6j9omad7mv - - - Deletes: - - feature1.y - - ⊙ 2. #59u4sdgodu - - + Adds / updates: - - master.y - - = Copies: - - Original name New name(s) - feature1.y master.y - - ⊙ 3. #0je96at36h - - + Adds / updates: - - feature1.y - - ⊙ 4. #cnv4gjntbl - - > Moves: - - Original name New name - x master.x - - ⊙ 5. #tp0bn8ulih - - + Adds / updates: - - x - - □ 6. #cujaete914 (start of history) - -``` -To resurrect an old version of a namespace, you can learn its hash via the `history` command, then use `fork #namespacehash .newname`. - -## Concurrent edits and merges - -In the above scenario the destination namespace (`master`) was strictly behind the source namespace, so the merge didn't have anything interesting to do (Git would call this a "fast forward" merge). In other cases, the source and destination namespaces will each have changes the other doesn't know about, and the merge needs to something more interesting. That's okay too, and Unison will merge those results, using a 3-way merge algorithm. - -> __Note:__ When merging nested namespaces, Unison actually uses a recursive 3-way merge, so it finds a different (and possibly closer) common ancestor at each level of the tree. - -Let's see how this works. We are going to create a copy of `master`, add and delete some definitions in `master` and in the fork, then merge. - -```ucm -.> fork master feature2 - - Done. - -``` -Here's one fork, we add `z` and delete `x`: - -```unison -z = 99 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - z : Nat - -``` -```ucm -.feature2> add +scratch/main> delete.namespace feature1 - ⍟ I've added these definitions: - - z : Nat - -.feature2> delete.term.verbose x - - Removed definitions: - - 1. x : Nat + ⚠️ - Tip: You can use `undo` or `reflog` to undo this change. - -``` -And here's the other fork, where we update `y` and add a new definition, `frobnicate`: + The namespace feature1 doesn't exist. -```unison -master.y = "updated y" -master.frobnicate n = n + 1 ``` ```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - master.frobnicate : Nat -> Nat - master.y : Text - +scratch/main> delete.namespace feature1scratch/main> history .feature1scratch/main> history ``` -```ucm -.> update - - Okay, I'm searching the branch for code that needs to be - updated... - Done. - -.> view master.y - master.y : Text - master.y = "updated y" +🛑 -.> view master.frobnicate +The transcript failed due to an error in the stanza above. The error is: - master.frobnicate : Nat -> Nat - master.frobnicate n = - use Nat + - n + 1 - -``` -At this point, `master` and `feature2` both have some changes the other doesn't know about. Let's merge them. - -```ucm -.> merge.old feature2 master - - Here's what's changed in master after the merge: - - Added definitions: - - 1. z : Nat - - Removed definitions: - - 2. x : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` -Notice that `x` is deleted in the merged branch (it was deleted in `feature2` and untouched by `master`): - -```ucm -.> view master.x ⚠️ - The following names were not found in the codebase. Check your spelling. - master.x - -``` -And notice that `y` has the most recent value, and that `z` and `frobnicate` both exist as well: - -```ucm -.> view master.y - - master.y : Text - master.y = "updated y" - -.> view master.z - - master.z : Nat - master.z = 99 - -.> view master.frobnicate - - master.frobnicate : Nat -> Nat - master.frobnicate n = - use Nat + - n + 1 - -``` -## FAQ + The namespace feature1 doesn't exist. -* What happens if namespace1 deletes a name that namespace2 has updated? A: ??? -* ... diff --git a/unison-src/transcripts/move-all.md b/unison-src/transcripts/move-all.md index f3a4f5209c..bb1f01dda1 100644 --- a/unison-src/transcripts/move-all.md +++ b/unison-src/transcripts/move-all.md @@ -1,7 +1,7 @@ # Tests for `move` ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ## Happy Path - namespace, term, and type @@ -16,7 +16,7 @@ unique type Foo.T = T ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -25,16 +25,16 @@ unique type Foo.T = T1 | T2 ``` ```ucm -.> update +scratch/main> update ``` Should be able to move the term, type, and namespace, including its types, terms, and sub-namespaces. ```ucm -.> move Foo Bar -.> ls -.> ls Bar -.> history Bar +scratch/main> move Foo Bar +scratch/main> ls +scratch/main> ls Bar +scratch/main> history Bar ``` ## Happy Path - Just term @@ -67,5 +67,5 @@ bonk.zonk = 5 ## Sad Path - No term, type, or namespace named src ```ucm:error -.> move doesntexist foo +scratch/main> move doesntexist foo ``` diff --git a/unison-src/transcripts/move-all.output.md b/unison-src/transcripts/move-all.output.md index f5fefba061..9ec89be763 100644 --- a/unison-src/transcripts/move-all.output.md +++ b/unison-src/transcripts/move-all.output.md @@ -28,7 +28,7 @@ unique type Foo.T = T ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -60,7 +60,7 @@ unique type Foo.T = T1 | T2 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -71,25 +71,25 @@ unique type Foo.T = T1 | T2 Should be able to move the term, type, and namespace, including its types, terms, and sub-namespaces. ```ucm -.> move Foo Bar +scratch/main> move Foo Bar Done. -.> ls +scratch/main> ls 1. Bar (Nat) 2. Bar (type) 3. Bar/ (4 terms, 1 type) 4. builtin/ (469 terms, 74 types) -.> ls Bar +scratch/main> ls Bar 1. Foo (Bar) 2. T (type) 3. T/ (2 terms) 4. termInA (Nat) -.> history Bar +scratch/main> history Bar Note: The most recent namespace hash is immediately below this message. @@ -200,7 +200,7 @@ bonk.zonk = 5 ## Sad Path - No term, type, or namespace named src ```ucm -.> move doesntexist foo +scratch/main> move doesntexist foo ⚠️ diff --git a/unison-src/transcripts/move-namespace.md b/unison-src/transcripts/move-namespace.md index 15c66f74c2..a3d859d9fb 100644 --- a/unison-src/transcripts/move-namespace.md +++ b/unison-src/transcripts/move-namespace.md @@ -103,30 +103,30 @@ I should be able to move the root into a sub-namespace ```ucm -- Should request confirmation -.> move.namespace . .root.at.path -.> move.namespace . .root.at.path -.> ls -.> history +scratch/main> move.namespace . .root.at.path +scratch/main> move.namespace . .root.at.path +scratch/main> ls +scratch/main> history ``` ```ucm -.> ls .root.at.path -.> history .root.at.path +scratch/main> ls .root.at.path +scratch/main> history .root.at.path ``` I should be able to move a sub namespace _over_ the root. ```ucm -- Should request confirmation -.> move.namespace .root.at.path.happy . -.> move.namespace .root.at.path.happy . -.> ls -.> history +scratch/main> move.namespace .root.at.path.happy . +scratch/main> move.namespace .root.at.path.happy . +scratch/main> ls +scratch/main> history ``` ```ucm:error -- should be empty -.> ls .root.at.path.happy -.> history .root.at.path.happy +scratch/main> ls .root.at.path.happy +scratch/main> history .root.at.path.happy ``` diff --git a/unison-src/transcripts/move-namespace.output.md b/unison-src/transcripts/move-namespace.output.md index 9b63baeb67..b044a08910 100644 --- a/unison-src/transcripts/move-namespace.output.md +++ b/unison-src/transcripts/move-namespace.output.md @@ -264,202 +264,32 @@ I should be able to move the root into a sub-namespace ```ucm -- Should request confirmation -.> move.namespace . .root.at.path +scratch/main> move.namespace . .root.at.path ⚠️ Moves which affect the root branch cannot be undone, are you sure? Re-run the same command to proceed. -.> move.namespace . .root.at.path +scratch/main> move.namespace . .root.at.path Done. -.> ls +scratch/main> ls - 1. root/ (1412 terms, 223 types) - -.> history - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #o7cku9c0t9 (start of history) - -``` -```ucm -.> ls .root.at.path - - 1. existing/ (470 terms, 74 types) - 2. happy/ (472 terms, 75 types) - 3. history/ (470 terms, 74 types) - -.> history .root.at.path - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #fv72cqfto4 - - - Deletes: - - existing.b.termInB - - > Moves: - - Original name New name - existing.a.termInA existing.b.termInA - - ⊙ 2. #12iqsb3l9g - - + Adds / updates: - - existing.a.termInA existing.b.termInB - - = Copies: - - Original name New name(s) - happy.b.termInA existing.a.termInA - history.b.termInA existing.a.termInA - - ⊙ 3. #r9jmgtco5u - - + Adds / updates: - - existing.a.termInA existing.b.termInB - - ⊙ 4. #1k6kae1vn4 - - > Moves: - - Original name New name - history.a.termInA history.b.termInA - - ⊙ 5. #ua9re7leg7 - - - Deletes: - - history.b.termInB - - ⊙ 6. #3k8ouql6cc - - + Adds / updates: - - history.a.termInA history.b.termInB - - = Copies: - - Original name New name(s) - happy.b.termInA history.a.termInA - - ⊙ 7. #fp2331i1ek - - + Adds / updates: - - history.a.termInA history.b.termInB - - ⊙ 8. #5sj5jefgcu - - > Moves: - - Original name New name - happy.a.T happy.b.T - happy.a.T.T1 happy.b.T.T1 - happy.a.T.T2 happy.b.T.T2 - happy.a.termInA happy.b.termInA - - ⊙ 9. #ell48pttus - - + Adds / updates: - - happy.a.T happy.a.T.T1 happy.a.T.T2 happy.a.termInA - - - Deletes: - - happy.a.T.T - - ⊙ 10. #al8eguoh70 - - + Adds / updates: - - happy.a.T happy.a.T.T happy.a.termInA - - There's more history before the versions shown here. Use - `history #som3n4m3space` to view history starting from a given - namespace hash. - - ⠇ - - ⊙ 11. #okceqk39nf - + nothing to show ``` -I should be able to move a sub namespace _over_ the root. ```ucm --- Should request confirmation -.> move.namespace .root.at.path.happy . - - ⚠️ - - Moves which affect the root branch cannot be undone, are you sure? - Re-run the same command to proceed. - -.> move.namespace .root.at.path.happy . - - Done. - -.> ls +-- Should request confirmationscratch/main> move.namespace . .root.at.pathscratch/main> move.namespace . .root.at.pathscratch/main> lsscratch/main> history +``` - 1. b/ (3 terms, 1 type) - 2. builtin/ (469 terms, 74 types) -.> history +🛑 - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #0rvi5q5une - - + Adds / updates: - - b.T b.T.T1 b.T.T2 b.termInA - - ⊙ 2. #oaa8ltdusf - - - Deletes: - - a.T a.T.T1 a.T.T2 a.termInA - - ⊙ 3. #t1c91ou7ri - - + Adds / updates: - - a.T a.T.T1 a.T.T2 a.termInA - - - Deletes: - - a.T.T - - ⊙ 4. #hovh08jep4 - - + Adds / updates: - - a.T a.T.T a.termInA - - □ 5. #4bigcpnl7t (start of history) +The transcript failed due to an error in the stanza above. The error is: -``` -```ucm --- should be empty -.> ls .root.at.path.happy nothing to show -.> history .root.at.path.happy - - ☝️ The namespace .root.at.path.happy is empty. - -``` diff --git a/unison-src/transcripts/name-segment-escape.md b/unison-src/transcripts/name-segment-escape.md index a782953188..bf6bca128d 100644 --- a/unison-src/transcripts/name-segment-escape.md +++ b/unison-src/transcripts/name-segment-escape.md @@ -1,8 +1,8 @@ You can use a keyword or reserved operator as a name segment if you surround it with backticks. ```ucm:error -.> view `match` -.> view `=` +scratch/main> view `match` +scratch/main> view `=` ``` You can also use backticks to expand the set of valid symbols in a symboly name segment to include these three: `.()` @@ -10,6 +10,6 @@ You can also use backticks to expand the set of valid symbols in a symboly name This allows you to spell `.` or `()` as name segments (which historically have appeared in the namespace). ```ucm:error -.> view `.` -.> view `()` +scratch/main> view `.` +scratch/main> view `()` ``` diff --git a/unison-src/transcripts/name-segment-escape.output.md b/unison-src/transcripts/name-segment-escape.output.md index 7eef020774..f324018ff7 100644 --- a/unison-src/transcripts/name-segment-escape.output.md +++ b/unison-src/transcripts/name-segment-escape.output.md @@ -1,14 +1,14 @@ You can use a keyword or reserved operator as a name segment if you surround it with backticks. ```ucm -.> view `match` +scratch/main> view `match` ⚠️ The following names were not found in the codebase. Check your spelling. `match` -.> view `=` +scratch/main> view `=` ⚠️ @@ -21,14 +21,14 @@ You can also use backticks to expand the set of valid symbols in a symboly name This allows you to spell `.` or `()` as name segments (which historically have appeared in the namespace). ```ucm -.> view `.` +scratch/main> view `.` ⚠️ The following names were not found in the codebase. Check your spelling. `.` -.> view `()` +scratch/main> view `()` ⚠️ diff --git a/unison-src/transcripts/name-selection.md b/unison-src/transcripts/name-selection.md index 992ee79491..50830d71bc 100644 --- a/unison-src/transcripts/name-selection.md +++ b/unison-src/transcripts/name-selection.md @@ -27,8 +27,8 @@ Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment Next let's introduce a conflicting symbol and show that its hash qualified name isn't used when it has an unconflicted name: ``` -.> fork a a2 -.> fork a a3 +scratch/main> fork a a2 +scratch/main> fork a a3 ``` ```unison:hide @@ -59,7 +59,7 @@ The original `a2` namespace has an unconflicted definition for `c` and `d`, but `a2.c` is chosen because although the suffixified version has fewer segments, its fully-qualified name has the fewest segments. ```ucm -.> view a b c d +scratch/main> view a b c d ``` ## Name biasing diff --git a/unison-src/transcripts/name-selection.output.md b/unison-src/transcripts/name-selection.output.md index e124c18a20..2aa57bf342 100644 --- a/unison-src/transcripts/name-selection.output.md +++ b/unison-src/transcripts/name-selection.output.md @@ -33,9 +33,9 @@ Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment ``` Next let's introduce a conflicting symbol and show that its hash qualified name isn't used when it has an unconflicted name: -``` -.> fork a a2 -.> fork a a3 +```scratch +/main> fork a a2 +scratch/main> fork a a3 ``` @@ -104,114 +104,30 @@ The original `a2` namespace has an unconflicted definition for `c` and `d`, but `a2.c` is chosen because although the suffixified version has fewer segments, its fully-qualified name has the fewest segments. ```ucm -.> view a b c d - - a.a : Nat - a.a = - use Nat + - b + 1 - - a.b : Nat - a.b = - use Nat + - 0 + 1 - - a2.c : Nat - a2.c = 1 - - a2.d : Nat - a2.d = - use Nat + - a2.c + 10 - - a3.c#dcgdua2lj6 : Nat - a3.c#dcgdua2lj6 = 2 - - a3.d#9ivhgvhthc : Nat - a3.d#9ivhgvhthc = - use Nat + - c#dcgdua2lj6 + 10 - -``` -## Name biasing - -```unison -deeply.nested.term = - a + 1 - -deeply.nested.num = 10 - -a = 10 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - a : Nat - deeply.nested.num : Nat - deeply.nested.term : Nat - -``` -```ucm -.biasing> add +scratch/main> view a b c d - ⍟ I've added these definitions: + ⚠️ - a : Nat - deeply.nested.num : Nat - deeply.nested.term : Nat - --- Despite being saved with name `a`, --- the pretty printer should prefer the suffixified 'deeply.nested.num name' over the shallow 'a'. --- It's closer to the term being printed. -.biasing> view deeply.nested.term - - deeply.nested.term : Nat - deeply.nested.term = - use Nat + - num + 1 + The following names were not found in the codebase. Check your spelling. + a + b + c + d ``` -Add another term with `num` suffix to force longer suffixification of `deeply.nested.num` -```unison -other.num = 20 -``` -```ucm - Loading changes detected in scratch.u. +🛑 - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - other.num : Nat +The transcript failed due to an error in the stanza above. The error is: -``` -```ucm -.biasing> add - ⍟ I've added these definitions: + ⚠️ - other.num : Nat - --- nested.num should be preferred over the shorter name `a` due to biasing --- because `deeply.nested.num` is nearby to the term being viewed. -.biasing> view deeply.nested.term + The following names were not found in the codebase. Check your spelling. + a + b + c + d - deeply.nested.term : Nat - deeply.nested.term = - use Nat + - nested.num + 1 - -``` diff --git a/unison-src/transcripts/names.md b/unison-src/transcripts/names.md index 6d395266c4..6c93ea33ef 100644 --- a/unison-src/transcripts/names.md +++ b/unison-src/transcripts/names.md @@ -13,7 +13,7 @@ somewhere.y = 2 ``` ```ucm -.> add +scratch/main> add ``` diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index 8138b5434d..75eff3c3a5 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -30,7 +30,7 @@ somewhere.y = 2 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -46,62 +46,31 @@ somewhere.y = 2 ```ucm -- We can search by suffix and find all definitions named 'x', and each of their aliases respectively. -- But we don't see somewhere.z which is has the same value but is out of our namespace -.some> names x - - Terms - Hash: #gjmq673r1v - Names: otherplace.y place.x - - Hash: #pi25gcdv0o - Names: otherplace.x - - Tip: Use `names.global` to see more results. + ☝️ The namespace .some is empty. --- We can search by hash, and see all aliases of that hash -.some> names #gjmq673r1v +.some> names x - Term - Hash: #gjmq673r1v - Names: otherplace.y place.x + 😶 - Tip: Use `names.global` to see more results. - --- If the query is absolute, treat it as a `names.global` -.some> names .some.place.x - - Term - Hash: #gjmq673r1v - Names: .some.otherplace.y .some.place.x .somewhere.z + I couldn't find anything by that name. Tip: Use `names.global` to see more results. ``` -`names.global` searches from the root, and absolutely qualifies results - ```ucm --- We can search by suffix and find all definitions in the codebase named 'x', and each of their aliases respectively. -.some> names.global x +-- We can search by suffix and find all definitions named 'x', and each of their aliases respectively.-- But we don't see somewhere.z which is has the same value but is out of our namespace.some> names x-- We can search by hash, and see all aliases of that hash.some> names #gjmq673r1v-- If the query is absolute, treat it as a `names.global`.some> names .some.place.x +``` - Terms - Hash: #gjmq673r1v - Names: .some.otherplace.y .some.place.x .somewhere.z - - Hash: #pi25gcdv0o - Names: .some.otherplace.x --- We can search by hash, and see all aliases of that hash in the codebase -.some> names.global #gjmq673r1v +🛑 - Term - Hash: #gjmq673r1v - Names: .some.otherplace.y .some.place.x .somewhere.z +The transcript failed due to an error in the stanza above. The error is: --- We can search using an absolute name -.some> names.global .some.place.x - Term - Hash: #gjmq673r1v - Names: .some.otherplace.y .some.place.x .somewhere.z + 😶 + + I couldn't find anything by that name. + + Tip: Use `names.global` to see more results. -``` diff --git a/unison-src/transcripts/namespace-deletion-regression.md b/unison-src/transcripts/namespace-deletion-regression.md index d33a707100..f9d5fd7410 100644 --- a/unison-src/transcripts/namespace-deletion-regression.md +++ b/unison-src/transcripts/namespace-deletion-regression.md @@ -8,9 +8,9 @@ Previously the following sequence delete the current namespace unexpectedly 😬. ```ucm -.> alias.term ##Nat.+ .Nat.+ -.> ls Nat -.> move.namespace Nat Nat.operators -.> ls Nat -.> ls Nat.operators +scratch/main> alias.term ##Nat.+ .Nat.+ +scratch/main> ls Nat +scratch/main> move.namespace Nat Nat.operators +scratch/main> ls Nat +scratch/main> ls Nat.operators ``` diff --git a/unison-src/transcripts/namespace-deletion-regression.output.md b/unison-src/transcripts/namespace-deletion-regression.output.md index 45af1bfcb3..624501a17b 100644 --- a/unison-src/transcripts/namespace-deletion-regression.output.md +++ b/unison-src/transcripts/namespace-deletion-regression.output.md @@ -8,24 +8,25 @@ Previously the following sequence delete the current namespace unexpectedly 😬. ```ucm -.> alias.term ##Nat.+ .Nat.+ +scratch/main> alias.term ##Nat.+ .Nat.+ Done. -.> ls Nat +scratch/main> ls Nat - 1. + (##Nat -> ##Nat -> ##Nat) + nothing to show -.> move.namespace Nat Nat.operators +``` - Done. +```ucm +scratch/main> alias.term ##Nat.+ .Nat.+scratch/main> ls Natscratch/main> move.namespace Nat Nat.operatorsscratch/main> ls Natscratch/main> ls Nat.operators +``` -.> ls Nat - 1. operators/ (1 term) +🛑 -.> ls Nat.operators +The transcript failed due to an error in the stanza above. The error is: - 1. + (##Nat -> ##Nat -> ##Nat) -``` + nothing to show + diff --git a/unison-src/transcripts/old-fold-right.md b/unison-src/transcripts/old-fold-right.md index f3c01d5d01..179ad5b936 100644 --- a/unison-src/transcripts/old-fold-right.md +++ b/unison-src/transcripts/old-fold-right.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/pattern-match-coverage.md b/unison-src/transcripts/pattern-match-coverage.md index 8c35e07d55..e08ea269ab 100644 --- a/unison-src/transcripts/pattern-match-coverage.md +++ b/unison-src/transcripts/pattern-match-coverage.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` # Basics @@ -292,7 +292,7 @@ unit2t = cases ``` ```ucm -.> add +scratch/main> add ``` Pattern coverage checking needs the data decl map to contain all @@ -316,7 +316,7 @@ evil = bug "" ``` ```ucm -.> add +scratch/main> add ``` ```unison:error @@ -330,7 +330,7 @@ unique type SomeType = A ``` ```ucm -.> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts/pattern-match-coverage.output.md b/unison-src/transcripts/pattern-match-coverage.output.md index 0a0b290c99..b8d30cb252 100644 --- a/unison-src/transcripts/pattern-match-coverage.output.md +++ b/unison-src/transcripts/pattern-match-coverage.output.md @@ -650,7 +650,7 @@ unit2t = cases ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -706,7 +706,7 @@ evil = bug "" ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -747,7 +747,7 @@ unique type SomeType = A ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/pattern-pretty-print-2345.md b/unison-src/transcripts/pattern-pretty-print-2345.md index 0879808f2d..8728aa4d83 100644 --- a/unison-src/transcripts/pattern-pretty-print-2345.md +++ b/unison-src/transcripts/pattern-pretty-print-2345.md @@ -2,7 +2,7 @@ Regression test for https://github.com/unisonweb/unison/pull/2377 ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -65,21 +65,21 @@ doc = cases ``` ```ucm -.> add -.> view dopey -.> view grumpy -.> view happy -.> view sneezy -.> view bashful -.> view mouthy -.> view pokey -.> view sleepy -.> view demure -.> view angry -.> view tremulous -.> view throaty -.> view agitated -.> view doc +scratch/main> add +scratch/main> view dopey +scratch/main> view grumpy +scratch/main> view happy +scratch/main> view sneezy +scratch/main> view bashful +scratch/main> view mouthy +scratch/main> view pokey +scratch/main> view sleepy +scratch/main> view demure +scratch/main> view angry +scratch/main> view tremulous +scratch/main> view throaty +scratch/main> view agitated +scratch/main> view doc ``` diff --git a/unison-src/transcripts/pattern-pretty-print-2345.output.md b/unison-src/transcripts/pattern-pretty-print-2345.output.md index 6c239772d2..6157aa8e7f 100644 --- a/unison-src/transcripts/pattern-pretty-print-2345.output.md +++ b/unison-src/transcripts/pattern-pretty-print-2345.output.md @@ -88,7 +88,7 @@ doc = cases ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -108,94 +108,94 @@ doc = cases throaty : Request {g, Ab} x -> () tremulous : (Nat, Nat) -> () -.> view dopey +scratch/main> view dopey dopey : Char -> () dopey = cases ?0 -> () _ -> () -.> view grumpy +scratch/main> view grumpy grumpy : ff284oqf651 -> () grumpy = cases d -> () -.> view happy +scratch/main> view happy happy : Boolean -> () happy = cases true -> () false -> () -.> view sneezy +scratch/main> view sneezy sneezy : Int -> () sneezy = cases +1 -> () _ -> () -.> view bashful +scratch/main> view bashful bashful : Optional a -> () bashful = cases Some a -> () _ -> () -.> view mouthy +scratch/main> view mouthy mouthy : [t] -> () mouthy = cases [] -> () _ -> () -.> view pokey +scratch/main> view pokey pokey : [t] -> () pokey = cases h +: t -> () _ -> () -.> view sleepy +scratch/main> view sleepy sleepy : [t] -> () sleepy = cases i :+ l -> () _ -> () -.> view demure +scratch/main> view demure demure : [Nat] -> () demure = cases [0] -> () _ -> () -.> view angry +scratch/main> view angry angry : [t] -> () angry = cases a ++ [] -> () -.> view tremulous +scratch/main> view tremulous tremulous : (Nat, Nat) -> () tremulous = cases (0, 1) -> () _ -> () -.> view throaty +scratch/main> view throaty throaty : Request {g, Ab} x -> () throaty = cases { Ab.a a -> k } -> () { _ } -> () -.> view agitated +scratch/main> view agitated agitated : Nat -> () agitated = cases a | a == 2 -> () _ -> () -.> view doc +scratch/main> view doc doc : Nat -> () doc = cases diff --git a/unison-src/transcripts/patternMatchTls.md b/unison-src/transcripts/patternMatchTls.md index cfe5b177cf..dbd8510716 100644 --- a/unison-src/transcripts/patternMatchTls.md +++ b/unison-src/transcripts/patternMatchTls.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` We had bugs in the calling conventions for both send and terminate which would @@ -29,6 +29,6 @@ assertRight = cases ```ucm -.> add -.> run frank +scratch/main> add +scratch/main> run frank ``` diff --git a/unison-src/transcripts/patternMatchTls.output.md b/unison-src/transcripts/patternMatchTls.output.md index b1f82833b5..65aa5153d6 100644 --- a/unison-src/transcripts/patternMatchTls.output.md +++ b/unison-src/transcripts/patternMatchTls.output.md @@ -37,14 +37,14 @@ assertRight = cases ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: assertRight : Either a b -> b frank : '{IO} () -.> run frank +scratch/main> run frank () diff --git a/unison-src/transcripts/patterns.md b/unison-src/transcripts/patterns.md index 104d1bc8ae..8eb309ad75 100644 --- a/unison-src/transcripts/patterns.md +++ b/unison-src/transcripts/patterns.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Some tests of pattern behavior. diff --git a/unison-src/transcripts/project-merge.md b/unison-src/transcripts/project-merge.md index d18fd89cfd..4d27e25931 100644 --- a/unison-src/transcripts/project-merge.md +++ b/unison-src/transcripts/project-merge.md @@ -1,7 +1,7 @@ # projects merge ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -10,8 +10,8 @@ zonk = 0 ```ucm .foo> add -.> project.create-empty foo -.> merge.old foo foo/main +scratch/main> project.create-empty foo +scratch/main> merge.old foo foo/main ``` ```unison @@ -23,7 +23,7 @@ foo/main> add ``` ```ucm -.> project.create-empty bar +scratch/main> project.create-empty bar bar/main> merge.old foo/main bar/main> branch /topic ``` diff --git a/unison-src/transcripts/project-merge.output.md b/unison-src/transcripts/project-merge.output.md index 98f20e79d7..16425c8b88 100644 --- a/unison-src/transcripts/project-merge.output.md +++ b/unison-src/transcripts/project-merge.output.md @@ -1,7 +1,7 @@ # projects merge ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. @@ -32,7 +32,7 @@ zonk = 0 zonk : ##Nat -.> project.create-empty foo +scratch/main> project.create-empty foo 🎉 I've created the project foo. @@ -48,146 +48,22 @@ zonk = 0 🎉 🥳 Happy coding! -.> merge.old foo foo/main +scratch/main> merge.old foo foo/main - Here's what's changed in foo/main after the merge: + ⚠️ - Added definitions: - - 1. zonk : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... + The namespace foo doesn't exist. ``` -```unison -bonk = 2 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - bonk : Nat - -``` -```ucm -foo/main> add - ⍟ I've added these definitions: - - bonk : ##Nat -``` -```ucm -.> project.create-empty bar - 🎉 I've created the project bar. +🛑 - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! +The transcript failed due to an error in the stanza above. The error is: -bar/main> merge.old foo/main - Here's what's changed in the current namespace after the - merge: + ⚠️ - Added definitions: - - 1. bonk : ##Nat - 2. zonk : ##Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -bar/main> branch /topic + The namespace foo doesn't exist. - Done. I've created the topic branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic`. - -``` -```unison -xonk = 1 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - xonk : ##Nat - -``` -```ucm -bar/main> add - - ⍟ I've added these definitions: - - xonk : ##Nat - -bar/topic> merge.old /main - - Here's what's changed in the current namespace after the - merge: - - Added definitions: - - 1. xonk : ##Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - - ☝️ The namespace .bar is empty. - -.bar> merge.old foo/main - - Here's what's changed in the current namespace after the - merge: - - Added definitions: - - 1. bonk : ##Nat - 2. zonk : ##Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` diff --git a/unison-src/transcripts/propagate.md b/unison-src/transcripts/propagate.md index cc80ef885c..ea0e8d8b0f 100644 --- a/unison-src/transcripts/propagate.md +++ b/unison-src/transcripts/propagate.md @@ -84,7 +84,7 @@ type of `otherTerm` should remain the same. Cleaning up a bit... ```ucm -.> delete.namespace subpath +scratch/main> delete.namespace subpath .subpath.lib> builtins.merge ``` diff --git a/unison-src/transcripts/propagate.output.md b/unison-src/transcripts/propagate.output.md index 5f0b72bb35..db8dceb6d4 100644 --- a/unison-src/transcripts/propagate.output.md +++ b/unison-src/transcripts/propagate.output.md @@ -180,92 +180,25 @@ type of `otherTerm` should remain the same. Cleaning up a bit... ```ucm -.> delete.namespace subpath +scratch/main> delete.namespace subpath - Done. - - ☝️ The namespace .subpath.lib is empty. - -.subpath.lib> builtins.merge - - Done. - -``` -Now, we make two terms, where one depends on the other. - -```unison -one.someTerm : Optional foo -> Optional foo -one.someTerm x = x - -one.otherTerm : Optional baz -> Optional baz -one.otherTerm y = someTerm y -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: + ⚠️ - ⍟ These new definitions are ok to `add`: - - one.otherTerm : Optional baz -> Optional baz - one.someTerm : Optional foo -> Optional foo + The namespace subpath doesn't exist. ``` -We'll make two copies of this namespace. ```ucm -.subpath> add - - ⍟ I've added these definitions: - - one.otherTerm : Optional baz -> Optional baz - one.someTerm : Optional foo -> Optional foo - -.subpath> fork one two - - Done. - +scratch/main> delete.namespace subpath.subpath.lib> builtins.merge ``` -Now let's edit one of the terms... -```unison -someTerm : Optional x -> Optional x -someTerm _ = None -``` -```ucm +🛑 - Loading changes detected in scratch.u. +The transcript failed due to an error in the stanza above. The error is: - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - someTerm : Optional x -> Optional x -``` -... in one of the namespaces... - -```ucm -.subpath.one> update.old - - ⍟ I've updated these names to your new definition: + ⚠️ - someTerm : #nirp5os0q6 x -> #nirp5os0q6 x + The namespace subpath doesn't exist. -``` -The other namespace should be left alone. - -```ucm -.subpath> view two.someTerm - - two.someTerm : Optional foo -> Optional foo - two.someTerm x = x - -``` diff --git a/unison-src/transcripts/records.md b/unison-src/transcripts/records.md index 4a3d5d23d2..199218f3ea 100644 --- a/unison-src/transcripts/records.md +++ b/unison-src/transcripts/records.md @@ -1,8 +1,8 @@ Ensure that Records keep their syntax after being added to the codebase ```ucm:hide -.> builtins.merge -.> load unison-src/transcripts-using-base/base.u +scratch/main> builtins.merge +scratch/main> load unison-src/transcripts-using-base/base.u ``` ## Record with 1 field @@ -12,11 +12,11 @@ unique type Record1 = { a : Text } ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view Record1 +scratch/main> view Record1 ``` ## Record with 2 fields @@ -26,11 +26,11 @@ unique type Record2 = { a : Text, b : Int } ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view Record2 +scratch/main> view Record2 ``` ## Record with 3 fields @@ -40,11 +40,11 @@ unique type Record3 = { a : Text, b : Int, c : Nat } ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view Record3 +scratch/main> view Record3 ``` ## Record with many fields @@ -62,11 +62,11 @@ unique type Record4 = ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view Record4 +scratch/main> view Record4 ``` ## Record with many many fields @@ -98,11 +98,11 @@ unique type Record5 = { ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> view Record5 +scratch/main> view Record5 ``` ## Record with user-defined type fields @@ -116,13 +116,13 @@ unique type RecordWithUserType = { a : Text, b : Record4, c : UserType } ``` ```ucm:hide -.> add +scratch/main> add ``` If you `view` or `edit` it, it _should_ be treated as a record type, but it does not (which is a bug) ```ucm -.> view RecordWithUserType +scratch/main> view RecordWithUserType ``` diff --git a/unison-src/transcripts/records.output.md b/unison-src/transcripts/records.output.md index 064e18c690..315bec4bb9 100644 --- a/unison-src/transcripts/records.output.md +++ b/unison-src/transcripts/records.output.md @@ -7,7 +7,7 @@ unique type Record1 = { a : Text } ``` ```ucm -.> view Record1 +scratch/main> view Record1 type Record1 = { a : Text } @@ -19,7 +19,7 @@ unique type Record2 = { a : Text, b : Int } ``` ```ucm -.> view Record2 +scratch/main> view Record2 type Record2 = { a : Text, b : Int } @@ -31,7 +31,7 @@ unique type Record3 = { a : Text, b : Int, c : Nat } ``` ```ucm -.> view Record3 +scratch/main> view Record3 type Record3 = { a : Text, b : Int, c : Nat } @@ -51,7 +51,7 @@ unique type Record4 = ``` ```ucm -.> view Record4 +scratch/main> view Record4 type Record4 = { a : Text, @@ -92,7 +92,7 @@ unique type Record5 = { ``` ```ucm -.> view Record5 +scratch/main> view Record5 type Record5 = { zero : Nat, @@ -131,7 +131,7 @@ unique type RecordWithUserType = { a : Text, b : Record4, c : UserType } If you `view` or `edit` it, it _should_ be treated as a record type, but it does not (which is a bug) ```ucm -.> view RecordWithUserType +scratch/main> view RecordWithUserType type RecordWithUserType = { a : Text, b : Record4, c : UserType } diff --git a/unison-src/transcripts/reflog.md b/unison-src/transcripts/reflog.md index 202dc50820..47f8aa598d 100644 --- a/unison-src/transcripts/reflog.md +++ b/unison-src/transcripts/reflog.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` First we make two changes to the codebase, so that there's more than one line @@ -9,23 +9,23 @@ for the `reflog` command to display: x = 1 ``` ```ucm -.> add +scratch/main> add ``` ```unison y = 2 ``` ```ucm -.> add -.> view y +scratch/main> add +scratch/main> view y ``` ```ucm -.> reflog +scratch/main> reflog ``` If we `reset-root` to its previous value, `y` disappears. ```ucm -.> reset-root 2 +scratch/main> reset-root 2 ``` ```ucm:error -.> view y +scratch/main> view y ``` diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index 96e68114ff..75d0bb1eae 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -19,7 +19,7 @@ x = 1 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -44,36 +44,36 @@ y = 2 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: y : Nat -.> view y +scratch/main> view y y : Nat y = 2 ``` ```ucm -.> reflog +scratch/main> reflog Here is a log of the root namespace hashes, starting with the most recent, along with the command that got us there. Try: `fork 2 .old` - `fork #p611n6o5ve .old` to make an old namespace + `fork #86h1kthpsh .old` to make an old namespace accessible again, - `reset-root #p611n6o5ve` to reset the root namespace and + `reset-root #86h1kthpsh` to reset the root namespace and its history to that of the specified namespace. When Root Hash Action - 1. now #rmu2vgm86a add - 2. now #p611n6o5ve add - 3. now #4bigcpnl7t builtins.merge + 1. now #0de5f40rcr add + 2. now #86h1kthpsh add + 3. now #ei3jcs9f6v builtins.merge 4. #sg60bvjo91 history starts here Tip: Use `diff.namespace 1 7` to compare namespaces between @@ -82,13 +82,13 @@ y = 2 ``` If we `reset-root` to its previous value, `y` disappears. ```ucm -.> reset-root 2 +scratch/main> reset-root 2 Done. ``` ```ucm -.> view y +scratch/main> view y ⚠️ diff --git a/unison-src/transcripts/reset.md b/unison-src/transcripts/reset.md index a01351233d..f8d18e7822 100644 --- a/unison-src/transcripts/reset.md +++ b/unison-src/transcripts/reset.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` # reset loose code @@ -8,10 +8,10 @@ a = 5 ``` ```ucm -.> add -.> history -.> reset 2 -.> history +scratch/main> add +scratch/main> history +scratch/main> reset 2 +scratch/main> history ``` ```unison @@ -19,11 +19,11 @@ foo.a = 5 ``` ```ucm -.> add -.> ls foo -.> history -.> reset 1 foo -.> ls foo.foo +scratch/main> add +scratch/main> ls foo +scratch/main> history +scratch/main> reset 1 foo +scratch/main> ls foo.foo ``` # reset branch diff --git a/unison-src/transcripts/reset.output.md b/unison-src/transcripts/reset.output.md index 344b2c16f9..9be437365f 100644 --- a/unison-src/transcripts/reset.output.md +++ b/unison-src/transcripts/reset.output.md @@ -17,13 +17,13 @@ a = 5 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: a : Nat -.> history +scratch/main> history Note: The most recent namespace hash is immediately below this message. @@ -36,11 +36,11 @@ a = 5 □ 2. #4bigcpnl7t (start of history) -.> reset 2 +scratch/main> reset 2 Done. -.> history +scratch/main> history Note: The most recent namespace hash is immediately below this message. @@ -68,17 +68,17 @@ foo.a = 5 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: foo.a : Nat -.> ls foo +scratch/main> ls foo 1. a (Nat) -.> history +scratch/main> history Note: The most recent namespace hash is immediately below this message. @@ -91,11 +91,11 @@ foo.a = 5 □ 2. #4bigcpnl7t (start of history) -.> reset 1 foo +scratch/main> reset 1 foo Done. -.> ls foo.foo +scratch/main> ls foo.foo 1. a (Nat) diff --git a/unison-src/transcripts/rsa.md b/unison-src/transcripts/rsa.md index 6b9ed33b53..6fe2118370 100644 --- a/unison-src/transcripts/rsa.md +++ b/unison-src/transcripts/rsa.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/scope-ref.md b/unison-src/transcripts/scope-ref.md index 67fcbc336b..1abf26be2f 100644 --- a/unison-src/transcripts/scope-ref.md +++ b/unison-src/transcripts/scope-ref.md @@ -2,7 +2,7 @@ A short script to test mutable references with local scope. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/squash.md b/unison-src/transcripts/squash.md index f3b010944a..93ccaed4f0 100644 --- a/unison-src/transcripts/squash.md +++ b/unison-src/transcripts/squash.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` # Squash merges @@ -10,8 +10,8 @@ Let's look at some examples. We'll start with a namespace with just the builtins. Let's take a look at the hash of this namespace: ```ucm -.> history builtin -.> fork builtin builtin2 +scratch/main> history builtin +scratch/main> fork builtin builtin2 ``` (We make a copy of `builtin` for use later in this transcript.) @@ -19,7 +19,7 @@ Let's look at some examples. We'll start with a namespace with just the builtins Now suppose we `fork` a copy of builtin, then rename `Nat.+` to `frobnicate`, then rename it back. Notice this produces multiple entries in the history: ```ucm -.> fork builtin mybuiltin +scratch/main> fork builtin mybuiltin .mybuiltin> rename.term Nat.+ Nat.frobnicate .mybuiltin> rename.term Nat.frobnicate Nat.+ .mybuiltin> history @@ -28,15 +28,15 @@ Now suppose we `fork` a copy of builtin, then rename `Nat.+` to `frobnicate`, th If we merge that back into `builtin`, we get that same chain of history: ```ucm -.> merge.old mybuiltin builtin -.> history builtin +scratch/main> merge.old mybuiltin builtin +scratch/main> history builtin ``` Let's try again, but using a `merge.squash` (or just `squash`) instead. The history will be unchanged: ```ucm -.> merge.old.squash mybuiltin builtin2 -.> history builtin2 +scratch/main> merge.old.squash mybuiltin builtin2 +scratch/main> history builtin2 ``` The churn that happened in `mybuiltin` namespace ended up back in the same spot, so the squash merge of that namespace with our original namespace had no effect. @@ -51,8 +51,8 @@ x = 1 ```ucm .trunk> add -.> fork trunk alice -.> fork trunk bob +scratch/main> fork trunk alice +scratch/main> fork trunk bob ``` Alice now does some hacking: @@ -84,34 +84,34 @@ no more = no more At this point, Alice and Bob both have some history beyond what's in trunk: ```ucm -.> history trunk -.> history alice -.> history bob +scratch/main> history trunk +scratch/main> history alice +scratch/main> history bob ``` Alice then squash merges into `trunk`, as does Bob. It's as if Alice and Bob both made their changes in one single commit. ```ucm -.> merge.old.squash alice trunk -.> history trunk -.> merge.old.squash bob trunk -.> history trunk +scratch/main> merge.old.squash alice trunk +scratch/main> history trunk +scratch/main> merge.old.squash bob trunk +scratch/main> history trunk ``` Since squash merges don't produce any merge nodes, we can `undo` a couple times to get back to our starting state: ```ucm -.> undo -.> undo -.> history trunk +scratch/main> undo +scratch/main> undo +scratch/main> history trunk ``` This time, we'll first squash Alice and Bob's changes together before squashing their combined changes into `trunk`. The resulting `trunk` will have just a single entry in it, combining both Alice and Bob's changes: ```ucm -.> merge.old.squash alice bob -.> merge.old.squash bob trunk -.> history trunk +scratch/main> merge.old.squash alice bob +scratch/main> merge.old.squash bob trunk +scratch/main> history trunk ``` So, there you have it. With squashing, you can control the granularity of your history. @@ -121,8 +121,8 @@ So, there you have it. With squashing, you can control the granularity of your h Another thing we can do is `squash` into an empty namespace. This effectively makes a copy of the namespace, but without any of its history: ```ucm -.> merge.old.squash alice nohistoryalice -.> history nohistoryalice +scratch/main> merge.old.squash alice nohistoryalice +scratch/main> history nohistoryalice ``` There's nothing really special here, `squash src dest` discards `src` history that comes after the LCA of `src` and `dest`, it's just that in the case of an empty namespace, that LCA is the beginning of time (the empty namespace), so all the history of `src` is discarded. diff --git a/unison-src/transcripts/squash.output.md b/unison-src/transcripts/squash.output.md index 3698fdfe6a..8c6752c311 100644 --- a/unison-src/transcripts/squash.output.md +++ b/unison-src/transcripts/squash.output.md @@ -6,7 +6,7 @@ Let's look at some examples. We'll start with a namespace with just the builtins. Let's take a look at the hash of this namespace: ```ucm -.> history builtin +scratch/main> history builtin Note: The most recent namespace hash is immediately below this message. @@ -15,7 +15,7 @@ Let's look at some examples. We'll start with a namespace with just the builtins □ 1. #i3vp9o9btm (start of history) -.> fork builtin builtin2 +scratch/main> fork builtin builtin2 Done. @@ -25,505 +25,31 @@ Let's look at some examples. We'll start with a namespace with just the builtins Now suppose we `fork` a copy of builtin, then rename `Nat.+` to `frobnicate`, then rename it back. Notice this produces multiple entries in the history: ```ucm -.> fork builtin mybuiltin +scratch/main> fork builtin mybuiltin Done. -.mybuiltin> rename.term Nat.+ Nat.frobnicate - - Done. - -.mybuiltin> rename.term Nat.frobnicate Nat.+ - - Done. - -.mybuiltin> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #tpkjb488ei - - > Moves: - - Original name New name - Nat.frobnicate Nat.+ - - ⊙ 2. #334ak3epqt - - > Moves: - - Original name New name - Nat.+ Nat.frobnicate - - □ 3. #i3vp9o9btm (start of history) - -``` -If we merge that back into `builtin`, we get that same chain of history: - -```ucm -.> merge.old mybuiltin builtin - - Nothing changed as a result of the merge. - - Applying changes from patch... - -.> history builtin - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #tpkjb488ei - - > Moves: - - Original name New name - Nat.frobnicate Nat.+ - - ⊙ 2. #334ak3epqt - - > Moves: - - Original name New name - Nat.+ Nat.frobnicate - - □ 3. #i3vp9o9btm (start of history) - -``` -Let's try again, but using a `merge.squash` (or just `squash`) instead. The history will be unchanged: - -```ucm -.> merge.old.squash mybuiltin builtin2 - - Nothing changed as a result of the merge. - - 😶 - - builtin2 was already up-to-date with mybuiltin. - -.> history builtin2 - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #i3vp9o9btm (start of history) - -``` -The churn that happened in `mybuiltin` namespace ended up back in the same spot, so the squash merge of that namespace with our original namespace had no effect. - -## Another example - -Let's look at a more interesting example, where the two namespaces have diverged a bit. Here's our starting namespace: - -```unison -x = 1 -``` - -```ucm - ☝️ The namespace .trunk is empty. - -.trunk> add - - ⍟ I've added these definitions: - - x : ##Nat - -.> fork trunk alice - - Done. - -.> fork trunk bob + ☝️ The namespace .mybuiltin is empty. - Done. - -``` -Alice now does some hacking: - -```unison -radNumber = 348 -bodaciousNumero = 2394 -neatoFun x = x -``` - -```ucm -.alice> add - - ⍟ I've added these definitions: - - bodaciousNumero : ##Nat - neatoFun : x -> x - radNumber : ##Nat - -.alice> rename.term radNumber superRadNumber - - Done. - -.alice> rename.term neatoFun productionReadyId - - Done. - -``` -Meanwhile, Bob does his own hacking: - -```unison -whatIsLove = "?" -babyDon'tHurtMe = ".. Don't hurt me..." -no more = no more -``` - -```ucm -.bob> add - - ⍟ I've added these definitions: - - babyDon'tHurtMe : ##Text - no : more -> r - whatIsLove : ##Text - -``` -At this point, Alice and Bob both have some history beyond what's in trunk: - -```ucm -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #i52j9fd57b (start of history) - -.> history alice - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #e9jd55555o - - > Moves: - - Original name New name - neatoFun productionReadyId - - ⊙ 2. #l5ocoo2eac - - > Moves: - - Original name New name - radNumber superRadNumber - - ⊙ 3. #i1vq05628n - - + Adds / updates: - - bodaciousNumero neatoFun radNumber - - □ 4. #i52j9fd57b (start of history) - -.> history bob - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #brr4400742 - - + Adds / updates: - - babyDon'tHurtMe no whatIsLove - - □ 2. #i52j9fd57b (start of history) - -``` -Alice then squash merges into `trunk`, as does Bob. It's as if Alice and Bob both made their changes in one single commit. - -```ucm -.> merge.old.squash alice trunk - - Here's what's changed in trunk after the merge: - - Added definitions: - - 1. bodaciousNumero : Nat - 2. productionReadyId : x -> x - 3. superRadNumber : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #f9lvm9gd2k - - + Adds / updates: - - bodaciousNumero productionReadyId superRadNumber - - □ 2. #i52j9fd57b (start of history) - -.> merge.old.squash bob trunk - - Here's what's changed in trunk after the merge: - - Added definitions: - - 1. babyDon'tHurtMe : Text - 2. no : more -> r - 3. whatIsLove : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #dbp78ts6q3 - - + Adds / updates: - - babyDon'tHurtMe no whatIsLove - - ⊙ 2. #f9lvm9gd2k - - + Adds / updates: - - bodaciousNumero productionReadyId superRadNumber - - □ 3. #i52j9fd57b (start of history) - -``` -Since squash merges don't produce any merge nodes, we can `undo` a couple times to get back to our starting state: - -```ucm -.> undo - - Here are the changes I undid - - Name changes: - - Original Changes - 1. bob.babyDon'tHurtMe 2. trunk.babyDon'tHurtMe (added) - - 3. bob.no 4. trunk.no (added) - - 5. bob.whatIsLove 6. trunk.whatIsLove (added) - -.> undo - - Here are the changes I undid - - Name changes: - - Original Changes - 1. alice.bodaciousNumero 2. trunk.bodaciousNumero (added) - - 3. alice.productionReadyId 4. trunk.productionReadyId (added) - - 5. alice.superRadNumber 6. trunk.superRadNumber (added) - -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #i52j9fd57b (start of history) - -``` -This time, we'll first squash Alice and Bob's changes together before squashing their combined changes into `trunk`. The resulting `trunk` will have just a single entry in it, combining both Alice and Bob's changes: - -```ucm -.> merge.old.squash alice bob - - Here's what's changed in bob after the merge: - - Added definitions: - - 1. bodaciousNumero : Nat - 2. productionReadyId : x -> x - 3. superRadNumber : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> merge.old.squash bob trunk - - Here's what's changed in trunk after the merge: - - Added definitions: - - 1. babyDon'tHurtMe : Text - 2. bodaciousNumero : Nat - 3. no : more -> r - 4. productionReadyId : x -> x - 5. superRadNumber : Nat - 6. whatIsLove : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #qtotqgds4i - - + Adds / updates: - - babyDon'tHurtMe bodaciousNumero no productionReadyId - superRadNumber whatIsLove - - □ 2. #i52j9fd57b (start of history) - -``` -So, there you have it. With squashing, you can control the granularity of your history. - -## Throwing out all history - -Another thing we can do is `squash` into an empty namespace. This effectively makes a copy of the namespace, but without any of its history: - -```ucm -.> merge.old.squash alice nohistoryalice - - Here's what's changed in nohistoryalice after the merge: - - Added definitions: - - 1. bodaciousNumero : Nat - 2. productionReadyId : x -> x - 3. superRadNumber : Nat - 4. x : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history nohistoryalice +.mybuiltin> rename.term Nat.+ Nat.frobnicate - Note: The most recent namespace hash is immediately below this - message. - - + ⚠️ - □ 1. #1d9haupn3d (start of history) + I don't know about that term. ``` -There's nothing really special here, `squash src dest` discards `src` history that comes after the LCA of `src` and `dest`, it's just that in the case of an empty namespace, that LCA is the beginning of time (the empty namespace), so all the history of `src` is discarded. - -## Checking for handling of deletes - -This checks to see that squashing correctly preserves deletions: ```ucm - ☝️ The namespace .delete is empty. - -.delete> builtins.merge - - Done. - -.delete> fork builtin builtin2 - - Done. - -.delete> delete.term.verbose builtin2.Nat.+ - - Name changes: - - Original Changes - 1. builtin.Nat.+ ┐ 2. builtin2.Nat.+ (removed) - 3. builtin2.Nat.+ ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.delete> delete.term.verbose builtin2.Nat.* - - Name changes: - - Original Changes - 1. builtin.Nat.* ┐ 2. builtin2.Nat.* (removed) - 3. builtin2.Nat.* ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.delete> merge.old.squash builtin2 builtin - - Here's what's changed in builtin after the merge: - - Removed definitions: - - 1. Nat.* : Nat -> Nat -> Nat - 2. Nat.+ : Nat -> Nat -> Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.delete> history builtin - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #dv00hf6vmg - - - Deletes: - - Nat.* Nat.+ - - □ 2. #i3vp9o9btm (start of history) - +scratch/main> fork builtin mybuiltin.mybuiltin> rename.term Nat.+ Nat.frobnicate.mybuiltin> rename.term Nat.frobnicate Nat.+.mybuiltin> history ``` -Notice that `Nat.+` and `Nat.*` are deleted by the squash, and we see them deleted in one atomic step in the history. -Just confirming that those two definitions are in fact removed: -```ucm -.delete> view .delete.builtin.Nat.+ +🛑 - ⚠️ - - The following names were not found in the codebase. Check your spelling. - .delete.builtin.Nat.+ +The transcript failed due to an error in the stanza above. The error is: -``` -```ucm -.delete> view .delete.builtin.Nat.* ⚠️ - The following names were not found in the codebase. Check your spelling. - .delete.builtin.Nat.* - -``` -## Caveats + I don't know about that term. -If you `squash mystuff trunk`, you're discarding any history of `mystuff` and just cons'ing onto the history of `trunk`. Thus, don't expect to be able to `merge trunk mystuff later and get great results. Squashing should only be used when you don't care about the history (and you know others haven't pulled and built on your line of history being discarded, so they don't care about the history either). diff --git a/unison-src/transcripts/suffixes.md b/unison-src/transcripts/suffixes.md index 3a4c47933f..7245b4cb31 100644 --- a/unison-src/transcripts/suffixes.md +++ b/unison-src/transcripts/suffixes.md @@ -1,7 +1,7 @@ # Suffix-based resolution of names ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Any unique name suffix can be used to refer to a definition. For instance: @@ -20,15 +20,15 @@ optional.isNone = cases This also affects commands like find. Notice lack of qualified names in output: ```ucm -.> add -.> find take +scratch/main> add +scratch/main> find take ``` The `view` and `display` commands also benefit from this: ```ucm -.> view List.drop -.> display bar.a +scratch/main> view List.drop +scratch/main> display bar.a ``` In the signature, we don't see `base.Nat`, just `Nat`. The full declaration name is still shown for each search result though. @@ -36,7 +36,7 @@ In the signature, we don't see `base.Nat`, just `Nat`. The full declaration name Type-based search also benefits from this, we can just say `Nat` rather than `.base.Nat`: ```ucm -.> find : Nat -> [a] -> [a] +scratch/main> find : Nat -> [a] -> [a] ``` ## Preferring names not in `lib.*.lib.*` @@ -51,7 +51,7 @@ lib.distributed.lib.baz.qux = "indirect dependency" ``` ```ucm -.> add +scratch/main> add ``` ```unison:error @@ -63,15 +63,15 @@ lib.distributed.lib.baz.qux = "indirect dependency" ``` ```ucm -.> view abra.cadabra -.> view baz.qux +scratch/main> view abra.cadabra +scratch/main> view baz.qux ``` Note that we can always still view indirect dependencies by using more name segments: ```ucm -.> view distributed.abra.cadabra -.> names distributed.lib.baz.qux +scratch/main> view distributed.abra.cadabra +scratch/main> names distributed.lib.baz.qux ``` ## Corner cases @@ -86,7 +86,7 @@ bar = 100 ``` ```ucm -.> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts/suffixes.output.md b/unison-src/transcripts/suffixes.output.md index 21aeafa44e..411fdebba3 100644 --- a/unison-src/transcripts/suffixes.output.md +++ b/unison-src/transcripts/suffixes.output.md @@ -16,14 +16,14 @@ optional.isNone = cases This also affects commands like find. Notice lack of qualified names in output: ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: foo.bar.a : Int optional.isNone : Optional a -> Boolean -.> find take +scratch/main> find take 1. builtin.Bytes.take : Nat -> Bytes -> Bytes 2. builtin.List.take : Nat -> [a] -> [a] @@ -36,11 +36,11 @@ This also affects commands like find. Notice lack of qualified names in output: The `view` and `display` commands also benefit from this: ```ucm -.> view List.drop +scratch/main> view List.drop builtin builtin.List.drop : builtin.Nat -> [a] -> [a] -.> display bar.a +scratch/main> display bar.a +99 @@ -50,7 +50,7 @@ In the signature, we don't see `base.Nat`, just `Nat`. The full declaration name Type-based search also benefits from this, we can just say `Nat` rather than `.base.Nat`: ```ucm -.> find : Nat -> [a] -> [a] +scratch/main> find : Nat -> [a] -> [a] 1. builtin.List.drop : Nat -> [a] -> [a] 2. builtin.List.take : Nat -> [a] -> [a] @@ -85,7 +85,7 @@ lib.distributed.lib.baz.qux = "indirect dependency" ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -138,7 +138,7 @@ lib.distributed.lib.baz.qux = "indirect dependency" ``` ```ucm -.> view abra.cadabra +scratch/main> view abra.cadabra cool.abra.cadabra : Text cool.abra.cadabra = "my project" @@ -146,7 +146,7 @@ lib.distributed.lib.baz.qux = "indirect dependency" lib.distributed.abra.cadabra : Text lib.distributed.abra.cadabra = "direct dependency 1" -.> view baz.qux +scratch/main> view baz.qux lib.distributed.baz.qux : Text lib.distributed.baz.qux = "direct dependency 2" @@ -155,12 +155,12 @@ lib.distributed.lib.baz.qux = "indirect dependency" Note that we can always still view indirect dependencies by using more name segments: ```ucm -.> view distributed.abra.cadabra +scratch/main> view distributed.abra.cadabra lib.distributed.abra.cadabra : Text lib.distributed.abra.cadabra = "direct dependency 1" -.> names distributed.lib.baz.qux +scratch/main> names distributed.lib.baz.qux Term Hash: #nhup096n2s @@ -181,7 +181,7 @@ bar = 100 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/switch-command.md b/unison-src/transcripts/switch-command.md index c1a2bca962..13e33c8583 100644 --- a/unison-src/transcripts/switch-command.md +++ b/unison-src/transcripts/switch-command.md @@ -22,8 +22,8 @@ the current project can be preceded by a forward slash (which makes it unambiguo forward slash (which makes it unambiguous). ```ucm -.> switch foo -.> switch foo/topic +scratch/main> switch foo +scratch/main> switch foo/topic foo/main> switch topic foo/main> switch /topic foo/main> switch bar/ @@ -38,11 +38,11 @@ foo/main> switch bar It's an error to try to switch to something that doesn't exist, of course. ```ucm:error -.> switch foo/no-such-branch +scratch/main> switch foo/no-such-branch ``` ```ucm:error -.> switch no-such-project +scratch/main> switch no-such-project ``` ```ucm:error diff --git a/unison-src/transcripts/switch-command.output.md b/unison-src/transcripts/switch-command.output.md index 2542da7b32..e84fefd0ab 100644 --- a/unison-src/transcripts/switch-command.output.md +++ b/unison-src/transcripts/switch-command.output.md @@ -46,9 +46,9 @@ the current project can be preceded by a forward slash (which makes it unambiguo forward slash (which makes it unambiguous). ```ucm -.> switch foo +scratch/main> switch foo -.> switch foo/topic +scratch/main> switch foo/topic foo/main> switch topic @@ -74,15 +74,16 @@ foo/main> switch bar It's an error to try to switch to something that doesn't exist, of course. ```ucm -.> switch foo/no-such-branch +scratch/main> switch foo/no-such-branch foo/no-such-branch does not exist. ``` ```ucm -.> switch no-such-project +scratch/main> switch no-such-project - no-such-project does not exist. + Neither project no-such-project nor branch /no-such-project + exists. ``` ```ucm diff --git a/unison-src/transcripts/tab-completion.md b/unison-src/transcripts/tab-completion.md index c35c4ba347..28ba55c8dd 100644 --- a/unison-src/transcripts/tab-completion.md +++ b/unison-src/transcripts/tab-completion.md @@ -5,8 +5,8 @@ Test that tab completion works as expected. ## Tab Complete Command Names ```ucm -.> debug.tab-complete vi -.> debug.tab-complete delete. +scratch/main> debug.tab-complete vi +scratch/main> debug.tab-complete delete. ``` ## Tab complete terms & types @@ -21,21 +21,21 @@ unique type subnamespace.AType = A | B ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -- Should tab complete namespaces since they may contain terms/types -.> debug.tab-complete view sub +scratch/main> debug.tab-complete view sub -- Should not complete things from child namespaces of the current query if there are other completions at this level -.> debug.tab-complete view subnamespace +scratch/main> debug.tab-complete view subnamespace -- Should complete things from child namespaces of the current query if it's dot-suffixed -.> debug.tab-complete view subnamespace. +scratch/main> debug.tab-complete view subnamespace. -- Should complete things from child namespaces of the current query if there are no more completions at this level. -.> debug.tab-complete view subnamespace2 +scratch/main> debug.tab-complete view subnamespace2 -- Should prefix-filter by query suffix -.> debug.tab-complete view subnamespace.some -.> debug.tab-complete view subnamespace.someOther +scratch/main> debug.tab-complete view subnamespace.some +scratch/main> debug.tab-complete view subnamespace.someOther -- Should tab complete absolute names .othernamespace> debug.tab-complete view .subnamespace.some ``` @@ -44,12 +44,12 @@ unique type subnamespace.AType = A | B ```ucm -- Should tab complete namespaces -.> debug.tab-complete find-in sub -.> debug.tab-complete find-in subnamespace -.> debug.tab-complete find-in subnamespace. -.> debug.tab-complete io.test sub -.> debug.tab-complete io.test subnamespace -.> debug.tab-complete io.test subnamespace. +scratch/main> debug.tab-complete find-in sub +scratch/main> debug.tab-complete find-in subnamespace +scratch/main> debug.tab-complete find-in subnamespace. +scratch/main> debug.tab-complete io.test sub +scratch/main> debug.tab-complete io.test subnamespace +scratch/main> debug.tab-complete io.test subnamespace. ``` Tab Complete Delete Subcommands @@ -61,9 +61,9 @@ add b = b ``` ```ucm -.> update.old -.> debug.tab-complete delete.type Foo -.> debug.tab-complete delete.term add +scratch/main> update.old +scratch/main> debug.tab-complete delete.type Foo +scratch/main> debug.tab-complete delete.term add ``` ## Tab complete projects and branches diff --git a/unison-src/transcripts/tab-completion.output.md b/unison-src/transcripts/tab-completion.output.md index 82961cfd5c..3537f7e16d 100644 --- a/unison-src/transcripts/tab-completion.output.md +++ b/unison-src/transcripts/tab-completion.output.md @@ -5,12 +5,12 @@ Test that tab completion works as expected. ## Tab Complete Command Names ```ucm -.> debug.tab-complete vi +scratch/main> debug.tab-complete vi view view.global -.> debug.tab-complete delete. +scratch/main> debug.tab-complete delete. delete.branch delete.namespace @@ -53,19 +53,19 @@ unique type subnamespace.AType = A | B ``` ```ucm -- Should tab complete namespaces since they may contain terms/types -.> debug.tab-complete view sub +scratch/main> debug.tab-complete view sub subnamespace. subnamespace2. -- Should not complete things from child namespaces of the current query if there are other completions at this level -.> debug.tab-complete view subnamespace +scratch/main> debug.tab-complete view subnamespace subnamespace. subnamespace2. -- Should complete things from child namespaces of the current query if it's dot-suffixed -.> debug.tab-complete view subnamespace. +scratch/main> debug.tab-complete view subnamespace. * subnamespace.AType subnamespace.AType. @@ -73,57 +73,58 @@ unique type subnamespace.AType = A | B * subnamespace.someOtherName -- Should complete things from child namespaces of the current query if there are no more completions at this level. -.> debug.tab-complete view subnamespace2 +scratch/main> debug.tab-complete view subnamespace2 subnamespace2. * subnamespace2.thing -- Should prefix-filter by query suffix -.> debug.tab-complete view subnamespace.some +scratch/main> debug.tab-complete view subnamespace.some * subnamespace.someName * subnamespace.someOtherName -.> debug.tab-complete view subnamespace.someOther +scratch/main> debug.tab-complete view subnamespace.someOther * subnamespace.someOtherName -- Should tab complete absolute names + ☝️ The namespace .othernamespace is empty. + .othernamespace> debug.tab-complete view .subnamespace.some - * .subnamespace.someName - * .subnamespace.someOtherName + ``` ## Tab complete namespaces ```ucm -- Should tab complete namespaces -.> debug.tab-complete find-in sub +scratch/main> debug.tab-complete find-in sub subnamespace subnamespace2 -.> debug.tab-complete find-in subnamespace +scratch/main> debug.tab-complete find-in subnamespace subnamespace subnamespace2 -.> debug.tab-complete find-in subnamespace. +scratch/main> debug.tab-complete find-in subnamespace. subnamespace.AType -.> debug.tab-complete io.test sub +scratch/main> debug.tab-complete io.test sub subnamespace. subnamespace2. -.> debug.tab-complete io.test subnamespace +scratch/main> debug.tab-complete io.test subnamespace subnamespace. subnamespace2. -.> debug.tab-complete io.test subnamespace. +scratch/main> debug.tab-complete io.test subnamespace. subnamespace.AType. * subnamespace.someName @@ -153,19 +154,19 @@ add b = b ``` ```ucm -.> update.old +scratch/main> update.old ⍟ I've added these definitions: type Foo add : a -> a -.> debug.tab-complete delete.type Foo +scratch/main> debug.tab-complete delete.type Foo * Foo Foo. -.> debug.tab-complete delete.term add +scratch/main> debug.tab-complete delete.term add * add diff --git a/unison-src/transcripts/test-command.md b/unison-src/transcripts/test-command.md index 2f95c846b7..f4c80cb840 100644 --- a/unison-src/transcripts/test-command.md +++ b/unison-src/transcripts/test-command.md @@ -1,7 +1,7 @@ Merge builtins so we get enough names for the testing stuff. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` The `test` command should run all of the tests in the current directory. @@ -15,17 +15,17 @@ foo.test2 = [Ok "test2"] ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -.> test +scratch/main> test ``` Tests should be cached if unchanged. ```ucm -.> test +scratch/main> test ``` `test` won't descend into the `lib` namespace, but `test.all` will. @@ -40,8 +40,8 @@ testInLib = [Ok "testInLib"] ``` ```ucm -.> test -.> test.all +scratch/main> test +scratch/main> test.all ``` `test` WILL run tests within `lib` if ucm is cd'd inside. @@ -53,5 +53,5 @@ testInLib = [Ok "testInLib"] `test` can be given a relative path, in which case it will only run tests found somewhere in that namespace. ```ucm -.> test foo +scratch/main> test foo ``` diff --git a/unison-src/transcripts/test-command.output.md b/unison-src/transcripts/test-command.output.md index a59faee54c..b7c3eaa535 100644 --- a/unison-src/transcripts/test-command.output.md +++ b/unison-src/transcripts/test-command.output.md @@ -25,7 +25,7 @@ foo.test2 = [Ok "test2"] ``` ```ucm -.> test +scratch/main> test ✅ @@ -50,7 +50,7 @@ foo.test2 = [Ok "test2"] Tests should be cached if unchanged. ```ucm -.> test +scratch/main> test Cached test results (`help testcache` to learn more) @@ -83,7 +83,7 @@ testInLib = [Ok "testInLib"] ``` ```ucm -.> test +scratch/main> test Cached test results (`help testcache` to learn more) @@ -94,29 +94,16 @@ testInLib = [Ok "testInLib"] Tip: Use view foo.test2 to view the source of a test. -.> test.all +scratch/main> test.all - - Cached test results (`help testcache` to learn more) - - ◉ foo.test2 test2 - ◉ test1 test1 - - ✅ 2 test(s) passing - - ✅ - - - - - - New test results: + Cached test results (`help testcache` to learn more) - ◉ lib.testInLib testInLib + ◉ foo.test2 test2 + ◉ test1 test1 - ✅ 1 test(s) passing + ✅ 2 test(s) passing - Tip: Use view lib.testInLib to view the source of a test. + Tip: Use view foo.test2 to view the source of a test. ``` `test` WILL run tests within `lib` if ucm is cd'd inside. @@ -124,7 +111,13 @@ testInLib = [Ok "testInLib"] ```ucm .lib> test - Cached test results (`help testcache` to learn more) + ✅ + + + + + + New test results: ◉ testInLib testInLib @@ -136,7 +129,7 @@ testInLib = [Ok "testInLib"] `test` can be given a relative path, in which case it will only run tests found somewhere in that namespace. ```ucm -.> test foo +scratch/main> test foo Cached test results (`help testcache` to learn more) diff --git a/unison-src/transcripts/text-literals.md b/unison-src/transcripts/text-literals.md index 06898d1452..3d3b1359aa 100644 --- a/unison-src/transcripts/text-literals.md +++ b/unison-src/transcripts/text-literals.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` This transcript shows some syntax for raw text literals. @@ -37,6 +37,6 @@ lit2 = """" ``` ```ucm -.> add -.> view lit1 lit2 +scratch/main> add +scratch/main> view lit1 lit2 ``` \ No newline at end of file diff --git a/unison-src/transcripts/text-literals.output.md b/unison-src/transcripts/text-literals.output.md index efb094d98c..1889ec8e78 100644 --- a/unison-src/transcripts/text-literals.output.md +++ b/unison-src/transcripts/text-literals.output.md @@ -87,14 +87,14 @@ lit2 = """" ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: lit1 : Text lit2 : Text -.> view lit1 lit2 +scratch/main> view lit1 lit2 lit1 : Text lit1 = diff --git a/unison-src/transcripts/todo-bug-builtins.md b/unison-src/transcripts/todo-bug-builtins.md index c7d88fb784..e472204d4c 100644 --- a/unison-src/transcripts/todo-bug-builtins.md +++ b/unison-src/transcripts/todo-bug-builtins.md @@ -1,7 +1,7 @@ # The `todo` and `bug` builtin ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` `todo` and `bug` have type `a -> b`. They take a message or a value of type `a` and crash during runtime displaying `a` in ucm. diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index 7f3affeb12..9f47cc290e 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -19,9 +19,9 @@ baz = foo.bar + foo.bar I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: - + baz : Nat foo.bar : Nat @@ -30,7 +30,7 @@ baz = foo.bar + foo.bar project/main> add ⍟ I've added these definitions: - + baz : Nat foo.bar : Nat @@ -39,17 +39,17 @@ project/main> delete.namespace.force foo Done. ⚠️ - + Of the things I deleted, the following are still used in the following definitions. They now contain un-named references. - + Dependency Referenced In bar 1. baz project/main> todo These terms do not have any names in the current namespace: - + 1. #1jujb8oelv ``` diff --git a/unison-src/transcripts/top-level-exceptions.md b/unison-src/transcripts/top-level-exceptions.md index 8749984744..4caf9d717c 100644 --- a/unison-src/transcripts/top-level-exceptions.md +++ b/unison-src/transcripts/top-level-exceptions.md @@ -2,13 +2,13 @@ A simple transcript to test the use of exceptions that bubble to the top level. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` FYI, here are the `Exception` and `Failure` types: ```ucm -.> view Exception Failure +scratch/main> view Exception Failure ``` Here's a sample program just to verify that the typechecker allows `run` to throw exceptions: @@ -24,9 +24,9 @@ mytest _ = [Ok "Great"] ``` ```ucm -.> run main -.> add -.> io.test mytest +scratch/main> run main +scratch/main> add +scratch/main> io.test mytest ``` Now a test to show the handling of uncaught exceptions: @@ -42,5 +42,5 @@ unique type RuntimeError = ``` ```ucm:error -.> run main2 +scratch/main> run main2 ``` diff --git a/unison-src/transcripts/top-level-exceptions.output.md b/unison-src/transcripts/top-level-exceptions.output.md index 745e94c657..d06445332b 100644 --- a/unison-src/transcripts/top-level-exceptions.output.md +++ b/unison-src/transcripts/top-level-exceptions.output.md @@ -4,7 +4,7 @@ A simple transcript to test the use of exceptions that bubble to the top level. FYI, here are the `Exception` and `Failure` types: ```ucm -.> view Exception Failure +scratch/main> view Exception Failure structural ability builtin.Exception where raise : Failure ->{builtin.Exception} x @@ -40,18 +40,18 @@ mytest _ = [Ok "Great"] ``` ```ucm -.> run main +scratch/main> run main () -.> add +scratch/main> add ⍟ I've added these definitions: main : '{IO, Exception} () mytest : '{IO, Exception} [Result] -.> io.test mytest +scratch/main> io.test mytest New test results: @@ -90,7 +90,7 @@ unique type RuntimeError = ``` ```ucm -.> run main2 +scratch/main> run main2 💔💥 diff --git a/unison-src/transcripts/type-deps.md b/unison-src/transcripts/type-deps.md index 142265c786..e63b539d50 100644 --- a/unison-src/transcripts/type-deps.md +++ b/unison-src/transcripts/type-deps.md @@ -3,7 +3,7 @@ https://github.com/unisonweb/unison/pull/2821 ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` @@ -14,7 +14,7 @@ structural type Y = Y ``` ```ucm:hide -.> add +scratch/main> add ``` Now, we update `Y`, and add a new type `Z` which depends on it. @@ -26,7 +26,7 @@ structural type Y = Y Nat Adding should fail for BOTH definitions, `Y` needs an update and `Z` is blocked by `Y`. ```ucm:error -.> add +scratch/main> add -- This shouldn't exist, because it should've been blocked. -.> view Z +scratch/main> view Z ``` diff --git a/unison-src/transcripts/type-deps.output.md b/unison-src/transcripts/type-deps.output.md index b3a18e310d..ad1205e1ef 100644 --- a/unison-src/transcripts/type-deps.output.md +++ b/unison-src/transcripts/type-deps.output.md @@ -36,7 +36,7 @@ structural type Y = Y Nat ``` Adding should fail for BOTH definitions, `Y` needs an update and `Z` is blocked by `Y`. ```ucm -.> add +scratch/main> add x These definitions failed: @@ -47,7 +47,7 @@ Adding should fail for BOTH definitions, `Y` needs an update and `Z` is blocked Tip: Use `help filestatus` to learn more. -- This shouldn't exist, because it should've been blocked. -.> view Z +scratch/main> view Z ⚠️ diff --git a/unison-src/transcripts/type-modifier-are-optional.md b/unison-src/transcripts/type-modifier-are-optional.md index abce0ad0b8..f0a13f59ea 100644 --- a/unison-src/transcripts/type-modifier-are-optional.md +++ b/unison-src/transcripts/type-modifier-are-optional.md @@ -1,7 +1,7 @@ # Type modifiers are optional, `unique` is the default. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Types and abilities may be prefixed with either `unique` or `structural`. When left unspecified, `unique` is assumed. diff --git a/unison-src/transcripts/unique-type-churn.md b/unison-src/transcripts/unique-type-churn.md index 904e1c480c..d35b2fa09a 100644 --- a/unison-src/transcripts/unique-type-churn.md +++ b/unison-src/transcripts/unique-type-churn.md @@ -9,7 +9,7 @@ unique type C = C B ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -22,7 +22,7 @@ unique type C = C B If the name stays the same, the churn is even prevented if the type is updated and then reverted to the original form. ```ucm -.> names A +scratch/main> names A ``` ```unison @@ -30,8 +30,8 @@ unique type A = A () ``` ```ucm -.> update -.> names A +scratch/main> update +scratch/main> names A ``` ```unison @@ -41,6 +41,6 @@ unique type A = A Note that `A` is back to its original hash. ```ucm -.> update -.> names A +scratch/main> update +scratch/main> names A ``` diff --git a/unison-src/transcripts/unique-type-churn.output.md b/unison-src/transcripts/unique-type-churn.output.md index bcee03f59e..74076d8c6d 100644 --- a/unison-src/transcripts/unique-type-churn.output.md +++ b/unison-src/transcripts/unique-type-churn.output.md @@ -24,7 +24,7 @@ unique type C = C B ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -51,7 +51,7 @@ unique type C = C B If the name stays the same, the churn is even prevented if the type is updated and then reverted to the original form. ```ucm -.> names A +scratch/main> names A Type Hash: #uj8oalgadr @@ -83,14 +83,14 @@ unique type A = A () ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> names A +scratch/main> names A Type Hash: #ufo5tuc7ho @@ -124,14 +124,14 @@ unique type A = A Note that `A` is back to its original hash. ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> names A +scratch/main> names A Type Hash: #uj8oalgadr diff --git a/unison-src/transcripts/unitnamespace.md b/unison-src/transcripts/unitnamespace.md index 0f6838dae5..41884f13c4 100644 --- a/unison-src/transcripts/unitnamespace.md +++ b/unison-src/transcripts/unitnamespace.md @@ -4,7 +4,7 @@ foo = "bar" ```ucm .`()`> add -.> find -.> find-in `()` -.> delete.namespace `()` +scratch/main> find +scratch/main> find-in `()` +scratch/main> delete.namespace `()` ``` diff --git a/unison-src/transcripts/unitnamespace.output.md b/unison-src/transcripts/unitnamespace.output.md index 9e18ea08ef..1b5ee1893b 100644 --- a/unison-src/transcripts/unitnamespace.output.md +++ b/unison-src/transcripts/unitnamespace.output.md @@ -24,18 +24,38 @@ foo = "bar" foo : ##Text -.> find +scratch/main> find - 1. `()`.foo : ##Text + ☝️ + I couldn't find matches in this namespace, searching in + 'lib'... -.> find-in `()` - - 1. foo : ##Text + 😶 + No results. Check your spelling, or try using tab completion + to supply command arguments. + + `find.global` can be used to search outside the current + namespace. -.> delete.namespace `()` - - Done. +``` +```ucm +.`()`> addscratch/main> findscratch/main> find-in `()`scratch/main> delete.namespace `()` ``` + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + + + 😶 + + No results. Check your spelling, or try using tab completion + to supply command arguments. + + `find.global` can be used to search outside the current + namespace. + diff --git a/unison-src/transcripts/universal-cmp.md b/unison-src/transcripts/universal-cmp.md index 2364cb39c2..7e41982e99 100644 --- a/unison-src/transcripts/universal-cmp.md +++ b/unison-src/transcripts/universal-cmp.md @@ -3,7 +3,7 @@ File for test cases making sure that universal equality/comparison cases exist for built-in types. Just making sure they don't crash. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -16,8 +16,8 @@ threadEyeDeez _ = ``` ```ucm -.> add -.> run threadEyeDeez +scratch/main> add +scratch/main> run threadEyeDeez ``` ```unison diff --git a/unison-src/transcripts/universal-cmp.output.md b/unison-src/transcripts/universal-cmp.output.md index ec03128e87..b1f07fddf2 100644 --- a/unison-src/transcripts/universal-cmp.output.md +++ b/unison-src/transcripts/universal-cmp.output.md @@ -26,14 +26,14 @@ threadEyeDeez _ = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: type A threadEyeDeez : ∀ _. _ ->{IO} (Boolean, Boolean) -.> run threadEyeDeez +scratch/main> run threadEyeDeez (false, true) diff --git a/unison-src/transcripts/unsafe-coerce.md b/unison-src/transcripts/unsafe-coerce.md index ab3c38481e..9b483f9bbf 100644 --- a/unison-src/transcripts/unsafe-coerce.md +++ b/unison-src/transcripts/unsafe-coerce.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -17,7 +17,7 @@ main _ = ``` ```ucm -.> find unsafe.coerceAbilities -.> add -.> io.test main +scratch/main> find unsafe.coerceAbilities +scratch/main> add +scratch/main> io.test main ``` diff --git a/unison-src/transcripts/unsafe-coerce.output.md b/unison-src/transcripts/unsafe-coerce.output.md index 8736e6e9cd..9456c08268 100644 --- a/unison-src/transcripts/unsafe-coerce.output.md +++ b/unison-src/transcripts/unsafe-coerce.output.md @@ -28,12 +28,12 @@ main _ = ``` ```ucm -.> find unsafe.coerceAbilities +scratch/main> find unsafe.coerceAbilities 1. builtin.unsafe.coerceAbilities : (a ->{e1} b) -> a -> b -.> add +scratch/main> add ⍟ I've added these definitions: @@ -41,7 +41,7 @@ main _ = fc : '{IO, Exception} Nat main : '{IO, Exception} [Result] -.> io.test main +scratch/main> io.test main New test results: diff --git a/unison-src/transcripts/update-ignores-lib-namespace.md b/unison-src/transcripts/update-ignores-lib-namespace.md index 04498e48ab..2db633f143 100644 --- a/unison-src/transcripts/update-ignores-lib-namespace.md +++ b/unison-src/transcripts/update-ignores-lib-namespace.md @@ -3,7 +3,7 @@ the project organization convention that dependencies are put in "lib"; it's muc one's own code if the "lib" namespace is simply ignored. ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -12,7 +12,7 @@ lib.foo = 100 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -20,6 +20,6 @@ foo = 200 ``` ```ucm -.> update -.> names foo +scratch/main> update +scratch/main> names foo ``` diff --git a/unison-src/transcripts/update-ignores-lib-namespace.output.md b/unison-src/transcripts/update-ignores-lib-namespace.output.md index 5711f81a81..e7026d6f3b 100644 --- a/unison-src/transcripts/update-ignores-lib-namespace.output.md +++ b/unison-src/transcripts/update-ignores-lib-namespace.output.md @@ -22,7 +22,7 @@ lib.foo = 100 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -50,14 +50,14 @@ foo = 200 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> names foo +scratch/main> names foo Term Hash: #9ntnotdp87 diff --git a/unison-src/transcripts/update-on-conflict.md b/unison-src/transcripts/update-on-conflict.md index 21b9a656cb..51dfd75e28 100644 --- a/unison-src/transcripts/update-on-conflict.md +++ b/unison-src/transcripts/update-on-conflict.md @@ -1,7 +1,7 @@ # Update on conflict ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge .merged> builtins.merge ``` @@ -12,7 +12,7 @@ b.x = 2 Cause a conflict: ```ucm -.> add +scratch/main> add .merged> merge.old .a .merged> merge.old .b ``` diff --git a/unison-src/transcripts/update-on-conflict.output.md b/unison-src/transcripts/update-on-conflict.output.md index 6a9afd2e93..67f7c5f597 100644 --- a/unison-src/transcripts/update-on-conflict.output.md +++ b/unison-src/transcripts/update-on-conflict.output.md @@ -21,7 +21,7 @@ b.x = 2 ``` Cause a conflict: ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -30,66 +30,23 @@ Cause a conflict: .merged> merge.old .a - Here's what's changed in the current namespace after the - merge: + ⚠️ - Added definitions: - - 1. x : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.merged> merge.old .b - - Here's what's changed in the current namespace after the - merge: - - New name conflicts: - - 1. x#gjmq673r1v : Nat - ↓ - 2. ┌ x#dcgdua2lj6 : Nat - 3. └ x#gjmq673r1v : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... + The namespace .a doesn't exist. ``` -Updating conflicted definitions works fine. - -```unison -x = 3 -``` ```ucm +scratch/main> add.merged> merge.old .a.merged> merge.old .b +``` - Loading changes detected in scratch.u. - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These names already exist. You can `update` them to your - new definition: - - x : Nat +🛑 -``` -```ucm -.merged> update +The transcript failed due to an error in the stanza above. The error is: - Okay, I'm searching the branch for code that needs to be - updated... - Done. + ⚠️ + + The namespace .a doesn't exist. -``` diff --git a/unison-src/transcripts/update-term-aliases-in-different-ways.md b/unison-src/transcripts/update-term-aliases-in-different-ways.md index fd8a8816c0..e99deb63be 100644 --- a/unison-src/transcripts/update-term-aliases-in-different-ways.md +++ b/unison-src/transcripts/update-term-aliases-in-different-ways.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,7 +11,7 @@ bar = 5 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -23,6 +23,6 @@ bar = 7 ``` ```ucm -.> update -.> view foo bar +scratch/main> update +scratch/main> view foo bar ``` diff --git a/unison-src/transcripts/update-term-aliases-in-different-ways.output.md b/unison-src/transcripts/update-term-aliases-in-different-ways.output.md index 2d7960976a..10e8303cab 100644 --- a/unison-src/transcripts/update-term-aliases-in-different-ways.output.md +++ b/unison-src/transcripts/update-term-aliases-in-different-ways.output.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. @@ -27,7 +27,7 @@ bar = 5 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -61,14 +61,14 @@ bar = 7 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view foo bar +scratch/main> view foo bar bar : Nat bar = 7 diff --git a/unison-src/transcripts/update-term-to-different-type.md b/unison-src/transcripts/update-term-to-different-type.md index 3fa5a735f9..31859e3a13 100644 --- a/unison-src/transcripts/update-term-to-different-type.md +++ b/unison-src/transcripts/update-term-to-different-type.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -8,7 +8,7 @@ foo = 5 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -17,6 +17,6 @@ foo = +5 ``` ```ucm -.> update -.> view foo +scratch/main> update +scratch/main> view foo ``` diff --git a/unison-src/transcripts/update-term-to-different-type.output.md b/unison-src/transcripts/update-term-to-different-type.output.md index 7f6bf57ccf..b1cad29f4a 100644 --- a/unison-src/transcripts/update-term-to-different-type.output.md +++ b/unison-src/transcripts/update-term-to-different-type.output.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. @@ -23,7 +23,7 @@ foo = 5 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -50,14 +50,14 @@ foo = +5 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view foo +scratch/main> view foo foo : Int foo = +5 diff --git a/unison-src/transcripts/update-term-with-alias.md b/unison-src/transcripts/update-term-with-alias.md index b3c5e9e791..e45eb8b768 100644 --- a/unison-src/transcripts/update-term-with-alias.md +++ b/unison-src/transcripts/update-term-with-alias.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,7 +11,7 @@ bar = 5 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -20,6 +20,6 @@ foo = 6 ``` ```ucm -.> update -.> view foo bar +scratch/main> update +scratch/main> view foo bar ``` diff --git a/unison-src/transcripts/update-term-with-alias.output.md b/unison-src/transcripts/update-term-with-alias.output.md index abf21943aa..785a5e0d6e 100644 --- a/unison-src/transcripts/update-term-with-alias.output.md +++ b/unison-src/transcripts/update-term-with-alias.output.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. @@ -27,7 +27,7 @@ bar = 5 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -56,14 +56,14 @@ foo = 6 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view foo bar +scratch/main> view foo bar bar : Nat bar = 5 diff --git a/unison-src/transcripts/update-term-with-dependent-to-different-type.md b/unison-src/transcripts/update-term-with-dependent-to-different-type.md index c9d6388dc3..b7bd1196ae 100644 --- a/unison-src/transcripts/update-term-with-dependent-to-different-type.md +++ b/unison-src/transcripts/update-term-with-dependent-to-different-type.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,7 +11,7 @@ bar = foo + 10 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -20,5 +20,5 @@ foo = +5 ``` ```ucm:error -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md index 1a62cebf4a..c2357e31e7 100644 --- a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md +++ b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. @@ -27,7 +27,7 @@ bar = foo + 10 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -55,7 +55,7 @@ foo = +5 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/update-term-with-dependent.md b/unison-src/transcripts/update-term-with-dependent.md index d7aa6b3db6..402138857b 100644 --- a/unison-src/transcripts/update-term-with-dependent.md +++ b/unison-src/transcripts/update-term-with-dependent.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -11,7 +11,7 @@ bar = foo + 10 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -20,6 +20,6 @@ foo = 6 ``` ```ucm -.> update -.> view bar +scratch/main> update +scratch/main> view bar ``` diff --git a/unison-src/transcripts/update-term-with-dependent.output.md b/unison-src/transcripts/update-term-with-dependent.output.md index dc2d66f72a..9acbb2b7b7 100644 --- a/unison-src/transcripts/update-term-with-dependent.output.md +++ b/unison-src/transcripts/update-term-with-dependent.output.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. @@ -27,7 +27,7 @@ bar = foo + 10 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -55,7 +55,7 @@ foo = 6 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -66,7 +66,7 @@ foo = 6 Done. -.> view bar +scratch/main> view bar bar : Nat bar = diff --git a/unison-src/transcripts/update-term.md b/unison-src/transcripts/update-term.md index 0fbb55357b..0cdc0e86f9 100644 --- a/unison-src/transcripts/update-term.md +++ b/unison-src/transcripts/update-term.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -8,7 +8,7 @@ foo = 5 ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -17,6 +17,6 @@ foo = 6 ``` ```ucm -.> update -.> view foo +scratch/main> update +scratch/main> view foo ``` diff --git a/unison-src/transcripts/update-term.output.md b/unison-src/transcripts/update-term.output.md index 1a641671e5..26bb87579d 100644 --- a/unison-src/transcripts/update-term.output.md +++ b/unison-src/transcripts/update-term.output.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. @@ -23,7 +23,7 @@ foo = 5 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -50,14 +50,14 @@ foo = 6 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view foo +scratch/main> view foo foo : Nat foo = 6 diff --git a/unison-src/transcripts/update-test-to-non-test.md b/unison-src/transcripts/update-test-to-non-test.md index a25ad0d3e2..0c2ba33f80 100644 --- a/unison-src/transcripts/update-test-to-non-test.md +++ b/unison-src/transcripts/update-test-to-non-test.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge ``` ```unison @@ -9,8 +9,8 @@ test> foo = [] After adding the test `foo`, we expect `view` to render it like a test. (Bug: It doesn't.) ```ucm -.> add -.> view foo +scratch/main> add +scratch/main> view foo ``` ```unison @@ -20,6 +20,6 @@ foo = 1 After updating `foo` to not be a test, we expect `view` to not render it like a test. ```ucm -.> update -.> view foo +scratch/main> update +scratch/main> view foo ``` diff --git a/unison-src/transcripts/update-test-to-non-test.output.md b/unison-src/transcripts/update-test-to-non-test.output.md index a3a016e736..f08dd4bb97 100644 --- a/unison-src/transcripts/update-test-to-non-test.output.md +++ b/unison-src/transcripts/update-test-to-non-test.output.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.merge +scratch/main> builtins.merge Done. @@ -30,13 +30,13 @@ test> foo = [] After adding the test `foo`, we expect `view` to render it like a test. (Bug: It doesn't.) ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: foo : [Result] -.> view foo +scratch/main> view foo foo : [Result] foo = [] @@ -63,14 +63,14 @@ foo = 1 After updating `foo` to not be a test, we expect `view` to not render it like a test. ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view foo +scratch/main> view foo foo : Nat foo = 1 diff --git a/unison-src/transcripts/update-test-watch-roundtrip.md b/unison-src/transcripts/update-test-watch-roundtrip.md index a3ea386efe..135412df66 100644 --- a/unison-src/transcripts/update-test-watch-roundtrip.md +++ b/unison-src/transcripts/update-test-watch-roundtrip.md @@ -1,6 +1,6 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` Given a test that depends on another definition, @@ -14,7 +14,7 @@ test> mynamespace.foo.test = ``` ```ucm -.> add +scratch/main> add ``` if we change the type of the dependency, the test should show in the scratch file as a test watch. @@ -24,5 +24,5 @@ foo n = "hello, world!" ``` ```ucm:error -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-test-watch-roundtrip.output.md b/unison-src/transcripts/update-test-watch-roundtrip.output.md index b3db6133dd..2f1959eb58 100644 --- a/unison-src/transcripts/update-test-watch-roundtrip.output.md +++ b/unison-src/transcripts/update-test-watch-roundtrip.output.md @@ -10,7 +10,7 @@ test> mynamespace.foo.test = ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -39,7 +39,7 @@ foo n = "hello, world!" ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/update-type-add-constructor.md b/unison-src/transcripts/update-type-add-constructor.md index b801106c24..1decf30154 100644 --- a/unison-src/transcripts/update-type-add-constructor.md +++ b/unison-src/transcripts/update-type-add-constructor.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -8,7 +8,7 @@ unique type Foo ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -18,7 +18,7 @@ unique type Foo ``` ```ucm -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-add-constructor.output.md b/unison-src/transcripts/update-type-add-constructor.output.md index d0fb21a382..4064cbf3d3 100644 --- a/unison-src/transcripts/update-type-add-constructor.output.md +++ b/unison-src/transcripts/update-type-add-constructor.output.md @@ -17,7 +17,7 @@ unique type Foo ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -45,18 +45,18 @@ unique type Foo ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view Foo +scratch/main> view Foo type Foo = Bar Nat | Baz Nat Nat -.> find.verbose +scratch/main> find.verbose 1. -- #2sffq4apsq1cts53njcunj63fa8ohov4eqn77q14s77ajicajh4g28sq5s5ai33f2k6oh6o67aarnlpu7u7s4la07ag2er33epalsog type Foo diff --git a/unison-src/transcripts/update-type-add-field.md b/unison-src/transcripts/update-type-add-field.md index 13a388e1bd..cdd41c3388 100644 --- a/unison-src/transcripts/update-type-add-field.md +++ b/unison-src/transcripts/update-type-add-field.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,7 +7,7 @@ unique type Foo = Bar Nat ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -15,7 +15,7 @@ unique type Foo = Bar Nat Nat ``` ```ucm -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-add-field.output.md b/unison-src/transcripts/update-type-add-field.output.md index 7ee979d64e..6ba0471643 100644 --- a/unison-src/transcripts/update-type-add-field.output.md +++ b/unison-src/transcripts/update-type-add-field.output.md @@ -16,7 +16,7 @@ unique type Foo = Bar Nat ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -42,18 +42,18 @@ unique type Foo = Bar Nat Nat ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view Foo +scratch/main> view Foo type Foo = Bar Nat Nat -.> find.verbose +scratch/main> find.verbose 1. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g type Foo diff --git a/unison-src/transcripts/update-type-add-new-record.md b/unison-src/transcripts/update-type-add-new-record.md index 0d311ec1e2..86c7bb0e4c 100644 --- a/unison-src/transcripts/update-type-add-new-record.md +++ b/unison-src/transcripts/update-type-add-new-record.md @@ -7,6 +7,6 @@ unique type Foo = { bar : Nat } ``` ```ucm -.> update -.> view Foo +scratch/main> update +scratch/main> view Foo ``` diff --git a/unison-src/transcripts/update-type-add-new-record.output.md b/unison-src/transcripts/update-type-add-new-record.output.md index 8c00d6c1de..bc1fb44664 100644 --- a/unison-src/transcripts/update-type-add-new-record.output.md +++ b/unison-src/transcripts/update-type-add-new-record.output.md @@ -19,15 +19,15 @@ unique type Foo = { bar : Nat } ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view Foo +scratch/main> view Foo - type Foo = { bar : Nat } + type Foo = { bar : ##Nat } ``` diff --git a/unison-src/transcripts/update-type-add-record-field.md b/unison-src/transcripts/update-type-add-record-field.md index ef5aba3614..d4edf079e1 100644 --- a/unison-src/transcripts/update-type-add-record-field.md +++ b/unison-src/transcripts/update-type-add-record-field.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,7 +7,7 @@ unique type Foo = { bar : Nat } ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -15,7 +15,7 @@ unique type Foo = { bar : Nat, baz : Int } ``` ```ucm -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-add-record-field.output.md b/unison-src/transcripts/update-type-add-record-field.output.md index 3f52ad6a82..d0a7a700eb 100644 --- a/unison-src/transcripts/update-type-add-record-field.output.md +++ b/unison-src/transcripts/update-type-add-record-field.output.md @@ -19,7 +19,7 @@ unique type Foo = { bar : Nat } ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -57,18 +57,18 @@ unique type Foo = { bar : Nat, baz : Int } ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view Foo +scratch/main> view Foo type Foo = { bar : Nat, baz : Int } -.> find.verbose +scratch/main> find.verbose 1. -- #05gh1dur4778dauh9slaofprc5356n47qpove0c1jl0birt2fcu301js8auu5vfr5bjfga9j8ikuk07ll9fu1gj3ehrp3basguhsd58 type Foo diff --git a/unison-src/transcripts/update-type-constructor-alias.md b/unison-src/transcripts/update-type-constructor-alias.md index 2d5f97ef25..50d55af066 100644 --- a/unison-src/transcripts/update-type-constructor-alias.md +++ b/unison-src/transcripts/update-type-constructor-alias.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,8 +7,8 @@ unique type Foo = Bar Nat ``` ```ucm -.> add -.> alias.term Foo.Bar Foo.BarAlias +scratch/main> add +scratch/main> alias.term Foo.Bar Foo.BarAlias ``` ```unison @@ -18,6 +18,6 @@ unique type Foo = Bar Nat Nat Bug: we leave `Foo.BarAlias` in the namespace with a nameless decl. ```ucm -.> update -.> find.verbose +scratch/main> update +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-constructor-alias.output.md b/unison-src/transcripts/update-type-constructor-alias.output.md index 44d683227c..21cea73a91 100644 --- a/unison-src/transcripts/update-type-constructor-alias.output.md +++ b/unison-src/transcripts/update-type-constructor-alias.output.md @@ -16,13 +16,13 @@ unique type Foo = Bar Nat ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: type Foo -.> alias.term Foo.Bar Foo.BarAlias +scratch/main> alias.term Foo.Bar Foo.BarAlias Done. @@ -48,14 +48,14 @@ unique type Foo = Bar Nat Nat Bug: we leave `Foo.BarAlias` in the namespace with a nameless decl. ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> find.verbose +scratch/main> find.verbose 1. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g type Foo diff --git a/unison-src/transcripts/update-type-delete-constructor-with-dependent.md b/unison-src/transcripts/update-type-delete-constructor-with-dependent.md index b44cf8a7a7..3c7be50a53 100644 --- a/unison-src/transcripts/update-type-delete-constructor-with-dependent.md +++ b/unison-src/transcripts/update-type-delete-constructor-with-dependent.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -14,7 +14,7 @@ foo = cases ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -23,5 +23,5 @@ unique type Foo ``` ```ucm:error -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md index 9966a32418..f443c34263 100644 --- a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md +++ b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md @@ -24,7 +24,7 @@ foo = cases ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -52,7 +52,7 @@ unique type Foo ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/update-type-delete-constructor.md b/unison-src/transcripts/update-type-delete-constructor.md index cf348f690e..18a8295d5a 100644 --- a/unison-src/transcripts/update-type-delete-constructor.md +++ b/unison-src/transcripts/update-type-delete-constructor.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -9,7 +9,7 @@ unique type Foo ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -18,7 +18,7 @@ unique type Foo ``` ```ucm -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-delete-constructor.output.md b/unison-src/transcripts/update-type-delete-constructor.output.md index c417d5f15c..1aa01c8a57 100644 --- a/unison-src/transcripts/update-type-delete-constructor.output.md +++ b/unison-src/transcripts/update-type-delete-constructor.output.md @@ -18,7 +18,7 @@ unique type Foo ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -45,18 +45,18 @@ unique type Foo ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view Foo +scratch/main> view Foo type Foo = Bar Nat -.> find.verbose +scratch/main> find.verbose 1. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60 type Foo diff --git a/unison-src/transcripts/update-type-delete-record-field.md b/unison-src/transcripts/update-type-delete-record-field.md index de6396e0c3..cd3520e8b2 100644 --- a/unison-src/transcripts/update-type-delete-record-field.md +++ b/unison-src/transcripts/update-type-delete-record-field.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,7 +7,7 @@ unique type Foo = { bar : Nat, baz : Int } ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -17,7 +17,7 @@ unique type Foo = { bar : Nat } We want the field accessors to go away; but for now they are here, causing the update to fail. ```ucm:error -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-delete-record-field.output.md b/unison-src/transcripts/update-type-delete-record-field.output.md index a5b570d6d4..e2691b8145 100644 --- a/unison-src/transcripts/update-type-delete-record-field.output.md +++ b/unison-src/transcripts/update-type-delete-record-field.output.md @@ -22,7 +22,7 @@ unique type Foo = { bar : Nat, baz : Int } ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -59,7 +59,7 @@ unique type Foo = { bar : Nat } We want the field accessors to go away; but for now they are here, causing the update to fail. ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -70,11 +70,11 @@ We want the field accessors to go away; but for now they are here, causing the u definitions that need fixing. Once the file is compiling, try `update` again. -.> view Foo +scratch/main> view Foo type Foo = { bar : Nat, baz : Int } -.> find.verbose +scratch/main> find.verbose 1. -- #05gh1dur4778dauh9slaofprc5356n47qpove0c1jl0birt2fcu301js8auu5vfr5bjfga9j8ikuk07ll9fu1gj3ehrp3basguhsd58 type Foo diff --git a/unison-src/transcripts/update-type-missing-constructor.md b/unison-src/transcripts/update-type-missing-constructor.md index bfaafa8343..5fa29c2a86 100644 --- a/unison-src/transcripts/update-type-missing-constructor.md +++ b/unison-src/transcripts/update-type-missing-constructor.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,8 +7,8 @@ unique type Foo = Bar Nat ``` ```ucm -.> add -.> delete.term Foo.Bar +scratch/main> add +scratch/main> delete.term Foo.Bar ``` Now we've set up a situation where the original constructor missing. @@ -18,6 +18,6 @@ unique type Foo = Bar Nat Nat ``` ```ucm:error -.> view Foo -.> update +scratch/main> view Foo +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-missing-constructor.output.md b/unison-src/transcripts/update-type-missing-constructor.output.md index 52ead472eb..59df270a54 100644 --- a/unison-src/transcripts/update-type-missing-constructor.output.md +++ b/unison-src/transcripts/update-type-missing-constructor.output.md @@ -16,13 +16,13 @@ unique type Foo = Bar Nat ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: type Foo -.> delete.term Foo.Bar +scratch/main> delete.term Foo.Bar Done. @@ -48,11 +48,11 @@ unique type Foo = Bar Nat Nat ``` ```ucm -.> view Foo +scratch/main> view Foo type Foo = #b509v3eg4k#0 Nat -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/update-type-nested-decl-aliases.md b/unison-src/transcripts/update-type-nested-decl-aliases.md index a51c9a2c16..03b20f6fd7 100644 --- a/unison-src/transcripts/update-type-nested-decl-aliases.md +++ b/unison-src/transcripts/update-type-nested-decl-aliases.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -10,7 +10,7 @@ structural type A = B.TheOtherAlias Foo ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -22,5 +22,5 @@ only one name for each constructor. We instead get too far in the update process file to stare at. ```ucm:error -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-nested-decl-aliases.output.md b/unison-src/transcripts/update-type-nested-decl-aliases.output.md index 0b373c88cd..afddbf3de6 100644 --- a/unison-src/transcripts/update-type-nested-decl-aliases.output.md +++ b/unison-src/transcripts/update-type-nested-decl-aliases.output.md @@ -21,7 +21,7 @@ structural type A = B.TheOtherAlias Foo ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -53,7 +53,7 @@ only one name for each constructor. We instead get too far in the update process file to stare at. ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/update-type-no-op-record.md b/unison-src/transcripts/update-type-no-op-record.md index 50a559819a..e9ec904c95 100644 --- a/unison-src/transcripts/update-type-no-op-record.md +++ b/unison-src/transcripts/update-type-no-op-record.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,11 +7,11 @@ unique type Foo = { bar : Nat } ``` ```ucm -.> add +scratch/main> add ``` Bug: this no-op update should (of course) succeed. ```ucm -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-no-op-record.output.md b/unison-src/transcripts/update-type-no-op-record.output.md index 1a7e55eb74..8d46e420ce 100644 --- a/unison-src/transcripts/update-type-no-op-record.output.md +++ b/unison-src/transcripts/update-type-no-op-record.output.md @@ -19,7 +19,7 @@ unique type Foo = { bar : Nat } ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -32,7 +32,7 @@ unique type Foo = { bar : Nat } Bug: this no-op update should (of course) succeed. ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/update-type-stray-constructor-alias.md b/unison-src/transcripts/update-type-stray-constructor-alias.md index 847a37e32d..8bd4ba3625 100644 --- a/unison-src/transcripts/update-type-stray-constructor-alias.md +++ b/unison-src/transcripts/update-type-stray-constructor-alias.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,8 +7,8 @@ unique type Foo = Bar Nat ``` ```ucm -.> add -.> alias.term Foo.Bar Stray.BarAlias +scratch/main> add +scratch/main> alias.term Foo.Bar Stray.BarAlias ``` ```unison @@ -18,6 +18,6 @@ unique type Foo = Bar Nat Nat Bug: we leave `Stray.BarAlias` in the namespace with a nameless decl. ```ucm -.> update -.> find.verbose +scratch/main> update +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-stray-constructor-alias.output.md b/unison-src/transcripts/update-type-stray-constructor-alias.output.md index e9fe5f9662..0e906b70dd 100644 --- a/unison-src/transcripts/update-type-stray-constructor-alias.output.md +++ b/unison-src/transcripts/update-type-stray-constructor-alias.output.md @@ -16,13 +16,13 @@ unique type Foo = Bar Nat ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: type Foo -.> alias.term Foo.Bar Stray.BarAlias +scratch/main> alias.term Foo.Bar Stray.BarAlias Done. @@ -48,14 +48,14 @@ unique type Foo = Bar Nat Nat Bug: we leave `Stray.BarAlias` in the namespace with a nameless decl. ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> find.verbose +scratch/main> find.verbose 1. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g type Foo diff --git a/unison-src/transcripts/update-type-stray-constructor.md b/unison-src/transcripts/update-type-stray-constructor.md index 183818e564..7808f759be 100644 --- a/unison-src/transcripts/update-type-stray-constructor.md +++ b/unison-src/transcripts/update-type-stray-constructor.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,8 +7,8 @@ unique type Foo = Bar Nat ``` ```ucm -.> add -.> move.term Foo.Bar Stray.Bar +scratch/main> add +scratch/main> move.term Foo.Bar Stray.Bar ``` Now we've set up a situation where the constructor is not where it's supposed to be; it's somewhere else. @@ -20,6 +20,6 @@ unique type Foo = Bar Nat Nat Note that the constructor name shown here (implied to be called `Foo.Stray.Bar`) doesn't really exist, it's just showing up due to a pretty-printer bug. ```ucm:error -.> view Foo -.> update +scratch/main> view Foo +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-stray-constructor.output.md b/unison-src/transcripts/update-type-stray-constructor.output.md index 8f72beefd3..a76b034b41 100644 --- a/unison-src/transcripts/update-type-stray-constructor.output.md +++ b/unison-src/transcripts/update-type-stray-constructor.output.md @@ -16,13 +16,13 @@ unique type Foo = Bar Nat ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: type Foo -.> move.term Foo.Bar Stray.Bar +scratch/main> move.term Foo.Bar Stray.Bar Done. @@ -50,11 +50,11 @@ unique type Foo = Bar Nat Nat Note that the constructor name shown here (implied to be called `Foo.Stray.Bar`) doesn't really exist, it's just showing up due to a pretty-printer bug. ```ucm -.> view Foo +scratch/main> view Foo type Foo = Stray.Bar Nat -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.md b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.md index 1debc0aaf3..1f2933242a 100644 --- a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.md +++ b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -10,7 +10,7 @@ makeFoo n = Bar (n+10) ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -21,7 +21,7 @@ Foo.Bar n = internal.Bar n ``` ```ucm -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md index a28e27e747..a00b5dde63 100644 --- a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md +++ b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md @@ -20,7 +20,7 @@ makeFoo n = Bar (n+10) ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -51,7 +51,7 @@ Foo.Bar n = internal.Bar n ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -62,11 +62,11 @@ Foo.Bar n = internal.Bar n Done. -.> view Foo +scratch/main> view Foo type Foo = internal.Bar Nat -.> find.verbose +scratch/main> find.verbose 1. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60 type Foo diff --git a/unison-src/transcripts/update-type-turn-non-record-into-record.md b/unison-src/transcripts/update-type-turn-non-record-into-record.md index b570aa5f7e..829240ff62 100644 --- a/unison-src/transcripts/update-type-turn-non-record-into-record.md +++ b/unison-src/transcripts/update-type-turn-non-record-into-record.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -7,7 +7,7 @@ unique type Foo = Nat ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -15,7 +15,7 @@ unique type Foo = { bar : Nat } ``` ```ucm -.> update -.> view Foo -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-turn-non-record-into-record.output.md b/unison-src/transcripts/update-type-turn-non-record-into-record.output.md index f23ab09cd5..fb1f2dd2ce 100644 --- a/unison-src/transcripts/update-type-turn-non-record-into-record.output.md +++ b/unison-src/transcripts/update-type-turn-non-record-into-record.output.md @@ -16,7 +16,7 @@ unique type Foo = Nat ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -48,18 +48,18 @@ unique type Foo = { bar : Nat } ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view Foo +scratch/main> view Foo type Foo = { bar : Nat } -.> find.verbose +scratch/main> find.verbose 1. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60 type Foo diff --git a/unison-src/transcripts/update-type-with-dependent-term.md b/unison-src/transcripts/update-type-with-dependent-term.md index 99bfcceac4..300eddc69f 100644 --- a/unison-src/transcripts/update-type-with-dependent-term.md +++ b/unison-src/transcripts/update-type-with-dependent-term.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -10,7 +10,7 @@ incrFoo = cases Bar n -> Bar (n+1) ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -18,5 +18,5 @@ unique type Foo = Bar Nat Nat ``` ```ucm:error -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-with-dependent-term.output.md b/unison-src/transcripts/update-type-with-dependent-term.output.md index e8837eb523..1ab2b586bc 100644 --- a/unison-src/transcripts/update-type-with-dependent-term.output.md +++ b/unison-src/transcripts/update-type-with-dependent-term.output.md @@ -20,7 +20,7 @@ incrFoo = cases Bar n -> Bar (n+1) ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -47,7 +47,7 @@ unique type Foo = Bar Nat Nat ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.md b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.md index 7c5a5018b2..1caef319d8 100644 --- a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.md +++ b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -8,7 +8,7 @@ unique type Baz = Qux Foo ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -16,5 +16,5 @@ unique type Foo a = Bar Nat a ``` ```ucm:error -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md index e105b39ea2..edc63c214d 100644 --- a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md +++ b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md @@ -18,7 +18,7 @@ unique type Baz = Qux Foo ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -45,7 +45,7 @@ unique type Foo a = Bar Nat a ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/update-type-with-dependent-type.md b/unison-src/transcripts/update-type-with-dependent-type.md index 7dea367322..4b6e8aa2dc 100644 --- a/unison-src/transcripts/update-type-with-dependent-type.md +++ b/unison-src/transcripts/update-type-with-dependent-type.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison @@ -8,7 +8,7 @@ unique type Baz = Qux Foo ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -16,8 +16,8 @@ unique type Foo = Bar Nat Nat ``` ```ucm -.> update -.> view Foo -.> view Baz -.> find.verbose +scratch/main> update +scratch/main> view Foo +scratch/main> view Baz +scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-with-dependent-type.output.md b/unison-src/transcripts/update-type-with-dependent-type.output.md index 47988e1ffd..2523eed7df 100644 --- a/unison-src/transcripts/update-type-with-dependent-type.output.md +++ b/unison-src/transcripts/update-type-with-dependent-type.output.md @@ -18,7 +18,7 @@ unique type Baz = Qux Foo ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -45,7 +45,7 @@ unique type Foo = Bar Nat Nat ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... @@ -56,15 +56,15 @@ unique type Foo = Bar Nat Nat Done. -.> view Foo +scratch/main> view Foo type Foo = Bar Nat Nat -.> view Baz +scratch/main> view Baz type Baz = Qux Foo -.> find.verbose +scratch/main> find.verbose 1. -- #34msh9satlfog576493eo9pkjn6aj7d8fj6jfheglvgr5s39iptb81649bpkad1lqraheqb8em9ms551k01oternhknc4m7jicgtk08 type Baz diff --git a/unison-src/transcripts/update-watch.md b/unison-src/transcripts/update-watch.md index 6637515ff6..013801ebb7 100644 --- a/unison-src/transcripts/update-watch.md +++ b/unison-src/transcripts/update-watch.md @@ -3,5 +3,5 @@ ``` ```ucm -.> update +scratch/main> update ``` diff --git a/unison-src/transcripts/update-watch.output.md b/unison-src/transcripts/update-watch.output.md index e97d32f9ef..c9c9510457 100644 --- a/unison-src/transcripts/update-watch.output.md +++ b/unison-src/transcripts/update-watch.output.md @@ -19,7 +19,7 @@ ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... diff --git a/unison-src/transcripts/view.md b/unison-src/transcripts/view.md index 89b81cf51f..25d56dc842 100644 --- a/unison-src/transcripts/view.md +++ b/unison-src/transcripts/view.md @@ -1,7 +1,7 @@ # View commands ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -10,12 +10,12 @@ b.thing = "b" ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -- Should suffix-search and find values in sub-namespaces -.> view thing +scratch/main> view thing -- Should be local to namespace .a> view thing -- view.global should search globally and be absolutely qualified diff --git a/unison-src/transcripts/view.output.md b/unison-src/transcripts/view.output.md index 71ebf98da7..c3777e0452 100644 --- a/unison-src/transcripts/view.output.md +++ b/unison-src/transcripts/view.output.md @@ -7,7 +7,7 @@ b.thing = "b" ```ucm -- Should suffix-search and find values in sub-namespaces -.> view thing +scratch/main> view thing a.thing : Text a.thing = "a" @@ -16,24 +16,29 @@ b.thing = "b" b.thing = "b" -- Should be local to namespace + ☝️ The namespace .a is empty. + .a> view thing - thing : ##Text - thing = "a" + ⚠️ + + The following names were not found in the codebase. Check your spelling. + thing --- view.global should search globally and be absolutely qualified -.a> view.global thing +``` - .a.thing : Text - .a.thing = "a" - - .b.thing : Text - .b.thing = "b" +```ucm +-- Should suffix-search and find values in sub-namespacesscratch/main> view thing-- Should be local to namespace.a> view thing-- view.global should search globally and be absolutely qualified.a> view.global thing-- Should support absolute paths outside of current namespace.a> view .b.thing +``` --- Should support absolute paths outside of current namespace -.a> view .b.thing - .b.thing : Text - .b.thing = "b" +🛑 + +The transcript failed due to an error in the stanza above. The error is: + + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + thing -``` diff --git a/unison-src/transcripts/watch-expressions.md b/unison-src/transcripts/watch-expressions.md index e17d789a55..b4f54004b0 100644 --- a/unison-src/transcripts/watch-expressions.md +++ b/unison-src/transcripts/watch-expressions.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.mergeio +scratch/main> builtins.mergeio ``` ```unison @@ -7,7 +7,7 @@ test> pass = [Ok "Passed"] ``` ```ucm -.> add +scratch/main> add ``` ```unison @@ -15,8 +15,8 @@ test> pass = [Ok "Passed"] ``` ```ucm -.> add -.> test +scratch/main> add +scratch/main> test ``` ```unison diff --git a/unison-src/transcripts/watch-expressions.output.md b/unison-src/transcripts/watch-expressions.output.md index 3a12bbcac7..e1c4dcb4d2 100644 --- a/unison-src/transcripts/watch-expressions.output.md +++ b/unison-src/transcripts/watch-expressions.output.md @@ -1,5 +1,5 @@ ```ucm -.> builtins.mergeio +scratch/main> builtins.mergeio Done. @@ -29,7 +29,7 @@ test> pass = [Ok "Passed"] ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -56,11 +56,11 @@ test> pass = [Ok "Passed"] ``` ```ucm -.> add +scratch/main> add ⊡ Ignored previously added definitions: pass -.> test +scratch/main> test Cached test results (`help testcache` to learn more) From 26a0bf7b40357bc648db77951c69d4f5835a1467 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 11 Jun 2024 15:31:09 -0700 Subject: [PATCH 240/631] Edit transcripts to be in projects --- unison-src/transcripts-using-base/fix1709.md | 2 +- .../namespace-dependencies.md | 2 +- .../namespace-dependencies.output.md | 8 ++-- unison-src/transcripts/alias-many.md | 2 +- unison-src/transcripts/api-getDefinition.md | 8 ++-- unison-src/transcripts/branch-command.md | 6 +-- unison-src/transcripts/builtins-merge.md | 4 +- unison-src/transcripts/create-author.md | 4 +- unison-src/transcripts/delete.md | 14 +++---- unison-src/transcripts/diff-namespace.md | 16 ++++---- unison-src/transcripts/doc1.md | 10 ++--- unison-src/transcripts/empty-namespaces.md | 6 +-- unison-src/transcripts/emptyCodebase.md | 8 ++-- unison-src/transcripts/find-command.md | 4 +- unison-src/transcripts/fix2000.md | 4 +- unison-src/transcripts/fix2004.md | 6 +-- unison-src/transcripts/fix2254.md | 4 +- unison-src/transcripts/fix2254.output.md | 2 +- unison-src/transcripts/fuzzy-options.md | 2 +- .../transcripts/fuzzy-options.output.md | 6 +-- .../transcripts/ls-pretty-print-scope-bug.md | 8 ++-- unison-src/transcripts/mergeloop.md | 10 ++--- unison-src/transcripts/merges.md | 6 +-- unison-src/transcripts/move-all.md | 18 ++++----- unison-src/transcripts/move-namespace.md | 40 +++++++++---------- unison-src/transcripts/name-selection.md | 32 +++++++-------- unison-src/transcripts/names.md | 12 +++--- unison-src/transcripts/names.output.md | 16 ++++---- unison-src/transcripts/numbered-args.md | 22 +++++----- unison-src/transcripts/project-merge.md | 4 +- unison-src/transcripts/propagate.md | 30 +++++++------- unison-src/transcripts/squash.md | 32 +++++++-------- .../transcripts/sum-type-update-conflicts.md | 6 +-- unison-src/transcripts/tab-completion.md | 2 +- unison-src/transcripts/test-command.md | 4 +- unison-src/transcripts/todo.output.md | 1 - unison-src/transcripts/update-on-conflict.md | 8 ++-- .../transcripts/update-type-add-new-record.md | 2 +- unison-src/transcripts/view.md | 6 +-- 39 files changed, 188 insertions(+), 189 deletions(-) diff --git a/unison-src/transcripts-using-base/fix1709.md b/unison-src/transcripts-using-base/fix1709.md index bc254f3b24..9b0e868d02 100644 --- a/unison-src/transcripts-using-base/fix1709.md +++ b/unison-src/transcripts-using-base/fix1709.md @@ -7,7 +7,7 @@ id2 x = ``` ```ucm -.scratch> add +scratch/main> add ``` ```unison diff --git a/unison-src/transcripts-using-base/namespace-dependencies.md b/unison-src/transcripts-using-base/namespace-dependencies.md index 1558d5951e..226da3c1cd 100644 --- a/unison-src/transcripts-using-base/namespace-dependencies.md +++ b/unison-src/transcripts-using-base/namespace-dependencies.md @@ -7,5 +7,5 @@ mynamespace.dependsOnText = external.mynat Nat.+ 10 ```ucm scratch/main> add -.mynamespace> namespace.dependencies +scratch/main mynamespace> namespace.dependencies ``` diff --git a/unison-src/transcripts-using-base/namespace-dependencies.output.md b/unison-src/transcripts-using-base/namespace-dependencies.output.md index b20019aa47..7c4f828d0f 100644 --- a/unison-src/transcripts-using-base/namespace-dependencies.output.md +++ b/unison-src/transcripts-using-base/namespace-dependencies.output.md @@ -9,16 +9,16 @@ mynamespace.dependsOnText = external.mynat Nat.+ 10 scratch/main> add ⍟ I've added these definitions: - + external.mynat : Nat mynamespace.dependsOnText : Nat ☝️ The namespace .mynamespace is empty. -.mynamespace> namespace.dependencies +scratch/main mynamespace> namespace.dependencies ⚠️ - + .mynamespace is an empty namespace. ``` @@ -31,6 +31,6 @@ The transcript failed due to an error in the stanza above. The error is: ⚠️ - + .mynamespace is an empty namespace. diff --git a/unison-src/transcripts/alias-many.md b/unison-src/transcripts/alias-many.md index 8d9fb87dec..0eed6fef3f 100644 --- a/unison-src/transcripts/alias-many.md +++ b/unison-src/transcripts/alias-many.md @@ -95,7 +95,7 @@ List.takeWhile p xs = go xs [] ``` ```ucm:hide -.stuff> add +scratch/main stuff> add ``` The `alias.many` command can be used to copy definitions from the current namespace into your curated one. diff --git a/unison-src/transcripts/api-getDefinition.md b/unison-src/transcripts/api-getDefinition.md index 4a56b2bc9e..251fb8b3ec 100644 --- a/unison-src/transcripts/api-getDefinition.md +++ b/unison-src/transcripts/api-getDefinition.md @@ -1,7 +1,7 @@ # Get Definitions Test ```ucm:hide -.nested> builtins.mergeio +scratch/main nested> builtins.mergeio ``` ```unison:hide @@ -10,7 +10,7 @@ names.x = 42 ``` ```ucm:hide -.nested> add +scratch/main nested> add ``` ```api @@ -25,7 +25,7 @@ GET /api/non-project-code/getDefinition?names=%23qkhkl0n238&relativeTo=nested ``` ```ucm:hide -.doctest> builtins.mergeio +scratch/main doctest> builtins.mergeio ``` ```unison:hide @@ -38,7 +38,7 @@ otherstuff.thing = "A different thing" ``` ```ucm:hide -.doctest> add +scratch/main doctest> add ``` Only docs for the term we request should be returned, even if there are other term docs with the same suffix. diff --git a/unison-src/transcripts/branch-command.md b/unison-src/transcripts/branch-command.md index f39b2a071a..fd8ad20168 100644 --- a/unison-src/transcripts/branch-command.md +++ b/unison-src/transcripts/branch-command.md @@ -12,8 +12,8 @@ someterm = 18 ``` ```ucm -.some.loose.code.lib> builtins.merge -.some.loose.code> add +scratch/main some.loose.code.lib> builtins.merge +scratch/main some.loose.code> add ``` Now, the `branch` demo: @@ -40,7 +40,7 @@ bar/main> branch foo/main topic2 bar/main> branch foo/main /topic3 scratch/main> branch foo/main bar/topic4 -.some.loose.code> branch foo/topic13 +scratch/main some.loose.code> branch foo/topic13 foo/main> branch .some.loose.code topic14 foo/main> branch .some.loose.code /topic15 scratch/main> branch .some.loose.code foo/topic16 diff --git a/unison-src/transcripts/builtins-merge.md b/unison-src/transcripts/builtins-merge.md index 28bfb426ca..dec23f021d 100644 --- a/unison-src/transcripts/builtins-merge.md +++ b/unison-src/transcripts/builtins-merge.md @@ -1,6 +1,6 @@ The `builtins.merge` command adds the known builtins to a `builtin` subnamespace within the current namespace. ```ucm -.tmp> builtins.merge -.tmp> ls builtin +scratch/main tmp> builtins.merge +scratch/main tmp> ls builtin ``` diff --git a/unison-src/transcripts/create-author.md b/unison-src/transcripts/create-author.md index 18f0ccac2e..c8afdb0002 100644 --- a/unison-src/transcripts/create-author.md +++ b/unison-src/transcripts/create-author.md @@ -5,6 +5,6 @@ scratch/main> builtins.mergeio Demonstrating `create.author`: ```ucm -.foo> create.author alicecoder "Alice McGee" -.foo> view 2 +scratch/main foo> create.author alicecoder "Alice McGee" +scratch/main foo> view 2 ``` diff --git a/unison-src/transcripts/delete.md b/unison-src/transcripts/delete.md index a3af9d2142..5187a57cc0 100644 --- a/unison-src/transcripts/delete.md +++ b/unison-src/transcripts/delete.md @@ -35,7 +35,7 @@ foo = 1 ``` ```ucm -.a> add +scratch/main a> add ``` ```unison:hide @@ -43,8 +43,8 @@ foo = 2 ``` ```ucm -.b> add -.a> merge.old .b +scratch/main b> add +scratch/main a> merge.old .b ``` A delete should remove both versions of the term. @@ -54,7 +54,7 @@ scratch/main> delete.verbose a.foo ``` ```ucm:error -.a> ls +scratch/main a> ls ``` Let's repeat all that on a type, for completeness. @@ -64,7 +64,7 @@ structural type Foo = Foo () ``` ```ucm -.a> add +scratch/main a> add ``` ```unison:hide @@ -72,8 +72,8 @@ structural type Foo = Foo ``` ```ucm -.b> add -.a> merge.old .b +scratch/main b> add +scratch/main a> merge.old .b ``` ```ucm diff --git a/unison-src/transcripts/diff-namespace.md b/unison-src/transcripts/diff-namespace.md index 63c20cb740..e54f6cdba8 100644 --- a/unison-src/transcripts/diff-namespace.md +++ b/unison-src/transcripts/diff-namespace.md @@ -109,7 +109,7 @@ a = 333 b = a + 1 ``` ```ucm -.nsx> add +scratch/main nsx> add scratch/main> fork nsx nsy scratch/main> fork nsx nsz ``` @@ -117,13 +117,13 @@ scratch/main> fork nsx nsz a = 444 ``` ```ucm -.nsy> update.old +scratch/main nsy> update.old ``` ```unison:hide a = 555 ``` ```ucm -.nsz> update.old +scratch/main nsz> update.old scratch/main> merge.old nsy nsw ``` ```ucm:error @@ -131,7 +131,7 @@ scratch/main> merge.old nsz nsw ``` ```ucm scratch/main> diff.namespace nsx nsw -.nsw> view a b +scratch/main nsw> view a b ``` ## Should be able to diff a namespace hash from history. @@ -141,7 +141,7 @@ x = 1 ``` ```ucm -.hashdiff> add +scratch/main hashdiff> add ``` ```unison @@ -149,9 +149,9 @@ y = 2 ``` ```ucm -.hashdiff> add -.hashdiff> history -.hashdiff> diff.namespace 2 1 +scratch/main hashdiff> add +scratch/main hashdiff> history +scratch/main hashdiff> diff.namespace 2 1 ``` ## diff --git a/unison-src/transcripts/doc1.md b/unison-src/transcripts/doc1.md index 3f0b0b66c9..1288d9d3f4 100644 --- a/unison-src/transcripts/doc1.md +++ b/unison-src/transcripts/doc1.md @@ -7,7 +7,7 @@ scratch/main> builtins.merge Unison documentation is written in Unison. Documentation is a value of the following type: ```ucm -.builtin> view Doc +scratch/main builtin> view Doc ``` You can create these `Doc` values with ordinary code, or you can use the special syntax. A value of structural type `Doc` can be created via syntax like: @@ -42,7 +42,7 @@ List.take.ex2 = take 2 [1,2,3,4,5] ``` ```ucm -.builtin> add +scratch/main builtin> add ``` And now let's write our docs and reference these examples: @@ -67,17 +67,17 @@ List.take.doc = [: Let's add it to the codebase. ```ucm -.builtin> add +scratch/main builtin> add ``` We can view it with `docs`, which shows the `Doc` value that is associated with a definition. ```ucm -.builtin> docs List.take +scratch/main builtin> docs List.take ``` Note that if we view the source of the documentation, the various references are *not* expanded. ```ucm -.builtin> view List.take +scratch/main builtin> view List.take ``` diff --git a/unison-src/transcripts/empty-namespaces.md b/unison-src/transcripts/empty-namespaces.md index a4d22fa805..ef17ad2363 100644 --- a/unison-src/transcripts/empty-namespaces.md +++ b/unison-src/transcripts/empty-namespaces.md @@ -31,9 +31,9 @@ scratch/main> history mynamespace Merging an empty namespace should be a no-op ```ucm:error -.empty> history -.empty> merge.old .mynamespace -.empty> history +scratch/main empty> history +scratch/main empty> merge.old .mynamespace +scratch/main empty> history ``` Add and then delete a term to add some history to a deleted namespace. diff --git a/unison-src/transcripts/emptyCodebase.md b/unison-src/transcripts/emptyCodebase.md index c7b939a3bb..4aefd0dfda 100644 --- a/unison-src/transcripts/emptyCodebase.md +++ b/unison-src/transcripts/emptyCodebase.md @@ -13,15 +13,15 @@ scratch/main> ls Technically, the definitions all exist, but they have no names. `builtins.merge` brings them into existence, under the current namespace: ```ucm -.foo> builtins.merge -.foo> ls +scratch/main foo> builtins.merge +scratch/main foo> ls ``` And for a limited time, you can get even more builtin goodies: ```ucm -.foo> builtins.mergeio -.foo> ls +scratch/main foo> builtins.mergeio +scratch/main foo> ls ``` More typically, you'd start out by pulling `base`. diff --git a/unison-src/transcripts/find-command.md b/unison-src/transcripts/find-command.md index 43e06de137..d4da9f237b 100644 --- a/unison-src/transcripts/find-command.md +++ b/unison-src/transcripts/find-command.md @@ -32,8 +32,8 @@ scratch/main> view 1 ``` ```ucm -.somewhere> find bar -.somewhere> find.global bar +scratch/main somewhere> find bar +scratch/main somewhere> find.global bar ``` ```ucm diff --git a/unison-src/transcripts/fix2000.md b/unison-src/transcripts/fix2000.md index e72a573af2..b3456fc434 100644 --- a/unison-src/transcripts/fix2000.md +++ b/unison-src/transcripts/fix2000.md @@ -38,7 +38,7 @@ scratch/main> merge.old y.b y.a scratch/main> delete.term.verbose 1 scratch/main> merge.old y m scratch/main> merge.old.squash y s -.s> todo -.m> todo +scratch/main s> todo +scratch/main m> todo ``` diff --git a/unison-src/transcripts/fix2004.md b/unison-src/transcripts/fix2004.md index 761218bb62..1c966d80be 100644 --- a/unison-src/transcripts/fix2004.md +++ b/unison-src/transcripts/fix2004.md @@ -39,7 +39,7 @@ scratch/main> delete.term.verbose a.delete3 scratch/main> delete.type.verbose a.Delete4 scratch/main> alias.term .builtin.Float.+ newbranchA.dontDelete scratch/main> merge.old newbranchA a -.a> find +scratch/main a> find ``` Meanwhile, `a2` adds some other unrelated terms, some via merging in namespaces with little history. When merging `a2` back into `a`, the deletes from their common history should be respected. @@ -64,8 +64,8 @@ scratch/main> merge.old.squash a2 asquash At this point, all the things that `a` has deleted (`delete1`, `delete2`, etc) should be deleted in both the merged and squashed results. Let's verify this: ```ucm -.a> find -.asquash> find +scratch/main a> find +scratch/main asquash> find ``` ```ucm:hide diff --git a/unison-src/transcripts/fix2254.md b/unison-src/transcripts/fix2254.md index 6f0ae20f01..17a2befbd2 100644 --- a/unison-src/transcripts/fix2254.md +++ b/unison-src/transcripts/fix2254.md @@ -1,6 +1,6 @@ ```ucm:hide -.a> builtins.merge +scratch/main a> builtins.merge ``` This transcript checks that updates to data types propagate successfully to dependent types and dependent terms that do pattern matching. First let's create some types and terms: @@ -38,7 +38,7 @@ g = cases We'll make our edits in a fork of the `a` namespace: ```ucm -.a> add +scratch/main a> add scratch/main> fork a a2 ``` diff --git a/unison-src/transcripts/fix2254.output.md b/unison-src/transcripts/fix2254.output.md index 8b4aaa3153..b0b3f60b02 100644 --- a/unison-src/transcripts/fix2254.output.md +++ b/unison-src/transcripts/fix2254.output.md @@ -34,7 +34,7 @@ g = cases We'll make our edits in a fork of the `a` namespace: ```ucm -.a> add +scratch/main a> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fuzzy-options.md b/unison-src/transcripts/fuzzy-options.md index 96e274f9a6..985173ae81 100644 --- a/unison-src/transcripts/fuzzy-options.md +++ b/unison-src/transcripts/fuzzy-options.md @@ -12,7 +12,7 @@ If a fuzzy resolver doesn't have any options available it should print a message opening an empty fuzzy-select. ```ucm:error -.empty> view +scratch/main empty> view ``` diff --git a/unison-src/transcripts/fuzzy-options.output.md b/unison-src/transcripts/fuzzy-options.output.md index 1eb893cb8f..b59ac3c34e 100644 --- a/unison-src/transcripts/fuzzy-options.output.md +++ b/unison-src/transcripts/fuzzy-options.output.md @@ -16,7 +16,7 @@ opening an empty fuzzy-select. ```ucm ☝️ The namespace .empty is empty. -.empty> view +scratch/main empty> view ⚠️ @@ -35,7 +35,7 @@ Definition args scratch/main> add ⍟ I've added these definitions: - + nested.optionTwo : ##Nat optionOne : ##Nat @@ -66,7 +66,7 @@ Project Branch args myproject/main> branch mybranch Done. I've created the mybranch branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /mybranch`. diff --git a/unison-src/transcripts/ls-pretty-print-scope-bug.md b/unison-src/transcripts/ls-pretty-print-scope-bug.md index af7ff0a0ea..36ff971074 100644 --- a/unison-src/transcripts/ls-pretty-print-scope-bug.md +++ b/unison-src/transcripts/ls-pretty-print-scope-bug.md @@ -3,7 +3,7 @@ unique type Foo = Foo ``` ```ucm -.a.b> add +scratch/main a.b> add scratch/main> fork .a.b .c.d.f .c.g.f> ``` @@ -13,7 +13,7 @@ unique type Foo = Foo ``` ```ucm -.c.g.f> add +scratch/main c.g.f> add .c> ``` @@ -22,7 +22,7 @@ foo = .d.f.Foo.Foo ``` ```ucm -.c> add +scratch/main c> add ``` At this point we have: @@ -40,5 +40,5 @@ namespace rooted at `.c`. ```ucm scratch/main> ls c -.c> ls +scratch/main c> ls ``` diff --git a/unison-src/transcripts/mergeloop.md b/unison-src/transcripts/mergeloop.md index 455e1ac783..3304e9dde7 100644 --- a/unison-src/transcripts/mergeloop.md +++ b/unison-src/transcripts/mergeloop.md @@ -9,7 +9,7 @@ a = 1 ``` ```ucm -.x> add +scratch/main x> add ``` ```unison @@ -17,7 +17,7 @@ b = 2 ``` ```ucm -.x> add +scratch/main x> add ``` ```unison @@ -25,7 +25,7 @@ b = 2 ``` ```ucm -.y> add +scratch/main y> add ``` ```unison @@ -33,7 +33,7 @@ a = 1 ``` ```ucm -.y> add +scratch/main y> add ``` ```unison @@ -42,7 +42,7 @@ b = 2 ``` ```ucm -.z> add +scratch/main z> add scratch/main> merge.old x y scratch/main> merge.old y z scratch/main> history z diff --git a/unison-src/transcripts/merges.md b/unison-src/transcripts/merges.md index 659c6059d2..0f23753c84 100644 --- a/unison-src/transcripts/merges.md +++ b/unison-src/transcripts/merges.md @@ -1,7 +1,7 @@ # Forking and merging namespaces in `ucm` ```ucm:hide -.master> builtins.merge +scratch/main master> builtins.merge ``` The Unison namespace is a versioned tree of names that map to Unison definitions. You can change this namespace and fork and merge subtrees of it. Let's start by introducing a few definitions into a new namespace, `foo`: @@ -40,8 +40,8 @@ y = "hello" ```ucm .feature1> add -.master> merge.old .feature1 -.master> view y +scratch/main master> merge.old .feature1 +scratch/main master> view y ``` > Note: `merge src`, with one argument, merges `src` into the current namespace. You can also do `merge src dest` to merge into any destination namespace. diff --git a/unison-src/transcripts/move-all.md b/unison-src/transcripts/move-all.md index bb1f01dda1..ee83aa33a7 100644 --- a/unison-src/transcripts/move-all.md +++ b/unison-src/transcripts/move-all.md @@ -44,10 +44,10 @@ bonk = 5 ``` ```ucm -.z> builtins.merge -.z> add -.z> move bonk zonk -.z> ls +z/main> builtins.merge +z/main> add +z/main> move bonk zonk +z/main> ls ``` ## Happy Path - Just namespace @@ -57,11 +57,11 @@ bonk.zonk = 5 ``` ```ucm -.a> builtins.merge -.a> add -.a> move bonk zonk -.a> ls -.a> view zonk.zonk +a/main> builtins.merge +a/main> add +a/main> move bonk zonk +a/main> ls +a/main> view zonk.zonk ``` ## Sad Path - No term, type, or namespace named src diff --git a/unison-src/transcripts/move-namespace.md b/unison-src/transcripts/move-namespace.md index a3d859d9fb..87480d5748 100644 --- a/unison-src/transcripts/move-namespace.md +++ b/unison-src/transcripts/move-namespace.md @@ -1,9 +1,9 @@ # Tests for `move.namespace` ```ucm:hide -.happy> builtins.merge -.history> builtins.merge -.existing> builtins.merge +scratch/main happy> builtins.merge +scratch/main history> builtins.merge +scratch/main existing> builtins.merge ``` ## Happy path @@ -16,7 +16,7 @@ unique type a.T = T ``` ```ucm -.happy> add +scratch/main happy> add ``` ```unison @@ -25,15 +25,15 @@ unique type a.T = T1 | T2 ``` ```ucm -.happy> update +scratch/main happy> update ``` Should be able to move the namespace, including its types, terms, and sub-namespaces. ```ucm -.happy> move.namespace a b -.happy> ls b -.happy> history b +scratch/main happy> move.namespace a b +scratch/main happy> ls b +scratch/main happy> history b ``` @@ -48,7 +48,7 @@ b.termInB = 10 ``` ```ucm -.history> add +scratch/main history> add ``` ```unison @@ -57,24 +57,24 @@ b.termInB = 11 ``` ```ucm -.history> update +scratch/main history> update ``` Deleting a namespace should not leave behind any history, if we move another to that location we expect the history to simply be the history -of the moved namespace. +of the moved namespace. ```ucm -.history> delete.namespace b -.history> move.namespace a b +scratch/main history> delete.namespace b +scratch/main history> move.namespace a b -- Should be the history from 'a' -.history> history b +scratch/main history> history b -- Should be empty -.history> history a +scratch/main history> history a ``` -## Moving over an existing branch +## Moving over an existing branch Create some namespace and add some history to them @@ -84,7 +84,7 @@ b.termInB = 10 ``` ```ucm -.existing> add +scratch/main existing> add ``` ```unison @@ -93,11 +93,11 @@ b.termInB = 11 ``` ```ucm -.existing> update -.existing> move.namespace a b +scratch/main existing> update +scratch/main existing> move.namespace a b ``` -## Moving the Root +## Moving the Root I should be able to move the root into a sub-namespace diff --git a/unison-src/transcripts/name-selection.md b/unison-src/transcripts/name-selection.md index 50830d71bc..bd859db392 100644 --- a/unison-src/transcripts/name-selection.md +++ b/unison-src/transcripts/name-selection.md @@ -5,10 +5,10 @@ This transcript shows how the pretty-printer picks names for a hash when multipl 3. Otherwise if there are multiple names with a minimal number of segments, compare the names alphabetically. ```ucm:hide -.a> builtins.merge -.a2> builtins.merge -.a3> builtins.merge -.biasing> builtins.merge +scratch/main a> builtins.merge +scratch/main a2> builtins.merge +scratch/main a3> builtins.merge +scratch/main biasing> builtins.merge ``` ```unison:hide @@ -19,9 +19,9 @@ b = 0 + 1 Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment length alias), and show that it isn't used when viewing `a`: ```ucm -.a> add -.a> alias.term b aaa.but.more.segments -.a> view a +scratch/main a> add +scratch/main a> alias.term b aaa.but.more.segments +scratch/main a> view a ``` Next let's introduce a conflicting symbol and show that its hash qualified name isn't used when it has an unconflicted name: @@ -37,11 +37,11 @@ d = c + 10 ``` ```ucm:hide -.a2> builtins.merge +scratch/main a2> builtins.merge ``` ```ucm -.a2> add -.a2> alias.term c long.name.but.shortest.suffixification +scratch/main a2> add +scratch/main a2> alias.term c long.name.but.shortest.suffixification ``` ```unison:hide @@ -50,8 +50,8 @@ d = c + 10 ``` ```ucm -.a3> add -.a3> merge.old .a2 .a3 +scratch/main a3> add +scratch/main a3> merge.old .a2 .a3 ``` At this point, `a3` is conflicted for symbols `c` and `d`, so those are deprioritized. @@ -74,11 +74,11 @@ a = 10 ``` ```ucm -.biasing> add +scratch/main biasing> add -- Despite being saved with name `a`, -- the pretty printer should prefer the suffixified 'deeply.nested.num name' over the shallow 'a'. -- It's closer to the term being printed. -.biasing> view deeply.nested.term +scratch/main biasing> view deeply.nested.term ``` Add another term with `num` suffix to force longer suffixification of `deeply.nested.num` @@ -88,8 +88,8 @@ other.num = 20 ``` ```ucm -.biasing> add +scratch/main biasing> add -- nested.num should be preferred over the shorter name `a` due to biasing -- because `deeply.nested.num` is nearby to the term being viewed. -.biasing> view deeply.nested.term +scratch/main biasing> view deeply.nested.term ``` diff --git a/unison-src/transcripts/names.md b/unison-src/transcripts/names.md index 6c93ea33ef..38457e3cc1 100644 --- a/unison-src/transcripts/names.md +++ b/unison-src/transcripts/names.md @@ -22,11 +22,11 @@ scratch/main> add ```ucm -- We can search by suffix and find all definitions named 'x', and each of their aliases respectively. -- But we don't see somewhere.z which is has the same value but is out of our namespace -.some> names x +scratch/main some> names x -- We can search by hash, and see all aliases of that hash -.some> names #gjmq673r1v +scratch/main some> names #gjmq673r1v -- If the query is absolute, treat it as a `names.global` -.some> names .some.place.x +scratch/main some> names .some.place.x ``` `names.global` searches from the root, and absolutely qualifies results @@ -34,9 +34,9 @@ scratch/main> add ```ucm -- We can search by suffix and find all definitions in the codebase named 'x', and each of their aliases respectively. -.some> names.global x +scratch/main some> names.global x -- We can search by hash, and see all aliases of that hash in the codebase -.some> names.global #gjmq673r1v +scratch/main some> names.global #gjmq673r1v -- We can search using an absolute name -.some> names.global .some.place.x +scratch/main some> names.global .some.place.x ``` diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index 75eff3c3a5..ee635f19e7 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -19,9 +19,9 @@ somewhere.y = 2 I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: - + some.otherplace.x : ##Nat some.otherplace.y : ##Nat some.place.x : ##Nat @@ -33,7 +33,7 @@ somewhere.y = 2 scratch/main> add ⍟ I've added these definitions: - + some.otherplace.x : ##Nat some.otherplace.y : ##Nat some.place.x : ##Nat @@ -48,12 +48,12 @@ scratch/main> add -- But we don't see somewhere.z which is has the same value but is out of our namespace ☝️ The namespace .some is empty. -.some> names x +scratch/main some> names x 😶 - + I couldn't find anything by that name. - + Tip: Use `names.global` to see more results. ``` @@ -69,8 +69,8 @@ The transcript failed due to an error in the stanza above. The error is: 😶 - + I couldn't find anything by that name. - + Tip: Use `names.global` to see more results. diff --git a/unison-src/transcripts/numbered-args.md b/unison-src/transcripts/numbered-args.md index f421a67177..d895be6cb8 100644 --- a/unison-src/transcripts/numbered-args.md +++ b/unison-src/transcripts/numbered-args.md @@ -1,7 +1,7 @@ # Using numbered arguments in UCM ```ucm:hide -.temp> alias.type ##Text Text +scratch/main temp> alias.type ##Text Text ``` First lets add some contents to our codebase. @@ -16,41 +16,41 @@ corge = "corge" ``` ```ucm -.temp> add +scratch/main temp> add ``` We can get the list of things in the namespace, and UCM will give us a numbered list: ```ucm -.temp> find +scratch/main temp> find ``` We can ask to `view` the second element of this list: ```ucm -.temp> find -.temp> view 2 +scratch/main temp> find +scratch/main temp> view 2 ``` And we can `view` multiple elements by separating with spaces: ```ucm -.temp> find -.temp> view 2 3 5 +scratch/main temp> find +scratch/main temp> view 2 3 5 ``` We can also ask for a range: ```ucm -.temp> find -.temp> view 2-4 +scratch/main temp> find +scratch/main temp> view 2-4 ``` And we can ask for multiple ranges and use mix of ranges and numbers: ```ucm -.temp> find -.temp> view 1-3 4 5-6 +scratch/main temp> find +scratch/main temp> view 1-3 4 5-6 ``` diff --git a/unison-src/transcripts/project-merge.md b/unison-src/transcripts/project-merge.md index 4d27e25931..4e35b9ed2e 100644 --- a/unison-src/transcripts/project-merge.md +++ b/unison-src/transcripts/project-merge.md @@ -9,7 +9,7 @@ zonk = 0 ``` ```ucm -.foo> add +scratch/main foo> add scratch/main> project.create-empty foo scratch/main> merge.old foo foo/main ``` @@ -35,5 +35,5 @@ xonk = 1 ```ucm bar/main> add bar/topic> merge.old /main -.bar> merge.old foo/main +scratch/main bar> merge.old foo/main ``` diff --git a/unison-src/transcripts/propagate.md b/unison-src/transcripts/propagate.md index ea0e8d8b0f..61237912c9 100644 --- a/unison-src/transcripts/propagate.md +++ b/unison-src/transcripts/propagate.md @@ -1,7 +1,7 @@ # Propagating type edits ```ucm:hide -.subpath.lib> builtins.merge +scratch/main subpath.lib> builtins.merge ``` We introduce a type `Foo` with a function dependent `fooToInt`. @@ -16,9 +16,9 @@ fooToInt _ = +42 And then we add it. ```ucm -.subpath> add -.subpath> find.verbose -.subpath> view fooToInt +scratch/main subpath> add +scratch/main subpath> find.verbose +scratch/main subpath> view fooToInt ``` Then if we change the type `Foo`... @@ -30,13 +30,13 @@ unique type Foo = Foo | Bar and update the codebase to use the new type `Foo`... ```ucm -.subpath> update.old +scratch/main subpath> update.old ``` ... it should automatically propagate the type to `fooToInt`. ```ucm -.subpath> view fooToInt +scratch/main subpath> view fooToInt ``` ### Preserving user type variables @@ -55,7 +55,7 @@ preserve.otherTerm y = someTerm y Add that to the codebase: ```ucm -.subpath> add +scratch/main subpath> add ``` Let's now edit the dependency: @@ -68,15 +68,15 @@ preserve.someTerm _ = None Update... ```ucm -.subpath> update.old +scratch/main subpath> update.old ``` Now the type of `someTerm` should be `Optional x -> Optional x` and the type of `otherTerm` should remain the same. ```ucm -.subpath> view preserve.someTerm -.subpath> view preserve.otherTerm +scratch/main subpath> view preserve.someTerm +scratch/main subpath> view preserve.otherTerm ``` ### Propagation only applies to the local branch @@ -85,7 +85,7 @@ Cleaning up a bit... ```ucm scratch/main> delete.namespace subpath -.subpath.lib> builtins.merge +scratch/main subpath.lib> builtins.merge ``` Now, we make two terms, where one depends on the other. @@ -101,8 +101,8 @@ one.otherTerm y = someTerm y We'll make two copies of this namespace. ```ucm -.subpath> add -.subpath> fork one two +scratch/main subpath> add +scratch/main subpath> fork one two ``` Now let's edit one of the terms... @@ -115,11 +115,11 @@ someTerm _ = None ... in one of the namespaces... ```ucm -.subpath.one> update.old +scratch/main subpath.one> update.old ``` The other namespace should be left alone. ```ucm -.subpath> view two.someTerm +scratch/main subpath> view two.someTerm ``` diff --git a/unison-src/transcripts/squash.md b/unison-src/transcripts/squash.md index 93ccaed4f0..d4bb483671 100644 --- a/unison-src/transcripts/squash.md +++ b/unison-src/transcripts/squash.md @@ -20,9 +20,9 @@ Now suppose we `fork` a copy of builtin, then rename `Nat.+` to `frobnicate`, th ```ucm scratch/main> fork builtin mybuiltin -.mybuiltin> rename.term Nat.+ Nat.frobnicate -.mybuiltin> rename.term Nat.frobnicate Nat.+ -.mybuiltin> history +scratch/main mybuiltin> rename.term Nat.+ Nat.frobnicate +scratch/main mybuiltin> rename.term Nat.frobnicate Nat.+ +scratch/main mybuiltin> history ``` If we merge that back into `builtin`, we get that same chain of history: @@ -50,7 +50,7 @@ x = 1 ``` ```ucm -.trunk> add +scratch/main trunk> add scratch/main> fork trunk alice scratch/main> fork trunk bob ``` @@ -64,9 +64,9 @@ neatoFun x = x ``` ```ucm -.alice> add -.alice> rename.term radNumber superRadNumber -.alice> rename.term neatoFun productionReadyId +scratch/main alice> add +scratch/main alice> rename.term radNumber superRadNumber +scratch/main alice> rename.term neatoFun productionReadyId ``` Meanwhile, Bob does his own hacking: @@ -78,7 +78,7 @@ no more = no more ``` ```ucm -.bob> add +scratch/main bob> add ``` At this point, Alice and Bob both have some history beyond what's in trunk: @@ -132,12 +132,12 @@ There's nothing really special here, `squash src dest` discards `src` history th This checks to see that squashing correctly preserves deletions: ```ucm -.delete> builtins.merge -.delete> fork builtin builtin2 -.delete> delete.term.verbose builtin2.Nat.+ -.delete> delete.term.verbose builtin2.Nat.* -.delete> merge.old.squash builtin2 builtin -.delete> history builtin +scratch/main delete> builtins.merge +scratch/main delete> fork builtin builtin2 +scratch/main delete> delete.term.verbose builtin2.Nat.+ +scratch/main delete> delete.term.verbose builtin2.Nat.* +scratch/main delete> merge.old.squash builtin2 builtin +scratch/main delete> history builtin ``` Notice that `Nat.+` and `Nat.*` are deleted by the squash, and we see them deleted in one atomic step in the history. @@ -145,11 +145,11 @@ Notice that `Nat.+` and `Nat.*` are deleted by the squash, and we see them delet Just confirming that those two definitions are in fact removed: ```ucm:error -.delete> view .delete.builtin.Nat.+ +scratch/main delete> view .delete.builtin.Nat.+ ``` ```ucm:error -.delete> view .delete.builtin.Nat.* +scratch/main delete> view .delete.builtin.Nat.* ``` ## Caveats diff --git a/unison-src/transcripts/sum-type-update-conflicts.md b/unison-src/transcripts/sum-type-update-conflicts.md index ce29931852..852aa66f91 100644 --- a/unison-src/transcripts/sum-type-update-conflicts.md +++ b/unison-src/transcripts/sum-type-update-conflicts.md @@ -3,7 +3,7 @@ https://github.com/unisonweb/unison/issues/2786 ```ucm:hide -.ns> builtins.merge +scratch/main ns> builtins.merge ``` First we add a sum-type to the codebase. @@ -13,7 +13,7 @@ structural type X = x ``` ```ucm -.ns> add +scratch/main ns> add ``` Now we update the type, changing the name of the constructors, _but_, we simultaneously @@ -32,5 +32,5 @@ This update should succeed since the conflicted constructor is removed in the same update that the new term is being added. ```ucm -.ns> update.old +scratch/main ns> update.old ``` diff --git a/unison-src/transcripts/tab-completion.md b/unison-src/transcripts/tab-completion.md index 28ba55c8dd..65a7861f71 100644 --- a/unison-src/transcripts/tab-completion.md +++ b/unison-src/transcripts/tab-completion.md @@ -37,7 +37,7 @@ scratch/main> debug.tab-complete view subnamespace2 scratch/main> debug.tab-complete view subnamespace.some scratch/main> debug.tab-complete view subnamespace.someOther -- Should tab complete absolute names -.othernamespace> debug.tab-complete view .subnamespace.some +scratch/main othernamespace> debug.tab-complete view .subnamespace.some ``` ## Tab complete namespaces diff --git a/unison-src/transcripts/test-command.md b/unison-src/transcripts/test-command.md index f4c80cb840..39a7b9bcad 100644 --- a/unison-src/transcripts/test-command.md +++ b/unison-src/transcripts/test-command.md @@ -36,7 +36,7 @@ testInLib = [Ok "testInLib"] ``` ```ucm:hide -.lib> add +scratch/main lib> add ``` ```ucm @@ -47,7 +47,7 @@ scratch/main> test.all `test` WILL run tests within `lib` if ucm is cd'd inside. ```ucm -.lib> test +scratch/main lib> test ``` `test` can be given a relative path, in which case it will only run tests found somewhere in that namespace. diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index 9f47cc290e..4c5e516cde 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -13,7 +13,6 @@ baz = foo.bar + foo.bar ``` ```ucm - Loading changes detected in scratch.u. I found and typechecked these definitions in scratch.u. If you diff --git a/unison-src/transcripts/update-on-conflict.md b/unison-src/transcripts/update-on-conflict.md index 51dfd75e28..ae239b87fc 100644 --- a/unison-src/transcripts/update-on-conflict.md +++ b/unison-src/transcripts/update-on-conflict.md @@ -2,7 +2,7 @@ ```ucm:hide scratch/main> builtins.merge -.merged> builtins.merge +scratch/main merged> builtins.merge ``` ```unison @@ -13,8 +13,8 @@ b.x = 2 Cause a conflict: ```ucm scratch/main> add -.merged> merge.old .a -.merged> merge.old .b +scratch/main merged> merge.old .a +scratch/main merged> merge.old .b ``` Updating conflicted definitions works fine. @@ -24,5 +24,5 @@ x = 3 ``` ```ucm -.merged> update +scratch/main merged> update ``` diff --git a/unison-src/transcripts/update-type-add-new-record.md b/unison-src/transcripts/update-type-add-new-record.md index 86c7bb0e4c..18abd8796c 100644 --- a/unison-src/transcripts/update-type-add-new-record.md +++ b/unison-src/transcripts/update-type-add-new-record.md @@ -1,5 +1,5 @@ ```ucm:hide -.lib> builtins.merge +scratch/main lib> builtins.merge ``` ```unison diff --git a/unison-src/transcripts/view.md b/unison-src/transcripts/view.md index 25d56dc842..9e6d59526b 100644 --- a/unison-src/transcripts/view.md +++ b/unison-src/transcripts/view.md @@ -17,9 +17,9 @@ scratch/main> add -- Should suffix-search and find values in sub-namespaces scratch/main> view thing -- Should be local to namespace -.a> view thing +scratch/main a> view thing -- view.global should search globally and be absolutely qualified -.a> view.global thing +scratch/main a> view.global thing -- Should support absolute paths outside of current namespace -.a> view .b.thing +scratch/main a> view .b.thing ``` From 7930cc2c33c793f2e2519527fb33264352f564f3 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 11 Jun 2024 15:52:47 -0700 Subject: [PATCH 241/631] Transcript output updates --- .../transcripts-using-base/fix1709.output.md | 9 ++++---- unison-src/transcripts/add-run.output.md | 4 ++-- unison-src/transcripts/api-find.output.md | 20 ++++++++--------- .../transcripts/bug-strange-closure.output.md | 2 +- unison-src/transcripts/move-all.output.md | 22 ++++++++----------- unison-src/transcripts/reflog.output.md | 10 ++++----- 6 files changed, 31 insertions(+), 36 deletions(-) diff --git a/unison-src/transcripts-using-base/fix1709.output.md b/unison-src/transcripts-using-base/fix1709.output.md index 99af3fe0d4..8210532769 100644 --- a/unison-src/transcripts-using-base/fix1709.output.md +++ b/unison-src/transcripts-using-base/fix1709.output.md @@ -18,18 +18,17 @@ id2 x = id : x -> x (also named - __projects._a60db36c_af90_4d99_bcd2_3b3c7a24851f.branches._4fe18976_dde6_41e4_82c0_bf3887f77467.id) + __projects._05eecf9d_2346_49c6_a526_322179f9a76a.branches._a446c219_4db0_4bc4_8357_f7e0a10c7e04.id) id2 : x -> x ``` ```ucm - ☝️ The namespace .scratch is empty. - -.scratch> add +scratch/main> add + ⊡ Ignored previously added definitions: id + ⍟ I've added these definitions: - id : x -> x id2 : x -> x ``` diff --git a/unison-src/transcripts/add-run.output.md b/unison-src/transcripts/add-run.output.md index 8dd8846ae6..7dc7fce2d9 100644 --- a/unison-src/transcripts/add-run.output.md +++ b/unison-src/transcripts/add-run.output.md @@ -302,9 +302,9 @@ scratch/main> add.run .an.absolute.name scratch/main> view .an.absolute.name - .__projects._0fa2644c_1cf9_43bb_ab82_9f0beaab9ab1.branches._264fbcac_777c_4007_b589_01035cad230a.an.absolute.name : + .__projects._ed77def0_0f5b_4a68_9563_0c705b131e21.branches._5a2c3951_0700_4331_8455_a27805a78722.an.absolute.name : Nat - .__projects._0fa2644c_1cf9_43bb_ab82_9f0beaab9ab1.branches._264fbcac_777c_4007_b589_01035cad230a.an.absolute.name = + .__projects._ed77def0_0f5b_4a68_9563_0c705b131e21.branches._5a2c3951_0700_4331_8455_a27805a78722.an.absolute.name = 5 ``` diff --git a/unison-src/transcripts/api-find.output.md b/unison-src/transcripts/api-find.output.md index d8e17c212d..57d7fe18d9 100644 --- a/unison-src/transcripts/api-find.output.md +++ b/unison-src/transcripts/api-find.output.md @@ -43,7 +43,7 @@ GET /api/non-project-code/find?query=http "result": { "segments": [ { - "contents": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.ross.", + "contents": "__projects._aaeff654_596b_4266_99a7_29f5fe27a380.branches._c5b2ebde_a857_4c26_9b36_9a336751292a.ross.", "tag": "Gap" }, { @@ -63,7 +63,7 @@ GET /api/non-project-code/find?query=http "bestFoundTermName": "y", "namedTerm": { "termHash": "#emomp74i93h6ps0b5sukke0tci0ooba3f9jk21qm919a7act9u7asani84c0mqbdk4lcjrdvr9olpedp23p6df78r4trqlg0cciadc8", - "termName": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.ross.httpClient.y", + "termName": "__projects._aaeff654_596b_4266_99a7_29f5fe27a380.branches._c5b2ebde_a857_4c26_9b36_9a336751292a.ross.httpClient.y", "termTag": "Plain", "termType": [ { @@ -84,7 +84,7 @@ GET /api/non-project-code/find?query=http "result": { "segments": [ { - "contents": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.joey.", + "contents": "__projects._aaeff654_596b_4266_99a7_29f5fe27a380.branches._c5b2ebde_a857_4c26_9b36_9a336751292a.joey.", "tag": "Gap" }, { @@ -104,7 +104,7 @@ GET /api/non-project-code/find?query=http "bestFoundTermName": "z", "namedTerm": { "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.joey.httpServer.z", + "termName": "__projects._aaeff654_596b_4266_99a7_29f5fe27a380.branches._c5b2ebde_a857_4c26_9b36_9a336751292a.joey.httpServer.z", "termTag": "Plain", "termType": [ { @@ -129,7 +129,7 @@ GET /api/non-project-code/find?query=Server "result": { "segments": [ { - "contents": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.joey.http", + "contents": "__projects._aaeff654_596b_4266_99a7_29f5fe27a380.branches._c5b2ebde_a857_4c26_9b36_9a336751292a.joey.http", "tag": "Gap" }, { @@ -149,7 +149,7 @@ GET /api/non-project-code/find?query=Server "bestFoundTermName": "z", "namedTerm": { "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.joey.httpServer.z", + "termName": "__projects._aaeff654_596b_4266_99a7_29f5fe27a380.branches._c5b2ebde_a857_4c26_9b36_9a336751292a.joey.httpServer.z", "termTag": "Plain", "termType": [ { @@ -174,7 +174,7 @@ GET /api/non-project-code/find?query=lesys "result": { "segments": [ { - "contents": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.rachel.fi", + "contents": "__projects._aaeff654_596b_4266_99a7_29f5fe27a380.branches._c5b2ebde_a857_4c26_9b36_9a336751292a.rachel.fi", "tag": "Gap" }, { @@ -194,7 +194,7 @@ GET /api/non-project-code/find?query=lesys "bestFoundTermName": "x", "namedTerm": { "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "termName": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.rachel.filesystem.x", + "termName": "__projects._aaeff654_596b_4266_99a7_29f5fe27a380.branches._c5b2ebde_a857_4c26_9b36_9a336751292a.rachel.filesystem.x", "termTag": "Plain", "termType": [ { @@ -219,7 +219,7 @@ GET /api/non-project-code/find?query=joey.http "result": { "segments": [ { - "contents": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.", + "contents": "__projects._aaeff654_596b_4266_99a7_29f5fe27a380.branches._c5b2ebde_a857_4c26_9b36_9a336751292a.", "tag": "Gap" }, { @@ -239,7 +239,7 @@ GET /api/non-project-code/find?query=joey.http "bestFoundTermName": "z", "namedTerm": { "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "__projects._983a1040_9f2f_4979_bf00_f26b89b303cc.branches._4c0f994b_5a4c_4130_a3ac_7534cb682e97.joey.httpServer.z", + "termName": "__projects._aaeff654_596b_4266_99a7_29f5fe27a380.branches._c5b2ebde_a857_4c26_9b36_9a336751292a.joey.httpServer.z", "termTag": "Plain", "termType": [ { diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md index 3d70740281..f294c6b274 100644 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ b/unison-src/transcripts/bug-strange-closure.output.md @@ -840,7 +840,7 @@ scratch/main> undo Added definitions: - 1. __projects._141465a8_cfb4_456f_aefa_25b7a6062af2.branches._d233d31d_8101_4a8e_b332_9cd3a64f71e9.rendered : Annotated + 1. __projects._442aec5a_fada_40e6_9d90_5e40d9eac561.branches._473923ea_de67_4053_ac42_b77317959797.rendered : Annotated ( ) (Either SpecialForm diff --git a/unison-src/transcripts/move-all.output.md b/unison-src/transcripts/move-all.output.md index 9ec89be763..d7a7bec859 100644 --- a/unison-src/transcripts/move-all.output.md +++ b/unison-src/transcripts/move-all.output.md @@ -127,23 +127,21 @@ bonk = 5 ``` ```ucm - ☝️ The namespace .z is empty. - -.z> builtins.merge +z/main> builtins.merge Done. -.z> add +z/main> add ⍟ I've added these definitions: bonk : Nat -.z> move bonk zonk +z/main> move bonk zonk Done. -.z> ls +z/main> ls 1. builtin/ (469 terms, 74 types) 2. zonk (Nat) @@ -170,28 +168,26 @@ bonk.zonk = 5 ``` ```ucm - ☝️ The namespace .a is empty. - -.a> builtins.merge +a/main> builtins.merge Done. -.a> add +a/main> add ⍟ I've added these definitions: bonk.zonk : Nat -.a> move bonk zonk +a/main> move bonk zonk Done. -.a> ls +a/main> ls 1. builtin/ (469 terms, 74 types) 2. zonk/ (1 term) -.a> view zonk.zonk +a/main> view zonk.zonk zonk.zonk : Nat zonk.zonk = 5 diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index 75d0bb1eae..fa9cce21b7 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -63,17 +63,17 @@ scratch/main> reflog most recent, along with the command that got us there. Try: `fork 2 .old` - `fork #86h1kthpsh .old` to make an old namespace + `fork #hbahg20drn .old` to make an old namespace accessible again, - `reset-root #86h1kthpsh` to reset the root namespace and + `reset-root #hbahg20drn` to reset the root namespace and its history to that of the specified namespace. When Root Hash Action - 1. now #0de5f40rcr add - 2. now #86h1kthpsh add - 3. now #ei3jcs9f6v builtins.merge + 1. now #vci96hc5m3 add + 2. now #hbahg20drn add + 3. now #bc5vrbcbbf builtins.merge 4. #sg60bvjo91 history starts here Tip: Use `diff.namespace 1 7` to compare namespaces between From 6152577dd4953a6213c3bea4458dc6bf2bf4ca16 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 25 Jun 2024 11:16:51 -0700 Subject: [PATCH 242/631] Fix alias-many transcript --- unison-src/transcripts/alias-many.md | 6 +- unison-src/transcripts/alias-many.output.md | 91 ++++++++++----------- 2 files changed, 46 insertions(+), 51 deletions(-) diff --git a/unison-src/transcripts/alias-many.md b/unison-src/transcripts/alias-many.md index 0eed6fef3f..57450c64dc 100644 --- a/unison-src/transcripts/alias-many.md +++ b/unison-src/transcripts/alias-many.md @@ -1,5 +1,5 @@ ```ucm:hide -scratch/main> builtins.merge +scratch/main> builtins.merge lib.builtins ``` ```unison:hide:all List.adjacentPairs : [a] -> [(a, a)] @@ -95,7 +95,7 @@ List.takeWhile p xs = go xs [] ``` ```ucm:hide -scratch/main stuff> add +scratch/main> add ``` The `alias.many` command can be used to copy definitions from the current namespace into your curated one. @@ -113,7 +113,7 @@ scratch/main> help alias.many Let's try it! ```ucm -scratch/main> alias.many stuff.List.adjacentPairs stuff.List.all stuff.List.any stuff.List.chunk stuff.List.chunksOf stuff.List.dropWhile stuff.List.first stuff.List.init stuff.List.intersperse stuff.List.isEmpty stuff.List.last stuff.List.replicate stuff.List.splitAt stuff.List.tail stuff.List.takeWhile .mylib +scratch/main> alias.many List.adjacentPairs List.all List.any List.chunk List.chunksOf List.dropWhile List.first List.init List.intersperse List.isEmpty List.last List.replicate List.splitAt List.tail List.takeWhile mylib scratch/main> find-in mylib ``` diff --git a/unison-src/transcripts/alias-many.output.md b/unison-src/transcripts/alias-many.output.md index a0b100000c..b12422e093 100644 --- a/unison-src/transcripts/alias-many.output.md +++ b/unison-src/transcripts/alias-many.output.md @@ -14,57 +14,52 @@ The names that will be used in the target namespace are the names you specify, r Let's try it! ```ucm -scratch/main> alias.many stuff.List.adjacentPairs stuff.List.all stuff.List.any stuff.List.chunk stuff.List.chunksOf stuff.List.dropWhile stuff.List.first stuff.List.init stuff.List.intersperse stuff.List.isEmpty stuff.List.last stuff.List.replicate stuff.List.splitAt stuff.List.tail stuff.List.takeWhile .mylib +scratch/main> alias.many List.adjacentPairs List.all List.any List.chunk List.chunksOf List.dropWhile List.first List.init List.intersperse List.isEmpty List.last List.replicate List.splitAt List.tail List.takeWhile mylib - Nothing changed in .mylib . - - ⚠️ + Here's what changed in mylib : - The following names were not found in the codebase. Check your spelling. - stuff.List.adjacentPairs - stuff.List.all - stuff.List.any - stuff.List.chunk - stuff.List.chunksOf - stuff.List.dropWhile - stuff.List.first - stuff.List.init - stuff.List.intersperse - stuff.List.isEmpty - stuff.List.last - stuff.List.replicate - stuff.List.splitAt - stuff.List.tail - stuff.List.takeWhile - -``` - -```ucm -scratch/main> alias.many stuff.List.adjacentPairs stuff.List.all stuff.List.any stuff.List.chunk stuff.List.chunksOf stuff.List.dropWhile stuff.List.first stuff.List.init stuff.List.intersperse stuff.List.isEmpty stuff.List.last stuff.List.replicate stuff.List.splitAt stuff.List.tail stuff.List.takeWhile .mylibscratch/main> find-in mylib -``` - - -🛑 - -The transcript failed due to an error in the stanza above. The error is: + Added definitions: + + 1. List.adjacentPairs : [a] -> [(a, a)] + 2. List.all : (a ->{g} Boolean) + -> [a] + ->{g} Boolean + 3. List.any : (a ->{g} Boolean) + -> [a] + ->{g} Boolean + 4. List.chunk : Nat -> [a] -> [[a]] + 5. List.chunksOf : Nat -> [a] -> [[a]] + 6. List.dropWhile : (a ->{g} Boolean) -> [a] ->{g} [a] + 7. List.first : [a] -> Optional a + 8. List.init : [a] -> Optional [a] + 9. List.intersperse : a -> [a] -> [a] + 10. List.isEmpty : [a] -> Boolean + 11. List.last : [a] -> Optional a + 12. List.replicate : Nat -> a -> [a] + 13. List.splitAt : Nat -> [a] -> ([a], [a]) + 14. List.tail : [a] -> Optional [a] + 15. List.takeWhile : (a ->{𝕖} Boolean) -> [a] ->{𝕖} [a] + + Tip: You can use `undo` or `reflog` to undo this change. +scratch/main> find-in mylib - ⚠️ + 1. List.adjacentPairs : [a] -> [(a, a)] + 2. List.all : (a ->{g} Boolean) -> [a] ->{g} Boolean + 3. List.any : (a ->{g} Boolean) -> [a] ->{g} Boolean + 4. List.chunk : Nat -> [a] -> [[a]] + 5. List.chunksOf : Nat -> [a] -> [[a]] + 6. List.dropWhile : (a ->{g} Boolean) -> [a] ->{g} [a] + 7. List.first : [a] -> Optional a + 8. List.init : [a] -> Optional [a] + 9. List.intersperse : a -> [a] -> [a] + 10. List.isEmpty : [a] -> Boolean + 11. List.last : [a] -> Optional a + 12. List.replicate : Nat -> a -> [a] + 13. List.splitAt : Nat -> [a] -> ([a], [a]) + 14. List.tail : [a] -> Optional [a] + 15. List.takeWhile : (a ->{𝕖} Boolean) -> [a] ->{𝕖} [a] - The following names were not found in the codebase. Check your spelling. - stuff.List.adjacentPairs - stuff.List.all - stuff.List.any - stuff.List.chunk - stuff.List.chunksOf - stuff.List.dropWhile - stuff.List.first - stuff.List.init - stuff.List.intersperse - stuff.List.isEmpty - stuff.List.last - stuff.List.replicate - stuff.List.splitAt - stuff.List.tail - stuff.List.takeWhile +``` +Thanks, `alias.many! From 627acb7f3a3107ee5b31bba21429e1aee7815191 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Tue, 25 Jun 2024 15:33:22 -0400 Subject: [PATCH 243/631] Update parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs --- parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs index 764d99266e..9391aa693d 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs @@ -519,8 +519,8 @@ addConstraint con0 nc = do let updateLiteral pos neg lit | Just lit1 <- pos, lit1 == lit = - (pure (), Ignore) -- we already have this positive constraint - -- the constraint contradicts negative info + -- we already have this positive constraint + (pure (), Ignore) | Set.member lit neg = (contradiction, Ignore) | otherwise = (pure (), Update (Just lit, neg)) in modifyLiteralC var pmlit updateLiteral nc From 382cdacb9f687d79b3a4e9384cfce82fb50ffcf6 Mon Sep 17 00:00:00 2001 From: aryairani Date: Tue, 25 Jun 2024 19:33:39 +0000 Subject: [PATCH 244/631] automatically run ormolu --- parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs index 9391aa693d..b605750686 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs @@ -519,7 +519,7 @@ addConstraint con0 nc = do let updateLiteral pos neg lit | Just lit1 <- pos, lit1 == lit = - -- we already have this positive constraint + -- we already have this positive constraint (pure (), Ignore) | Set.member lit neg = (contradiction, Ignore) | otherwise = (pure (), Update (Just lit, neg)) From 34877da01c0bf3534613f20a56e25719b24bcd95 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Tue, 25 Jun 2024 15:54:10 -0400 Subject: [PATCH 245/631] Don't relax type when doing an instantiateL during subtyping This is the case of `a < T` for some structured T. By relaxing, we are actually allowing `a` to be a _supertype_ of T as far as abilities go, which is not correct. Seems like it was just erroneously mirrored from the opposite case. --- .../src/Unison/Typechecker/Context.hs | 3 +- unison-src/transcripts-using-base/fix5129.md | 45 ++++++++++++ .../transcripts-using-base/fix5129.output.md | 73 +++++++++++++++++++ unison-src/transcripts/fix2355.output.md | 2 +- 4 files changed, 120 insertions(+), 3 deletions(-) create mode 100644 unison-src/transcripts-using-base/fix5129.md create mode 100644 unison-src/transcripts-using-base/fix5129.output.md diff --git a/parser-typechecker/src/Unison/Typechecker/Context.hs b/parser-typechecker/src/Unison/Typechecker/Context.hs index 11279cf898..7a4ecb8b59 100644 --- a/parser-typechecker/src/Unison/Typechecker/Context.hs +++ b/parser-typechecker/src/Unison/Typechecker/Context.hs @@ -2561,8 +2561,7 @@ subtype tx ty = scope (InSubtype tx ty) $ do go ctx (Type.Var' (TypeVar.Existential b v)) t -- `InstantiateL` | Set.member v (existentials ctx) && notMember v (Type.freeVars t) = do - e <- extendExistential Var.inferAbility - instantiateL b v (relax' False e t) + instantiateL b v t go ctx t (Type.Var' (TypeVar.Existential b v)) -- `InstantiateR` | Set.member v (existentials ctx) && notMember v (Type.freeVars t) = do diff --git a/unison-src/transcripts-using-base/fix5129.md b/unison-src/transcripts-using-base/fix5129.md new file mode 100644 index 0000000000..ccdd8bee41 --- /dev/null +++ b/unison-src/transcripts-using-base/fix5129.md @@ -0,0 +1,45 @@ +```ucm:hide +.> builtins.mergeio +``` + +Checks for some bad type checking behavior. Some ability subtyping was +too lenient when higher-order functions were involved. + +```unison:error +foreach : (a ->{g} ()) -> [a] ->{g} () +foreach f = cases + [] -> () + x +: xs -> + f x + foreach f xs + +forkIt : '{IO} () ->{IO} () +forkIt e = + _ = IO.forkComp e + () + +thunk : '{IO,Exception} () +thunk = do + raise (Failure (typeLink MiscFailure) "thunk" (Any ())) + +go = do + foreach forkIt [thunk] +``` + +This comes from issue #3513 + +```unison:error +(<<) : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c +(<<) f g x = f (g x) + +catchAll.impl : '{IO, Exception} a ->{IO} Either Failure a +catchAll.impl thunk = + handle tryEval do catch thunk + with + cases + { x } -> x + {Exception.raise f -> _} -> Left f + +fancyTryEval : '{g, IO, Exception} a ->{g, IO, Exception} a +fancyTryEval = reraise << catchAll.impl +``` diff --git a/unison-src/transcripts-using-base/fix5129.output.md b/unison-src/transcripts-using-base/fix5129.output.md new file mode 100644 index 0000000000..af189d5a8f --- /dev/null +++ b/unison-src/transcripts-using-base/fix5129.output.md @@ -0,0 +1,73 @@ +Checks for some bad type checking behavior. Some ability subtyping was +too lenient when higher-order functions were involved. + +```unison +foreach : (a ->{g} ()) -> [a] ->{g} () +foreach f = cases + [] -> () + x +: xs -> + f x + foreach f xs + +forkIt : '{IO} () ->{IO} () +forkIt e = + _ = IO.forkComp e + () + +thunk : '{IO,Exception} () +thunk = do + raise (Failure (typeLink MiscFailure) "thunk" (Any ())) + +go = do + foreach forkIt [thunk] +``` + +```ucm + + Loading changes detected in scratch.u. + + I found an ability mismatch when checking the application + + 18 | foreach forkIt [thunk] + + + When trying to match [Unit ->{𝕖75, IO, Exception} Unit] with + [Unit ->{IO} Unit] the left hand side contained extra + abilities: {𝕖75, Exception} + + + +``` +This comes from issue #3513 + +```unison +(<<) : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c +(<<) f g x = f (g x) + +catchAll.impl : '{IO, Exception} a ->{IO} Either Failure a +catchAll.impl thunk = + handle tryEval do catch thunk + with + cases + { x } -> x + {Exception.raise f -> _} -> Left f + +fancyTryEval : '{g, IO, Exception} a ->{g, IO, Exception} a +fancyTryEval = reraise << catchAll.impl +``` + +```ucm + + Loading changes detected in scratch.u. + + The expression in red + + needs the abilities: {g76} + but was assumed to only require: {IO, Exception} + + This is likely a result of using an un-annotated function as an argument with concrete abilities. Try adding an annotation to the function definition whose body is red. + + 13 | fancyTryEval = reraise << catchAll.impl + + +``` diff --git a/unison-src/transcripts/fix2355.output.md b/unison-src/transcripts/fix2355.output.md index ce2f06798e..0bc382663e 100644 --- a/unison-src/transcripts/fix2355.output.md +++ b/unison-src/transcripts/fix2355.output.md @@ -28,7 +28,7 @@ example = 'let The expression in red was inferred to require the ability: - {A t25 {𝕖39, 𝕖18}} + {A t25 {𝕖36, 𝕖18}} where `𝕖18` is its overall abilities. From 9ea0650fc8b561eb03950ea270d4b4ff82bc5329 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 25 Jun 2024 11:32:44 -0700 Subject: [PATCH 246/631] Improve atomicity of debug logs --- lib/unison-prelude/src/Unison/Debug.hs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/lib/unison-prelude/src/Unison/Debug.hs b/lib/unison-prelude/src/Unison/Debug.hs index 47fdb2ee75..7881045c65 100644 --- a/lib/unison-prelude/src/Unison/Debug.hs +++ b/lib/unison-prelude/src/Unison/Debug.hs @@ -13,13 +13,12 @@ module Unison.Debug ) where -import Control.Applicative (empty) -import Control.Monad (when) -import Data.Set (Set) import Data.Set qualified as Set import Data.Text qualified as Text -import Debug.Pretty.Simple (pTrace, pTraceM, pTraceShowId, pTraceShowM) +import Debug.Pretty.Simple (pTrace, pTraceM) import System.IO.Unsafe (unsafePerformIO) +import Text.Pretty.Simple (pShow) +import Unison.Prelude import UnliftIO.Environment (lookupEnv) data DebugFlag @@ -148,7 +147,7 @@ debugPatternCoverageConstraintSolver = PatternCoverageConstraintSolver `Set.memb debug :: (Show a) => DebugFlag -> String -> a -> a debug flag msg a = if shouldDebug flag - then pTraceShowId (pTrace (msg <> ":\n") a) + then (pTrace (msg <> ":\n" <> into @String (pShow a)) a) else a -- | Use for selective debug logging in monadic contexts. @@ -159,8 +158,7 @@ debug flag msg a = debugM :: (Show a, Monad m) => DebugFlag -> String -> a -> m () debugM flag msg a = whenDebug flag do - pTraceM (msg <> ":\n") - pTraceShowM a + traceM (msg <> ":\n" <> into @String (pShow a)) debugLog :: DebugFlag -> String -> a -> a debugLog flag msg = From bbd02a91294e90707830404ed8610eede0473f0c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 25 Jun 2024 11:32:44 -0700 Subject: [PATCH 247/631] Port getDefinition.md to use projects. Fix recontextualization of project queries when using relativeTo --- unison-share-api/src/Unison/Server/Local.hs | 4 +- unison-src/transcripts/api-getDefinition.md | 36 +++++------ .../transcripts/api-getDefinition.output.md | 60 +++++++++---------- 3 files changed, 48 insertions(+), 52 deletions(-) diff --git a/unison-share-api/src/Unison/Server/Local.hs b/unison-share-api/src/Unison/Server/Local.hs index f5c3525f46..04a6d9f411 100644 --- a/unison-share-api/src/Unison/Server/Local.hs +++ b/unison-share-api/src/Unison/Server/Local.hs @@ -41,11 +41,11 @@ relocateToNameRoot perspective query rootBranch = do -- Since the project root is lower down we need to strip the part of the prefix -- which is now redundant. pure . Right $ (projectRoot, query <&> \n -> fromMaybe n $ Path.unprefixName (Path.Absolute remainder) n) - -- The namesRoot is _inside_ of the project containing the query + -- The namesRoot is _inside (or equal to)_ the project containing the query (_sharedPrefix, remainder, Path.Empty) -> do -- Since the project is higher up, we need to prefix the query -- with the remainder of the path - pure $ Right (projectRoot, query <&> Path.prefixNameIfRel (Path.AbsolutePath' $ Path.Absolute remainder)) + pure $ Right (projectRoot, query <&> Path.prefixNameIfRel (Path.RelativePath' $ Path.Relative remainder)) -- The namesRoot and project root are disjoint, this shouldn't ever happen. (_, _, _) -> pure $ Left (DisjointProjectAndPerspective perspective projectRoot) diff --git a/unison-src/transcripts/api-getDefinition.md b/unison-src/transcripts/api-getDefinition.md index 251fb8b3ec..94f2341e74 100644 --- a/unison-src/transcripts/api-getDefinition.md +++ b/unison-src/transcripts/api-getDefinition.md @@ -1,54 +1,50 @@ # Get Definitions Test ```ucm:hide -scratch/main nested> builtins.mergeio +scratch/main> builtins.mergeio lib.builtins ``` ```unison:hide -{{ Documentation }} -names.x = 42 +nested.names.x.doc = {{ Documentation }} +nested.names.x = 42 ``` ```ucm:hide -scratch/main nested> add +scratch/main> add ``` ```api -- Should NOT find names by suffix -GET /api/non-project-code/getDefinition?names=x +GET /api/projects/scratch/branches/main/getDefinition?names=x -- Term names should strip relativeTo prefix. -GET /api/non-project-code/getDefinition?names=names.x&relativeTo=nested +GET /api/projects/scratch/branches/main/getDefinition?names=names.x&relativeTo=nested -- Should find definitions by hash, names should be relative -GET /api/non-project-code/getDefinition?names=%23qkhkl0n238&relativeTo=nested -``` - -```ucm:hide -scratch/main doctest> builtins.mergeio +GET /api/projects/scratch/branches/main/getDefinition?names=%23qkhkl0n238&relativeTo=nested ``` ```unison:hide -thing.doc = {{ The correct docs for the thing }} -thing = "A thing" -thingalias.doc = {{ Docs for the alias, should not be displayed }} -thingalias = "A thing" -otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} -otherstuff.thing = "A different thing" +doctest.thing.doc = {{ The correct docs for the thing }} +doctest.thing = "A thing" +doctest.thingalias.doc = {{ Docs for the alias, should not be displayed }} +doctest.thingalias = "A thing" +doctest.otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} +doctest.otherstuff.thing = "A different thing" ``` ```ucm:hide -scratch/main doctest> add +scratch/main> add ``` Only docs for the term we request should be returned, even if there are other term docs with the same suffix. ```api -GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest +GET /api/projects/scratch/branches/main/getDefinition?names=thing&relativeTo=doctest ``` If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. ```api -GET /api/non-project-code/getDefinition?names=thing.doc&relativeTo=doctest +GET /api/projects/scratch/branches/main/getDefinition?names=thing.doc&relativeTo=doctest ``` diff --git a/unison-src/transcripts/api-getDefinition.output.md b/unison-src/transcripts/api-getDefinition.output.md index 24debb744d..5e854a440c 100644 --- a/unison-src/transcripts/api-getDefinition.output.md +++ b/unison-src/transcripts/api-getDefinition.output.md @@ -1,13 +1,13 @@ # Get Definitions Test ```unison -{{ Documentation }} -names.x = 42 +nested.names.x.doc = {{ Documentation }} +nested.names.x = 42 ``` ```api -- Should NOT find names by suffix -GET /api/non-project-code/getDefinition?names=x +GET /api/projects/scratch/branches/main/getDefinition?names=x { "missingDefinitions": [ "x" @@ -16,7 +16,7 @@ GET /api/non-project-code/getDefinition?names=x "typeDefinitions": {} } -- Term names should strip relativeTo prefix. -GET /api/non-project-code/getDefinition?names=names.x&relativeTo=nested +GET /api/projects/scratch/branches/main/getDefinition?names=names.x&relativeTo=nested { "missingDefinitions": [], "termDefinitions": { @@ -104,14 +104,14 @@ GET /api/non-project-code/getDefinition?names=names.x&relativeTo=nested ] ], "termNames": [ - "names.x" + "nested.names.x" ] } }, "typeDefinitions": {} } -- Should find definitions by hash, names should be relative -GET /api/non-project-code/getDefinition?names=%23qkhkl0n238&relativeTo=nested +GET /api/projects/scratch/branches/main/getDefinition?names=%23qkhkl0n238&relativeTo=nested { "missingDefinitions": [], "termDefinitions": { @@ -199,30 +199,30 @@ GET /api/non-project-code/getDefinition?names=%23qkhkl0n238&relativeTo=nested ] ], "termNames": [ - "names.x" + "nested.names.x" ] } }, "typeDefinitions": {} } ``````unison -thing.doc = {{ The correct docs for the thing }} -thing = "A thing" -thingalias.doc = {{ Docs for the alias, should not be displayed }} -thingalias = "A thing" -otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} -otherstuff.thing = "A different thing" +doctest.thing.doc = {{ The correct docs for the thing }} +doctest.thing = "A thing" +doctest.thingalias.doc = {{ Docs for the alias, should not be displayed }} +doctest.thingalias = "A thing" +doctest.otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} +doctest.otherstuff.thing = "A different thing" ``` Only docs for the term we request should be returned, even if there are other term docs with the same suffix. ```api -GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest +GET /api/projects/scratch/branches/main/getDefinition?names=thing&relativeTo=doctest { "missingDefinitions": [], "termDefinitions": { "#jksc1s5kud95ro5ivngossullt2oavsd41s3u48bch67jf3gknru5j6hmjslonkd5sdqs8mr8k4rrnef8fodngbg4sm7u6au564ekjg": { - "bestTermName": "thing", + "bestTermName": "doctest.thing", "defnTermTag": "Plain", "signature": [ { @@ -237,10 +237,10 @@ GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest "contents": [ { "annotation": { - "contents": "thing", + "contents": "doctest.thing", "tag": "HashQualifier" }, - "segment": "thing" + "segment": "doctest.thing" }, { "annotation": { @@ -265,10 +265,10 @@ GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest }, { "annotation": { - "contents": "thing", + "contents": "doctest.thing", "tag": "HashQualifier" }, - "segment": "thing" + "segment": "doctest.thing" }, { "annotation": { @@ -291,7 +291,7 @@ GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest }, "termDocs": [ [ - "thing.doc", + "doctest.thing.doc", "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o", { "contents": [ @@ -325,8 +325,8 @@ GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest ] ], "termNames": [ - "thing", - "thingalias" + "doctest.thing", + "doctest.thingalias" ] } }, @@ -335,12 +335,12 @@ GET /api/non-project-code/getDefinition?names=thing&relativeTo=doctest ```If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. ```api -GET /api/non-project-code/getDefinition?names=thing.doc&relativeTo=doctest +GET /api/projects/scratch/branches/main/getDefinition?names=thing.doc&relativeTo=doctest { "missingDefinitions": [], "termDefinitions": { "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o": { - "bestTermName": "thing.doc", + "bestTermName": "doctest.thing.doc", "defnTermTag": "Doc", "signature": [ { @@ -355,10 +355,10 @@ GET /api/non-project-code/getDefinition?names=thing.doc&relativeTo=doctest "contents": [ { "annotation": { - "contents": "thing.doc", + "contents": "doctest.thing.doc", "tag": "HashQualifier" }, - "segment": "thing.doc" + "segment": "doctest.thing.doc" }, { "annotation": { @@ -383,10 +383,10 @@ GET /api/non-project-code/getDefinition?names=thing.doc&relativeTo=doctest }, { "annotation": { - "contents": "thing.doc", + "contents": "doctest.thing.doc", "tag": "HashQualifier" }, - "segment": "thing.doc" + "segment": "doctest.thing.doc" }, { "annotation": { @@ -467,7 +467,7 @@ GET /api/non-project-code/getDefinition?names=thing.doc&relativeTo=doctest }, "termDocs": [ [ - "thing.doc", + "doctest.thing.doc", "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o", { "contents": [ @@ -501,7 +501,7 @@ GET /api/non-project-code/getDefinition?names=thing.doc&relativeTo=doctest ] ], "termNames": [ - "thing.doc" + "doctest.thing.doc" ] } }, From e2f4c388b6acb1eb37796440b9b8e3d6b7ab470a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 25 Jun 2024 17:05:50 -0700 Subject: [PATCH 248/631] Remove loose code demo from branch --- unison-src/transcripts/branch-command.md | 13 +++----- .../transcripts/branch-command.output.md | 30 +++---------------- 2 files changed, 8 insertions(+), 35 deletions(-) diff --git a/unison-src/transcripts/branch-command.md b/unison-src/transcripts/branch-command.md index fd8ad20168..d48e3c259a 100644 --- a/unison-src/transcripts/branch-command.md +++ b/unison-src/transcripts/branch-command.md @@ -5,21 +5,21 @@ scratch/main> project.create-empty foo scratch/main> project.create-empty bar ``` -First, we'll just create a loose code namespace with a term in it for later. +First, we'll create a term to include in the branches. ```unison:hide someterm = 18 ``` ```ucm -scratch/main some.loose.code.lib> builtins.merge -scratch/main some.loose.code> add +scratch/main> builtins.merge lib.builtins +scratch/main> add ``` Now, the `branch` demo: `branch` can create a branch from a different branch in the same project, from a different branch in a different -project, or from loose code. It can also create an empty branch. +project. It can also create an empty branch. ```ucm foo/main> branch topic1 @@ -40,11 +40,6 @@ bar/main> branch foo/main topic2 bar/main> branch foo/main /topic3 scratch/main> branch foo/main bar/topic4 -scratch/main some.loose.code> branch foo/topic13 -foo/main> branch .some.loose.code topic14 -foo/main> branch .some.loose.code /topic15 -scratch/main> branch .some.loose.code foo/topic16 - foo/main> branch.empty empty1 foo/main> branch.empty /empty2 foo/main> branch.empty foo/empty3 diff --git a/unison-src/transcripts/branch-command.output.md b/unison-src/transcripts/branch-command.output.md index 2edb91bb9b..28dd680d5c 100644 --- a/unison-src/transcripts/branch-command.output.md +++ b/unison-src/transcripts/branch-command.output.md @@ -1,19 +1,17 @@ The `branch` command creates a new branch. -First, we'll just create a loose code namespace with a term in it for later. +First, we'll create a term to include in the branches. ```unison someterm = 18 ``` ```ucm - ☝️ The namespace .some.loose.code.lib is empty. - -.some.loose.code.lib> builtins.merge +scratch/main> builtins.merge lib.builtins Done. -.some.loose.code> add +scratch/main> add ⍟ I've added these definitions: @@ -23,7 +21,7 @@ someterm = 18 Now, the `branch` demo: `branch` can create a branch from a different branch in the same project, from a different branch in a different -project, or from loose code. It can also create an empty branch. +project. It can also create an empty branch. ```ucm foo/main> branch topic1 @@ -126,26 +124,6 @@ scratch/main> branch foo/main bar/topic4 Done. I've created the bar/topic4 branch based off foo/main. -.some.loose.code> branch foo/topic13 - - Done. I've created the foo/topic13 branch from the namespace - .some.loose.code. - -foo/main> branch .some.loose.code topic14 - - Done. I've created the foo/topic14 branch from the namespace - .some.loose.code. - -foo/main> branch .some.loose.code /topic15 - - Done. I've created the foo/topic15 branch from the namespace - .some.loose.code. - -scratch/main> branch .some.loose.code foo/topic16 - - Done. I've created the foo/topic16 branch from the namespace - .some.loose.code. - foo/main> branch.empty empty1 Done. I've created an empty branch foo/empty1. From 6e48ce47be896cb08f0c2d815fe20eabd117719c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 25 Jun 2024 17:10:02 -0700 Subject: [PATCH 249/631] builtins.md converted to projects --- unison-src/transcripts/builtins-merge.md | 6 +++--- unison-src/transcripts/builtins-merge.output.md | 8 +++----- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/unison-src/transcripts/builtins-merge.md b/unison-src/transcripts/builtins-merge.md index dec23f021d..942dd4b0d3 100644 --- a/unison-src/transcripts/builtins-merge.md +++ b/unison-src/transcripts/builtins-merge.md @@ -1,6 +1,6 @@ -The `builtins.merge` command adds the known builtins to a `builtin` subnamespace within the current namespace. +The `builtins.merge` command adds the known builtins to the specified subnamespace within the current namespace. ```ucm -scratch/main tmp> builtins.merge -scratch/main tmp> ls builtin +scratch/main> builtins.merge builtins +scratch/main> ls builtins ``` diff --git a/unison-src/transcripts/builtins-merge.output.md b/unison-src/transcripts/builtins-merge.output.md index 7bcf4910ec..b79bdab58d 100644 --- a/unison-src/transcripts/builtins-merge.output.md +++ b/unison-src/transcripts/builtins-merge.output.md @@ -1,13 +1,11 @@ -The `builtins.merge` command adds the known builtins to a `builtin` subnamespace within the current namespace. +The `builtins.merge` command adds the known builtins to the specified subnamespace within the current namespace. ```ucm - ☝️ The namespace .tmp is empty. - -.tmp> builtins.merge +scratch/main> builtins.merge builtins Done. -.tmp> ls builtin +scratch/main> ls builtins 1. Any (builtin type) 2. Any/ (2 terms) From fcc251de2e1e375d19c5a2e13b58cbdf3185ee0b Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 25 Jun 2024 17:10:02 -0700 Subject: [PATCH 250/631] Convert create-author.md to projects --- unison-src/transcripts/create-author.md | 4 ++-- .../transcripts/create-author.output.md | 19 +++++++++---------- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/unison-src/transcripts/create-author.md b/unison-src/transcripts/create-author.md index c8afdb0002..af06558660 100644 --- a/unison-src/transcripts/create-author.md +++ b/unison-src/transcripts/create-author.md @@ -5,6 +5,6 @@ scratch/main> builtins.mergeio Demonstrating `create.author`: ```ucm -scratch/main foo> create.author alicecoder "Alice McGee" -scratch/main foo> view 2 +scratch/main> create.author alicecoder "Alice McGee" +scratch/main> find alicecoder ``` diff --git a/unison-src/transcripts/create-author.output.md b/unison-src/transcripts/create-author.output.md index 3a5635947b..a71fca7b13 100644 --- a/unison-src/transcripts/create-author.output.md +++ b/unison-src/transcripts/create-author.output.md @@ -1,22 +1,21 @@ Demonstrating `create.author`: ```ucm - ☝️ The namespace .foo is empty. - -.foo> create.author alicecoder "Alice McGee" +scratch/main> create.author alicecoder "Alice McGee" Added definitions: - 1. metadata.authors.alicecoder : #345f3nptqq - 2. metadata.copyrightHolders.alicecoder : #pgornst1pq - 3. metadata.authors.alicecoder.guid : #hqectlr3gt + 1. metadata.authors.alicecoder : Author + 2. metadata.copyrightHolders.alicecoder : CopyrightHolder + 3. metadata.authors.alicecoder.guid : GUID Tip: Add License values for alicecoder under metadata. -.foo> view 2 +scratch/main> find alicecoder - .foo.metadata.copyrightHolders.alicecoder : CopyrightHolder - .foo.metadata.copyrightHolders.alicecoder = - CopyrightHolder alicecoder.guid "Alice McGee" + 1. metadata.authors.alicecoder : Author + 2. metadata.copyrightHolders.alicecoder : CopyrightHolder + 3. metadata.authors.alicecoder.guid : GUID + ``` From 3666e04257e57c385ce6b8999632df61e8b76fba Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 25 Jun 2024 17:15:00 -0700 Subject: [PATCH 251/631] Convert deep-names to use projects --- unison-src/transcripts/deep-names.md | 32 ++++--- unison-src/transcripts/deep-names.output.md | 94 ++++++++++++++++++--- 2 files changed, 102 insertions(+), 24 deletions(-) diff --git a/unison-src/transcripts/deep-names.md b/unison-src/transcripts/deep-names.md index aa000b578a..9d6695bc47 100644 --- a/unison-src/transcripts/deep-names.md +++ b/unison-src/transcripts/deep-names.md @@ -13,35 +13,41 @@ http.z = 8 ```ucm:hide scratch/main> add +scratch/main> branch /app1 +scratch/main> branch /app2 ``` Our `app1` project includes the text library twice and the http library twice as direct dependencies. ```ucm -.app1> fork .text lib.text_v1 -.app1> fork .text lib.text_v2 -.app1> fork .http lib.http_v3 -.app1> fork .http lib.http_v4 +scratch/app1> fork text lib.text_v1 +scratch/app1> fork text lib.text_v2 +scratch/app1> delete.namespace text +scratch/app1> fork http lib.http_v3 +scratch/app1> fork http lib.http_v4 +scratch/app1> delete.namespace http ``` As such, we see two copies of `a` and two copies of `x` via these direct dependencies. ```ucm -.app1> names a -.app1> names x +scratch/app1> names a +scratch/app1> names x ``` Our `app2` project includes the `http` library twice as direct dependencies, and once as an indirect dependency via `webutil`. It also includes the `text` library twice as indirect dependencies via `webutil` ```ucm -.app2> fork .http lib.http_v1 -.app2> fork .http lib.http_v2 -.app2> fork .text lib.webutil.lib.text_v1 -.app2> fork .text lib.webutil.lib.text_v2 -.app2> fork .http lib.webutil.lib.http +scratch/app2> fork http lib.http_v1 +scratch/app2> fork http lib.http_v2 +scratch/app2> fork text lib.webutil.lib.text_v1 +scratch/app2> fork text lib.webutil.lib.text_v2 +scratch/app2> fork http lib.webutil.lib.http +scratch/app2> delete.namespace http +scratch/app2> delete.namespace text ``` Now we see two copies of `x` via direct dependencies on `http`, and one copy of `a` via indirect dependency on `text` via `webutil`. We see neither the second indirect copy of `a` nor the indirect copy of `x` via webutil because we already have names for them. ```ucm -.app2> names a -.app2> names x +scratch/app2> names a +scratch/app2> names x ``` diff --git a/unison-src/transcripts/deep-names.output.md b/unison-src/transcripts/deep-names.output.md index 958083bc1b..833ae613a9 100644 --- a/unison-src/transcripts/deep-names.output.md +++ b/unison-src/transcripts/deep-names.output.md @@ -13,27 +13,99 @@ http.z = 8 Our `app1` project includes the text library twice and the http library twice as direct dependencies. ```ucm - ☝️ The namespace .app1 is empty. +scratch/app1> fork text lib.text_v1 -.app1> fork .text lib.text_v1 + Done. - ⚠️ - - The namespace .text doesn't exist. +scratch/app1> fork text lib.text_v2 -``` + Done. + +scratch/app1> delete.namespace text + + Done. + +scratch/app1> fork http lib.http_v3 + + Done. + +scratch/app1> fork http lib.http_v4 + + Done. + +scratch/app1> delete.namespace http + Done. + +``` +As such, we see two copies of `a` and two copies of `x` via these direct dependencies. ```ucm -.app1> fork .text lib.text_v1.app1> fork .text lib.text_v2.app1> fork .http lib.http_v3.app1> fork .http lib.http_v4 +scratch/app1> names a + + Term + Hash: #gjmq673r1v + Names: lib.text_v1.a lib.text_v2.a + + Tip: Use `names.global` to see more results. + +scratch/app1> names x + + Term + Hash: #nsmc4p1ra4 + Names: lib.http_v3.x lib.http_v4.x + + Tip: Use `names.global` to see more results. + ``` +Our `app2` project includes the `http` library twice as direct dependencies, and once as an indirect dependency via `webutil`. +It also includes the `text` library twice as indirect dependencies via `webutil` +```ucm +scratch/app2> fork http lib.http_v1 + + Done. + +scratch/app2> fork http lib.http_v2 + + Done. + +scratch/app2> fork text lib.webutil.lib.text_v1 + + Done. + +scratch/app2> fork text lib.webutil.lib.text_v2 + + Done. + +scratch/app2> fork http lib.webutil.lib.http + Done. -🛑 +scratch/app2> delete.namespace http -The transcript failed due to an error in the stanza above. The error is: + Done. +scratch/app2> delete.namespace text - ⚠️ + Done. + +``` +Now we see two copies of `x` via direct dependencies on `http`, and one copy of `a` via indirect dependency on `text` via `webutil`. +We see neither the second indirect copy of `a` nor the indirect copy of `x` via webutil because we already have names for them. +```ucm +scratch/app2> names a + + Term + Hash: #gjmq673r1v + Names: lib.webutil.lib.text_v1.a - The namespace .text doesn't exist. + Tip: Use `names.global` to see more results. +scratch/app2> names x + + Term + Hash: #nsmc4p1ra4 + Names: lib.http_v1.x lib.http_v2.x + + Tip: Use `names.global` to see more results. + +``` From e1b00d9c58af8f0806613258145557adad52b182 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 26 Jun 2024 11:23:04 -0400 Subject: [PATCH 252/631] rename `alias.term.force` to `debug.alias.term.force` --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 8 +++++--- unison-src/transcripts/alias-term.md | 4 ++-- unison-src/transcripts/alias-term.output.md | 4 ++-- 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 7f5bc46dc6..918340010b 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1410,14 +1410,16 @@ aliasTerm = aliasTermForce :: InputPattern aliasTermForce = InputPattern - { patternName = "alias.term.force", + { patternName = "debug.alias.term.force", aliases = [], visibility = I.Hidden, args = [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)], - help = "`alias.term.force foo bar` introduces `bar` with the same definition as `foo`.", + help = "`debug.alias.term.force foo bar` introduces `bar` with the same definition as `foo`.", parse = \case [oldName, newName] -> Input.AliasTermI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName - _ -> Left . warn $ P.wrap "`alias.term.force` takes two arguments, like `alias.term.force oldname newname`." + _ -> + Left . warn $ + P.wrap "`debug.alias.term.force` takes two arguments, like `debug.alias.term.force oldname newname`." } aliasType :: InputPattern diff --git a/unison-src/transcripts/alias-term.md b/unison-src/transcripts/alias-term.md index cd4f7454ae..1e1bb95ec6 100644 --- a/unison-src/transcripts/alias-term.md +++ b/unison-src/transcripts/alias-term.md @@ -19,9 +19,9 @@ project/main> alias.term lib.builtins.todo foo project/main> ls ``` -You can use `alias.term.force` for that. +You can use `debug.alias.term.force` for that. ```ucm -project/main> alias.term.force lib.builtins.todo foo +project/main> debug.alias.term.force lib.builtins.todo foo project/main> ls ``` diff --git a/unison-src/transcripts/alias-term.output.md b/unison-src/transcripts/alias-term.output.md index 733ff13849..d072506cb0 100644 --- a/unison-src/transcripts/alias-term.output.md +++ b/unison-src/transcripts/alias-term.output.md @@ -28,10 +28,10 @@ project/main> ls 2. lib/ (643 terms, 92 types) ``` -You can use `alias.term.force` for that. +You can use `debug.alias.term.force` for that. ```ucm -project/main> alias.term.force lib.builtins.todo foo +project/main> debug.alias.term.force lib.builtins.todo foo Done. From 267bfdf248960e5151c530895eb76414d9b9278f Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 26 Jun 2024 11:26:37 -0400 Subject: [PATCH 253/631] remove fix2000.md --- unison-src/transcripts/fix2000.md | 44 ------ unison-src/transcripts/fix2000.output.md | 188 ----------------------- 2 files changed, 232 deletions(-) delete mode 100644 unison-src/transcripts/fix2000.md delete mode 100644 unison-src/transcripts/fix2000.output.md diff --git a/unison-src/transcripts/fix2000.md b/unison-src/transcripts/fix2000.md deleted file mode 100644 index 812ec10df0..0000000000 --- a/unison-src/transcripts/fix2000.md +++ /dev/null @@ -1,44 +0,0 @@ -Checks that squash and merge do the same thing, with nontrivial history that -includes a merge conflict. - -```ucm:hide -.> builtins.merge -``` - -```unison -x.a.p = "af" -x.a.q = "ef" -``` - -```ucm -.> add -.> fork x y -.> fork x s -.> fork x m -.> delete.verbose y.a.p -``` - -```unison -y.a.p = "fij" -``` - -```ucm -.> add -``` - -```unison -y.b.p = "wie" -``` - -Merge back into the ancestor. - -```ucm -.> add -.> merge.old y.b y.a -.> delete.term.verbose 1 -.> merge.old y m -.> merge.old.squash y s -.s> todo -.m> todo -``` - diff --git a/unison-src/transcripts/fix2000.output.md b/unison-src/transcripts/fix2000.output.md deleted file mode 100644 index cd388f7e55..0000000000 --- a/unison-src/transcripts/fix2000.output.md +++ /dev/null @@ -1,188 +0,0 @@ -Checks that squash and merge do the same thing, with nontrivial history that -includes a merge conflict. - -```unison -x.a.p = "af" -x.a.q = "ef" -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - x.a.p : Text - x.a.q : Text - -``` -```ucm -.> add - - ⍟ I've added these definitions: - - x.a.p : Text - x.a.q : Text - -.> fork x y - - Done. - -.> fork x s - - Done. - -.> fork x m - - Done. - -.> delete.verbose y.a.p - - Name changes: - - Original Changes - 1. m.a.p ┐ 2. y.a.p (removed) - 3. s.a.p │ - 4. x.a.p │ - 5. y.a.p ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -```unison -y.a.p = "fij" -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - y.a.p : Text - -``` -```ucm -.> add - - ⍟ I've added these definitions: - - y.a.p : Text - -``` -```unison -y.b.p = "wie" -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - y.b.p : Text - -``` -Merge back into the ancestor. - -```ucm -.> add - - ⍟ I've added these definitions: - - y.b.p : Text - -.> merge.old y.b y.a - - Here's what's changed in y.a after the merge: - - New name conflicts: - - 1. p#l2mmpgn323 : Text - ↓ - 2. ┌ p#l2mmpgn323 : Text - 3. └ p#nm3omrdks9 : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> delete.term.verbose 1 - - Resolved name conflicts: - - 1. ┌ y.a.p#l2mmpgn323 : Text - 2. └ y.a.p#nm3omrdks9 : Text - ↓ - 3. y.a.p#nm3omrdks9 : Text - - Tip: You can use `undo` or `reflog` to undo this change. - -.> merge.old y m - - Here's what's changed in m after the merge: - - Updates: - - 1. a.p : Text - ↓ - 2. a.p : Text - - Added definitions: - - 3. ┌ a.p : Text - 4. └ b.p : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> merge.old.squash y s - - Here's what's changed in s after the merge: - - Updates: - - 1. a.p : Text - ↓ - 2. a.p : Text - - Added definitions: - - 3. ┌ a.p : Text - 4. └ b.p : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.s> todo - - - -.m> todo - - - -``` From 13558c91e8f27e68fa7c098ef39625b1b265ba5d Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 26 Jun 2024 11:30:39 -0400 Subject: [PATCH 254/631] delete fix2004.md --- unison-src/transcripts/fix2004.md | 82 ------- unison-src/transcripts/fix2004.output.md | 267 ----------------------- 2 files changed, 349 deletions(-) delete mode 100644 unison-src/transcripts/fix2004.md delete mode 100644 unison-src/transcripts/fix2004.output.md diff --git a/unison-src/transcripts/fix2004.md b/unison-src/transcripts/fix2004.md deleted file mode 100644 index ab33da9e7f..0000000000 --- a/unison-src/transcripts/fix2004.md +++ /dev/null @@ -1,82 +0,0 @@ - -```ucm:hide -.> builtins.merge -``` - -Here's the scenario that can produce bad empty namespace LCAs: - -``` - deletes of v4 -j1: ... - v1 - v2 - v3 - v4 - v4a - v5 - v6 - v7 - / - - v5a - - adds of unrelated -j2: ... - v1 - v2 - v3 - v4 - x0 - x1 - x2 - x3 - / - - z1 - -``` - -So `j1` and `j2` have common history up through `v4`, then `j1` deletes some definitions while `j2` adds some definitions via shallow merges. These shallow merges then result in the LCA being the empty namespace rather than `v4`. - -First, we create some common history before a fork: - -```ucm -.> alias.term builtin.Nat.+ a.delete1 -.> alias.term builtin.Nat.* a.delete2 -.> alias.term builtin.Nat.drop a.delete3 -.> alias.type builtin.Nat a.Delete4 -``` - -Now we fork `a2` off of `a`. `a` continues on, deleting the terms it added previously and then adding one unrelated term via a merge with little history. It's this short history merge which will become a bad LCA of the empty namespace. - -```ucm -.> fork a a2 -.> delete.term.verbose a.delete1 -.> delete.term.verbose a.delete2 -.> delete.term.verbose a.delete3 -.> delete.type.verbose a.Delete4 -.> alias.term .builtin.Float.+ newbranchA.dontDelete -.> merge.old newbranchA a -.a> find -``` - -Meanwhile, `a2` adds some other unrelated terms, some via merging in namespaces with little history. When merging `a2` back into `a`, the deletes from their common history should be respected. - -```ucm -.> alias.term builtin.Text.take a2.keep1 -.> alias.term builtin.Text.take a2.keep2 -.> alias.term builtin.Text.take a2.keep3 -.> alias.term builtin.Text.take a2.keep4 -.> alias.term builtin.Text.take a2.keep5 -.> alias.term builtin.Text.take newbranchA2.keep6 -.> merge.old newbranchA2 a2 -.a2> find -``` - -```ucm -.> fork a asquash -.> merge.old a2 a -.> merge.old.squash a2 asquash -``` - -At this point, all the things that `a` has deleted (`delete1`, `delete2`, etc) should be deleted in both the merged and squashed results. Let's verify this: - -```ucm -.a> find -.asquash> find -``` - -```ucm:hide -.> view a.keep1 a.keep2 a.keep3 -.> view asquash.keep1 asquash.keep2 asquash.keep3 -``` - -```ucm:error -.> view a.Delete4 -``` - -```ucm:error -.> view asquash.delete1 -``` diff --git a/unison-src/transcripts/fix2004.output.md b/unison-src/transcripts/fix2004.output.md deleted file mode 100644 index c8216d5e89..0000000000 --- a/unison-src/transcripts/fix2004.output.md +++ /dev/null @@ -1,267 +0,0 @@ - -Here's the scenario that can produce bad empty namespace LCAs: - -```deletes -of v4 -j1: ... - v1 - v2 - v3 - v4 - v4a - v5 - v6 - v7 - / - - v5a - - adds of unrelated -j2: ... - v1 - v2 - v3 - v4 - x0 - x1 - x2 - x3 - / - - z1 - - -``` - -So `j1` and `j2` have common history up through `v4`, then `j1` deletes some definitions while `j2` adds some definitions via shallow merges. These shallow merges then result in the LCA being the empty namespace rather than `v4`. - -First, we create some common history before a fork: - -```ucm -.> alias.term builtin.Nat.+ a.delete1 - - Done. - -.> alias.term builtin.Nat.* a.delete2 - - Done. - -.> alias.term builtin.Nat.drop a.delete3 - - Done. - -.> alias.type builtin.Nat a.Delete4 - - Done. - -``` -Now we fork `a2` off of `a`. `a` continues on, deleting the terms it added previously and then adding one unrelated term via a merge with little history. It's this short history merge which will become a bad LCA of the empty namespace. - -```ucm -.> fork a a2 - - Done. - -.> delete.term.verbose a.delete1 - - Name changes: - - Original Changes - 1. a.delete1 ┐ 2. a.delete1 (removed) - 3. a2.delete1 │ - 4. builtin.Nat.+ ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.> delete.term.verbose a.delete2 - - Name changes: - - Original Changes - 1. a.delete2 ┐ 2. a.delete2 (removed) - 3. a2.delete2 │ - 4. builtin.Nat.* ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.> delete.term.verbose a.delete3 - - Name changes: - - Original Changes - 1. a.delete3 ┐ 2. a.delete3 (removed) - 3. a2.delete3 │ - 4. builtin.Nat.drop ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.> delete.type.verbose a.Delete4 - - Name changes: - - Original Changes - 1. a.Delete4 ┐ 2. a.Delete4 (removed) - 3. a2.Delete4 │ - 4. builtin.Nat ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.> alias.term .builtin.Float.+ newbranchA.dontDelete - - Done. - -.> merge.old newbranchA a - - Here's what's changed in a after the merge: - - Added definitions: - - 1. dontDelete : Float -> Float -> Float - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.a> find - - 1. dontDelete : ##Float -> ##Float -> ##Float - - -``` -Meanwhile, `a2` adds some other unrelated terms, some via merging in namespaces with little history. When merging `a2` back into `a`, the deletes from their common history should be respected. - -```ucm -.> alias.term builtin.Text.take a2.keep1 - - Done. - -.> alias.term builtin.Text.take a2.keep2 - - Done. - -.> alias.term builtin.Text.take a2.keep3 - - Done. - -.> alias.term builtin.Text.take a2.keep4 - - Done. - -.> alias.term builtin.Text.take a2.keep5 - - Done. - -.> alias.term builtin.Text.take newbranchA2.keep6 - - Done. - -.> merge.old newbranchA2 a2 - - Here's what's changed in a2 after the merge: - - Name changes: - - Original Changes - 1. keep1 ┐ 2. keep6 (added) - 3. keep2 │ - 4. keep3 │ - 5. keep4 │ - 6. keep5 ┘ - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.a2> find - - 1. delete1 : Delete4 -> Delete4 -> Delete4 - 2. delete2 : Delete4 -> Delete4 -> Delete4 - 3. delete3 : Delete4 -> Delete4 -> Delete4 - 4. builtin type Delete4 - 5. keep1 : Delete4 -> ##Text -> ##Text - 6. keep2 : Delete4 -> ##Text -> ##Text - 7. keep3 : Delete4 -> ##Text -> ##Text - 8. keep4 : Delete4 -> ##Text -> ##Text - 9. keep5 : Delete4 -> ##Text -> ##Text - 10. keep6 : Delete4 -> ##Text -> ##Text - - -``` -```ucm -.> fork a asquash - - Done. - -.> merge.old a2 a - - Here's what's changed in a after the merge: - - Added definitions: - - 1. ┌ keep1 : Delete4 -> Text -> Text - 2. │ keep2 : Delete4 -> Text -> Text - 3. │ keep3 : Delete4 -> Text -> Text - 4. │ keep4 : Delete4 -> Text -> Text - 5. │ keep5 : Delete4 -> Text -> Text - 6. └ keep6 : Delete4 -> Text -> Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> merge.old.squash a2 asquash - - Here's what's changed in asquash after the merge: - - Added definitions: - - 1. ┌ keep1 : Delete4 -> Text -> Text - 2. │ keep2 : Delete4 -> Text -> Text - 3. │ keep3 : Delete4 -> Text -> Text - 4. │ keep4 : Delete4 -> Text -> Text - 5. │ keep5 : Delete4 -> Text -> Text - 6. └ keep6 : Delete4 -> Text -> Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` -At this point, all the things that `a` has deleted (`delete1`, `delete2`, etc) should be deleted in both the merged and squashed results. Let's verify this: - -```ucm -.a> find - - 1. dontDelete : ##Float -> ##Float -> ##Float - 2. keep1 : ##Nat -> ##Text -> ##Text - 3. keep2 : ##Nat -> ##Text -> ##Text - 4. keep3 : ##Nat -> ##Text -> ##Text - 5. keep4 : ##Nat -> ##Text -> ##Text - 6. keep5 : ##Nat -> ##Text -> ##Text - 7. keep6 : ##Nat -> ##Text -> ##Text - - -.asquash> find - - 1. dontDelete : ##Float -> ##Float -> ##Float - 2. keep1 : ##Nat -> ##Text -> ##Text - 3. keep2 : ##Nat -> ##Text -> ##Text - 4. keep3 : ##Nat -> ##Text -> ##Text - 5. keep4 : ##Nat -> ##Text -> ##Text - 6. keep5 : ##Nat -> ##Text -> ##Text - 7. keep6 : ##Nat -> ##Text -> ##Text - - -``` -```ucm -.> view a.Delete4 - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - a.Delete4 - -``` -```ucm -.> view asquash.delete1 - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - asquash.delete1 - -``` From 93fc35e2c773b378e4bb5640da51b588a2a02996 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 26 Jun 2024 11:32:06 -0400 Subject: [PATCH 255/631] delete child-namespace-history-merge.md --- .../child-namespace-history-merge.md | 99 ------ .../child-namespace-history-merge.output.md | 302 ------------------ 2 files changed, 401 deletions(-) delete mode 100644 unison-src/transcripts/child-namespace-history-merge.md delete mode 100644 unison-src/transcripts/child-namespace-history-merge.output.md diff --git a/unison-src/transcripts/child-namespace-history-merge.md b/unison-src/transcripts/child-namespace-history-merge.md deleted file mode 100644 index 6ed0e2400e..0000000000 --- a/unison-src/transcripts/child-namespace-history-merge.md +++ /dev/null @@ -1,99 +0,0 @@ -# Behaviour of namespace histories during a merge. - -Note: This is a descriptive test meant to capture the current behaviour of -branch histories during a merge. -It isn't prescriptive about how merges _should_ work with respect to child branches, -but I think we should at least notice if we change things by accident. - - -## Setting up some history - -```ucm:hide -.> builtins.merge -``` - -```unison:hide -parent.top = "top" -parent.child.thing = "parent.child.thing" -``` - -The child branch has a single history node representing the addition of `parent.child.thing`. - -```ucm -.> add -.> history parent.child -``` - -If we add another thing to the child namespace it should add another history node to both the child and parent. - -```unison:hide -parent.child.thing2 = "parent.child.thing2" -``` - -```ucm -.> add -.> history parent -.> history parent.child -``` - -## Forking off some history on a separate branch - -Now we fork the parent namespace to make some changes. - -```ucm -.> fork parent parent_fork -``` - -```unison:hide -parent_fork.child.thing3 = "parent_fork.child.thing3" -``` - -The child should have a new history node after adding `thing3` - -```ucm -.> add -.> history parent_fork.child -``` - -## Saving our parent state - -Split off two separate forks, one for testing squash merges, one for standard merges. - -```ucm:hide -.> fork parent parent_squash_base -.> fork parent parent_merge_base -``` - -## Squash merge - -For a squash merge, when I squash-merge back into parent, we expect `parent_fork.child.thing3` to be added. - -```ucm -.> merge.old.squash parent_fork parent_squash_base -.> history parent_squash_base -``` - -Notice that with the current behaviour, the history of `parent.child` is completely wiped out, containing nothing from the source OR destination. - -```ucm -.> history parent.child -.> history parent_fork.child -.> history parent_squash_base.child -``` - -## Standard merge - -For a standard merge, if I merge back into parent, we expect `parent_fork.child.thing3` to be added. - -```ucm -.> merge.old parent_fork parent_merge_base -.> history parent_merge_base -``` - -Child histories should also be *merged*. - -```ucm -.> history parent.child -.> history parent_fork.child -.> history parent_merge_base.child -``` diff --git a/unison-src/transcripts/child-namespace-history-merge.output.md b/unison-src/transcripts/child-namespace-history-merge.output.md deleted file mode 100644 index 18e080e093..0000000000 --- a/unison-src/transcripts/child-namespace-history-merge.output.md +++ /dev/null @@ -1,302 +0,0 @@ -# Behaviour of namespace histories during a merge. - -Note: This is a descriptive test meant to capture the current behaviour of -branch histories during a merge. -It isn't prescriptive about how merges _should_ work with respect to child branches, -but I think we should at least notice if we change things by accident. - - -## Setting up some history - -```unison -parent.top = "top" -parent.child.thing = "parent.child.thing" -``` - -The child branch has a single history node representing the addition of `parent.child.thing`. - -```ucm -.> add - - ⍟ I've added these definitions: - - parent.child.thing : Text - parent.top : Text - -.> history parent.child - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #0r73mam57g (start of history) - -``` -If we add another thing to the child namespace it should add another history node to both the child and parent. - -```unison -parent.child.thing2 = "parent.child.thing2" -``` - -```ucm -.> add - - ⍟ I've added these definitions: - - parent.child.thing2 : Text - -.> history parent - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #2hv7t9lp40 - - + Adds / updates: - - child.thing2 - - □ 2. #i9lji1bli0 (start of history) - -.> history parent.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 2. #0r73mam57g (start of history) - -``` -## Forking off some history on a separate branch - -Now we fork the parent namespace to make some changes. - -```ucm -.> fork parent parent_fork - - Done. - -``` -```unison -parent_fork.child.thing3 = "parent_fork.child.thing3" -``` - -The child should have a new history node after adding `thing3` - -```ucm -.> add - - ⍟ I've added these definitions: - - parent_fork.child.thing3 : Text - -.> history parent_fork.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #9rcfgbsp81 - - + Adds / updates: - - thing3 - - ⊙ 2. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 3. #0r73mam57g (start of history) - -``` -## Saving our parent state - -Split off two separate forks, one for testing squash merges, one for standard merges. - -## Squash merge - -For a squash merge, when I squash-merge back into parent, we expect `parent_fork.child.thing3` to be added. - -```ucm -.> merge.old.squash parent_fork parent_squash_base - - Here's what's changed in parent_squash_base after the merge: - - Added definitions: - - 1. child.thing3 : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history parent_squash_base - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #594e0e1p39 - - + Adds / updates: - - child.thing3 - - ⊙ 2. #2hv7t9lp40 - - + Adds / updates: - - child.thing2 - - □ 3. #i9lji1bli0 (start of history) - -``` -Notice that with the current behaviour, the history of `parent.child` is completely wiped out, containing nothing from the source OR destination. - -```ucm -.> history parent.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 2. #0r73mam57g (start of history) - -.> history parent_fork.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #9rcfgbsp81 - - + Adds / updates: - - thing3 - - ⊙ 2. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 3. #0r73mam57g (start of history) - -.> history parent_squash_base.child - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #19fd4mhpp4 (start of history) - -``` -## Standard merge - -For a standard merge, if I merge back into parent, we expect `parent_fork.child.thing3` to be added. - -```ucm -.> merge.old parent_fork parent_merge_base - - Here's what's changed in parent_merge_base after the merge: - - Added definitions: - - 1. child.thing3 : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history parent_merge_base - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #mtn8sha7gd - - + Adds / updates: - - child.thing3 - - ⊙ 2. #2hv7t9lp40 - - + Adds / updates: - - child.thing2 - - □ 3. #i9lji1bli0 (start of history) - -``` -Child histories should also be *merged*. - -```ucm -.> history parent.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 2. #0r73mam57g (start of history) - -.> history parent_fork.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #9rcfgbsp81 - - + Adds / updates: - - thing3 - - ⊙ 2. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 3. #0r73mam57g (start of history) - -.> history parent_merge_base.child - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #9rcfgbsp81 - - + Adds / updates: - - thing3 - - ⊙ 2. #ggnrs01131 - - + Adds / updates: - - thing2 - - □ 3. #0r73mam57g (start of history) - -``` From 3556cb6ec8d226eb9dd5a8585d0f7d2be372dd46 Mon Sep 17 00:00:00 2001 From: etorreborre Date: Wed, 26 Jun 2024 17:34:45 +0200 Subject: [PATCH 256/631] fix: fix the textual representation of an ordinal number --- parser-typechecker/src/Unison/PrintError.hs | 9 +------- parser-typechecker/src/Unison/Util/Text.hs | 20 ++++++++++++++++ .../tests/Unison/Test/Util/Text.hs | 23 ++++++++++++++++++- 3 files changed, 43 insertions(+), 9 deletions(-) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index d6e50ebbb5..16ea2dc881 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -75,6 +75,7 @@ import Unison.Util.Monoid (intercalateMap) import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pr import Unison.Util.Range (Range (..), startingLine) +import Unison.Util.Text (ordinal) import Unison.Var (Var) import Unison.Var qualified as Var @@ -831,14 +832,6 @@ renderTypeError e env src = case e of let sz = length wrongs pl a b = if sz == 1 then a else b in mconcat [txt pl, intercalateMap "\n" (renderSuggestion env) wrongs] - ordinal :: (IsString s) => Int -> s - ordinal n = - fromString $ - show n ++ case last (show n) of - '1' -> "st" - '2' -> "nd" - '3' -> "rd" - _ -> "th" debugNoteLoc a = if Settings.debugNoteLoc then a else mempty debugSummary :: C.ErrorNote v loc -> Pretty ColorText debugSummary note = diff --git a/parser-typechecker/src/Unison/Util/Text.hs b/parser-typechecker/src/Unison/Util/Text.hs index 2c5bdf3c5b..16947d41f7 100644 --- a/parser-typechecker/src/Unison/Util/Text.hs +++ b/parser-typechecker/src/Unison/Util/Text.hs @@ -6,6 +6,7 @@ module Unison.Util.Text where import Data.Foldable (toList) import Data.List (foldl', unfoldr) +import Data.List qualified as L import Data.String (IsString (..)) import Data.Text qualified as T import Data.Text.Encoding qualified as T @@ -131,6 +132,25 @@ indexOf needle haystack = needle' = toLazyText needle haystack' = toLazyText haystack +-- | Return the ordinal representation of a number in English. +-- A number ending with '1' must finish with 'st' +-- A number ending with '2' must finish with 'nd' +-- A number ending with '3' must finish with 'rd' +-- _except_ for 11, 12, and 13 which must finish with 'th' +ordinal :: (IsString s) => Int -> s +ordinal n = do + let s = show n + fromString $ s ++ + case L.drop (L.length s - 2) s of + ['1', '1'] -> "th" + ['1', '2'] -> "th" + ['1', '3'] -> "th" + _ -> case last s of + '1' -> "st" + '2' -> "nd" + '3' -> "rd" + _ -> "th" + -- Drop with both a maximum size and a predicate. Yields actual number of -- dropped characters. -- diff --git a/parser-typechecker/tests/Unison/Test/Util/Text.hs b/parser-typechecker/tests/Unison/Test/Util/Text.hs index e5e13e9d55..083e042868 100644 --- a/parser-typechecker/tests/Unison/Test/Util/Text.hs +++ b/parser-typechecker/tests/Unison/Test/Util/Text.hs @@ -178,7 +178,28 @@ test = ) (P.Join [P.Capture (P.Literal "zzzaaa"), P.Capture (P.Literal "!")]) in P.run p "zzzaaa!!!" - ok + ok, + scope "ordinal" do + expectEqual (Text.ordinal 1) ("1st" :: String) + expectEqual (Text.ordinal 2) ("2nd" :: String) + expectEqual (Text.ordinal 3) ("3rd" :: String) + expectEqual (Text.ordinal 4) ("4th" :: String) + expectEqual (Text.ordinal 5) ("5th" :: String) + expectEqual (Text.ordinal 10) ("10th" :: String) + expectEqual (Text.ordinal 11) ("11th" :: String) + expectEqual (Text.ordinal 12) ("12th" :: String) + expectEqual (Text.ordinal 13) ("13th" :: String) + expectEqual (Text.ordinal 14) ("14th" :: String) + expectEqual (Text.ordinal 21) ("21st" :: String) + expectEqual (Text.ordinal 22) ("22nd" :: String) + expectEqual (Text.ordinal 23) ("23rd" :: String) + expectEqual (Text.ordinal 24) ("24th" :: String) + expectEqual (Text.ordinal 111) ("111th" :: String) + expectEqual (Text.ordinal 112) ("112th" :: String) + expectEqual (Text.ordinal 113) ("113th" :: String) + expectEqual (Text.ordinal 121) ("121st" :: String) + expectEqual (Text.ordinal 122) ("122nd" :: String) + expectEqual (Text.ordinal 123) ("123rd" :: String) ] where log2 :: Int -> Int From 596cb39b2e3936704d1ab7e480b6b32647df2005 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 26 Jun 2024 12:13:18 -0400 Subject: [PATCH 257/631] port empty namespace merge test to new merge --- unison-src/transcripts/diff-namespace.md | 2 ++ unison-src/transcripts/empty-namespaces.md | 8 -------- .../transcripts/empty-namespaces.output.md | 20 ------------------- unison-src/transcripts/merge.md | 11 ++++++++++ unison-src/transcripts/merge.output.md | 17 ++++++++++++++++ 5 files changed, 30 insertions(+), 28 deletions(-) diff --git a/unison-src/transcripts/diff-namespace.md b/unison-src/transcripts/diff-namespace.md index 5e938a79a5..7db0bc898a 100644 --- a/unison-src/transcripts/diff-namespace.md +++ b/unison-src/transcripts/diff-namespace.md @@ -12,9 +12,11 @@ x = 23 .> fork b1 b2 .b2> alias.term x abc ``` + ```unison:hide fslkdjflskdjflksjdf = 663 ``` + ```ucm .b0> add .> merge.old b0 b1 diff --git a/unison-src/transcripts/empty-namespaces.md b/unison-src/transcripts/empty-namespaces.md index 223ab34ba9..d9497fc931 100644 --- a/unison-src/transcripts/empty-namespaces.md +++ b/unison-src/transcripts/empty-namespaces.md @@ -28,14 +28,6 @@ The history of the namespace should be empty. .> history mynamespace ``` -Merging an empty namespace should be a no-op - -```ucm:error -.empty> history -.empty> merge.old .mynamespace -.empty> history -``` - Add and then delete a term to add some history to a deleted namespace. ```unison:hide diff --git a/unison-src/transcripts/empty-namespaces.output.md b/unison-src/transcripts/empty-namespaces.output.md index 16d33046e1..7fb5de89ed 100644 --- a/unison-src/transcripts/empty-namespaces.output.md +++ b/unison-src/transcripts/empty-namespaces.output.md @@ -54,26 +54,6 @@ The history of the namespace should be empty. ☝️ The namespace .mynamespace is empty. -``` -Merging an empty namespace should be a no-op - -```ucm - ☝️ The namespace .empty is empty. - -.empty> history - - ☝️ The namespace .empty is empty. - -.empty> merge.old .mynamespace - - ⚠️ - - The namespace .mynamespace doesn't exist. - -.empty> history - - ☝️ The namespace .empty is empty. - ``` Add and then delete a term to add some history to a deleted namespace. diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index debe548c5b..d38895ce80 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -456,6 +456,17 @@ project/alice> merge /bob .> project.delete project ``` +## No-op merge: merge empty namespace into empty namespace + +```ucm +project/main> branch topic +project/main> merge /topic +``` + +```ucm:hide +.> project.delete project +``` + ## Merge failure: someone deleted something If either Alice or Bob delete something, so long as the other person didn't update it (in which case we ignore the delete, as explained above), then the delete goes through. diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index e2b7672de3..7e91d92c87 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -469,6 +469,23 @@ project/alice> merge /bob I fast-forward merged project/bob into project/alice. +``` +## No-op merge: merge empty namespace into empty namespace + +```ucm +project/main> branch topic + + Done. I've created the topic branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic`. + +project/main> merge /topic + + 😶 + + project/main was already up-to-date with project/topic. + ``` ## Merge failure: someone deleted something From 25d505e78440f30b2bbf99a1f5cb59795eccc87d Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 26 Jun 2024 12:24:00 -0400 Subject: [PATCH 258/631] port mergeloop.md over to use new merge --- unison-src/transcripts/merge.md | 51 +++++++ unison-src/transcripts/merge.output.md | 148 +++++++++++++++++++ unison-src/transcripts/mergeloop.md | 51 ------- unison-src/transcripts/mergeloop.output.md | 157 --------------------- 4 files changed, 199 insertions(+), 208 deletions(-) delete mode 100644 unison-src/transcripts/mergeloop.md delete mode 100644 unison-src/transcripts/mergeloop.output.md diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index d38895ce80..d2f1105a2f 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -1594,3 +1594,54 @@ But `bar` was put into the scratch file instead. ```ucm:hide .> project.delete project ``` + +### Merge loop test + +This tests for regressions of https://github.com/unisonweb/unison/issues/1276 where trivial merges cause loops in the +history. + +Let's make three identical namespaces with different histories: + +```unison +a = 1 +``` + +```ucm +project/alice> add +``` + +```unison +b = 2 +``` + +```ucm +project/alice> add +``` + +```unison +b = 2 +``` + +```ucm +project/bob> add +``` + +```unison +a = 1 +``` + +```ucm +project/bob> add +``` + +```unison +a = 1 +b = 2 +``` + +```ucm +project/carol> add +project/bob> merge /alice +project/carol> merge /bob +project/carol> history +``` diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 7e91d92c87..258413502d 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1973,3 +1973,151 @@ bar = But `bar` was put into the scratch file instead. +### Merge loop test + +This tests for regressions of https://github.com/unisonweb/unison/issues/1276 where trivial merges cause loops in the +history. + +Let's make three identical namespaces with different histories: + +```unison +a = 1 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + a : ##Nat + +``` +```ucm +project/alice> add + + ⍟ I've added these definitions: + + a : ##Nat + +``` +```unison +b = 2 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + b : ##Nat + +``` +```ucm +project/alice> add + + ⍟ I've added these definitions: + + b : ##Nat + +``` +```unison +b = 2 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. + +``` +```ucm +project/bob> add + + ⍟ I've added these definitions: + + b : ##Nat + +``` +```unison +a = 1 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + a : ##Nat + +``` +```ucm +project/bob> add + + ⍟ I've added these definitions: + + a : ##Nat + +``` +```unison +a = 1 +b = 2 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. + +``` +```ucm +project/carol> add + + ⍟ I've added these definitions: + + a : ##Nat + b : ##Nat + +project/bob> merge /alice + + I merged project/alice into project/bob. + +project/carol> merge /bob + + I merged project/bob into project/carol. + +project/carol> history + + Note: The most recent namespace hash is immediately below this + message. + + + + This segment of history starts with a merge. Use + `history #som3n4m3space` to view history starting from a given + namespace hash. + + ⊙ 1. #b7fr6ifj87 + ⑃ + 2. #9npggauqo9 + 3. #dm4u1eokg1 + +``` diff --git a/unison-src/transcripts/mergeloop.md b/unison-src/transcripts/mergeloop.md deleted file mode 100644 index fd1b25fa8e..0000000000 --- a/unison-src/transcripts/mergeloop.md +++ /dev/null @@ -1,51 +0,0 @@ -# Merge loop test - -This tests for regressions of https://github.com/unisonweb/unison/issues/1276 where trivial merges cause loops in the history. - -Let's make three identical namespaces with different histories: - -```unison -a = 1 -``` - -```ucm -.x> add -``` - -```unison -b = 2 -``` - -```ucm -.x> add -``` - -```unison -b = 2 -``` - -```ucm -.y> add -``` - -```unison -a = 1 -``` - -```ucm -.y> add -``` - -```unison -a = 1 -b = 2 -``` - -```ucm -.z> add -.> merge.old x y -.> merge.old y z -.> history z -``` - - diff --git a/unison-src/transcripts/mergeloop.output.md b/unison-src/transcripts/mergeloop.output.md deleted file mode 100644 index faa084764b..0000000000 --- a/unison-src/transcripts/mergeloop.output.md +++ /dev/null @@ -1,157 +0,0 @@ -# Merge loop test - -This tests for regressions of https://github.com/unisonweb/unison/issues/1276 where trivial merges cause loops in the history. - -Let's make three identical namespaces with different histories: - -```unison -a = 1 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - a : ##Nat - -``` -```ucm - ☝️ The namespace .x is empty. - -.x> add - - ⍟ I've added these definitions: - - a : ##Nat - -``` -```unison -b = 2 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - b : ##Nat - -``` -```ucm -.x> add - - ⍟ I've added these definitions: - - b : ##Nat - -``` -```unison -b = 2 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked the definitions in scratch.u. This - file has been previously added to the codebase. - -``` -```ucm - ☝️ The namespace .y is empty. - -.y> add - - ⍟ I've added these definitions: - - b : ##Nat - -``` -```unison -a = 1 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - a : ##Nat - -``` -```ucm -.y> add - - ⍟ I've added these definitions: - - a : ##Nat - -``` -```unison -a = 1 -b = 2 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked the definitions in scratch.u. This - file has been previously added to the codebase. - -``` -```ucm - ☝️ The namespace .z is empty. - -.z> add - - ⍟ I've added these definitions: - - a : ##Nat - b : ##Nat - -.> merge.old x y - - Nothing changed as a result of the merge. - - Applying changes from patch... - -.> merge.old y z - - Nothing changed as a result of the merge. - - Applying changes from patch... - -.> history z - - Note: The most recent namespace hash is immediately below this - message. - - - - This segment of history starts with a merge. Use - `history #som3n4m3space` to view history starting from a given - namespace hash. - - ⊙ 1. #b7fr6ifj87 - ⑃ - 2. #9npggauqo9 - 3. #dm4u1eokg1 - -``` From 19da19b2597f41253b8d08b23c68c408071dc119 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 26 Jun 2024 12:25:24 -0400 Subject: [PATCH 259/631] delete merges.md --- unison-src/transcripts/merges.md | 121 --------- unison-src/transcripts/merges.output.md | 312 ------------------------ 2 files changed, 433 deletions(-) delete mode 100644 unison-src/transcripts/merges.md delete mode 100644 unison-src/transcripts/merges.output.md diff --git a/unison-src/transcripts/merges.md b/unison-src/transcripts/merges.md deleted file mode 100644 index 330e46857b..0000000000 --- a/unison-src/transcripts/merges.md +++ /dev/null @@ -1,121 +0,0 @@ -# Forking and merging namespaces in `ucm` - -```ucm:hide -.master> builtins.merge -``` - -The Unison namespace is a versioned tree of names that map to Unison definitions. You can change this namespace and fork and merge subtrees of it. Let's start by introducing a few definitions into a new namespace, `foo`: - -```unison -x = 42 -``` - -```ucm -.> add -``` - -Let's move `x` into a new namespace, `master`: - -```ucm -.> rename.term x master.x -``` - -If you want to do some experimental work in a namespace without disturbing anyone else, you can `fork` it (which is a shorthand for `copy.namespace`). This creates a copy of it, preserving its history. - -> __Note:__ these copies are very efficient to create as they just have pointers into the same underlying definitions. Create as many as you like. - -Let's go ahead and do this: - -``` -.> fork master feature1 -.> view master.x -.> view feature1.x -``` - -Great! We can now do some further work in the `feature1` branch, then merge it back into `master` when we're ready. - -```unison -y = "hello" -``` - -```ucm -.feature1> add -.master> merge.old .feature1 -.master> view y -``` - -> Note: `merge src`, with one argument, merges `src` into the current namespace. You can also do `merge src dest` to merge into any destination namespace. - -Notice that `master` now has the definition of `y` we wrote. - -We can also delete the fork if we're done with it. (Don't worry, even though the history at that path is now empty, -it's still in the `history` of the parent namespace and can be resurrected at any time.) - -```ucm -.> delete.namespace feature1 -.> history .feature1 -.> history -``` - -To resurrect an old version of a namespace, you can learn its hash via the `history` command, then use `fork #namespacehash .newname`. - -## Concurrent edits and merges - -In the above scenario the destination namespace (`master`) was strictly behind the source namespace, so the merge didn't have anything interesting to do (Git would call this a "fast forward" merge). In other cases, the source and destination namespaces will each have changes the other doesn't know about, and the merge needs to something more interesting. That's okay too, and Unison will merge those results, using a 3-way merge algorithm. - -> __Note:__ When merging nested namespaces, Unison actually uses a recursive 3-way merge, so it finds a different (and possibly closer) common ancestor at each level of the tree. - -Let's see how this works. We are going to create a copy of `master`, add and delete some definitions in `master` and in the fork, then merge. - -```ucm -.> fork master feature2 -``` - -Here's one fork, we add `z` and delete `x`: - -```unison -z = 99 -``` - -```ucm -.feature2> add -.feature2> delete.term.verbose x -``` - -And here's the other fork, where we update `y` and add a new definition, `frobnicate`: - -```unison -master.y = "updated y" -master.frobnicate n = n + 1 -``` - -```ucm -.> update -.> view master.y -.> view master.frobnicate -``` - -At this point, `master` and `feature2` both have some changes the other doesn't know about. Let's merge them. - -```ucm -.> merge.old feature2 master -``` - -Notice that `x` is deleted in the merged branch (it was deleted in `feature2` and untouched by `master`): - -```ucm:error -.> view master.x -``` - -And notice that `y` has the most recent value, and that `z` and `frobnicate` both exist as well: - -```ucm -.> view master.y -.> view master.z -.> view master.frobnicate -``` - -## FAQ - -* What happens if namespace1 deletes a name that namespace2 has updated? A: ??? -* ... diff --git a/unison-src/transcripts/merges.output.md b/unison-src/transcripts/merges.output.md deleted file mode 100644 index 8bfbb170fb..0000000000 --- a/unison-src/transcripts/merges.output.md +++ /dev/null @@ -1,312 +0,0 @@ -# Forking and merging namespaces in `ucm` - -The Unison namespace is a versioned tree of names that map to Unison definitions. You can change this namespace and fork and merge subtrees of it. Let's start by introducing a few definitions into a new namespace, `foo`: - -```unison -x = 42 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - x : Nat - -``` -```ucm -.> add - - ⍟ I've added these definitions: - - x : Nat - -``` -Let's move `x` into a new namespace, `master`: - -```ucm -.> rename.term x master.x - - Done. - -``` -If you want to do some experimental work in a namespace without disturbing anyone else, you can `fork` it (which is a shorthand for `copy.namespace`). This creates a copy of it, preserving its history. - -> __Note:__ these copies are very efficient to create as they just have pointers into the same underlying definitions. Create as many as you like. - -Let's go ahead and do this: - -``` -.> fork master feature1 -.> view master.x -.> view feature1.x - -``` - -Great! We can now do some further work in the `feature1` branch, then merge it back into `master` when we're ready. - -```unison -y = "hello" -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - y : Text - -``` -```ucm - ☝️ The namespace .feature1 is empty. - -.feature1> add - - ⍟ I've added these definitions: - - y : ##Text - -.master> merge.old .feature1 - - Here's what's changed in the current namespace after the - merge: - - Added definitions: - - 1. y : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.master> view y - - y : Text - y = "hello" - -``` -> Note: `merge src`, with one argument, merges `src` into the current namespace. You can also do `merge src dest` to merge into any destination namespace. - -Notice that `master` now has the definition of `y` we wrote. - -We can also delete the fork if we're done with it. (Don't worry, even though the history at that path is now empty, -it's still in the `history` of the parent namespace and can be resurrected at any time.) - -```ucm -.> delete.namespace feature1 - - Done. - -.> history .feature1 - - ☝️ The namespace .feature1 is empty. - -.> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #6j9omad7mv - - - Deletes: - - feature1.y - - ⊙ 2. #59u4sdgodu - - + Adds / updates: - - master.y - - = Copies: - - Original name New name(s) - feature1.y master.y - - ⊙ 3. #0je96at36h - - + Adds / updates: - - feature1.y - - ⊙ 4. #cnv4gjntbl - - > Moves: - - Original name New name - x master.x - - ⊙ 5. #tp0bn8ulih - - + Adds / updates: - - x - - □ 6. #cujaete914 (start of history) - -``` -To resurrect an old version of a namespace, you can learn its hash via the `history` command, then use `fork #namespacehash .newname`. - -## Concurrent edits and merges - -In the above scenario the destination namespace (`master`) was strictly behind the source namespace, so the merge didn't have anything interesting to do (Git would call this a "fast forward" merge). In other cases, the source and destination namespaces will each have changes the other doesn't know about, and the merge needs to something more interesting. That's okay too, and Unison will merge those results, using a 3-way merge algorithm. - -> __Note:__ When merging nested namespaces, Unison actually uses a recursive 3-way merge, so it finds a different (and possibly closer) common ancestor at each level of the tree. - -Let's see how this works. We are going to create a copy of `master`, add and delete some definitions in `master` and in the fork, then merge. - -```ucm -.> fork master feature2 - - Done. - -``` -Here's one fork, we add `z` and delete `x`: - -```unison -z = 99 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - z : Nat - -``` -```ucm -.feature2> add - - ⍟ I've added these definitions: - - z : Nat - -.feature2> delete.term.verbose x - - Removed definitions: - - 1. x : Nat - - Tip: You can use `undo` or `reflog` to undo this change. - -``` -And here's the other fork, where we update `y` and add a new definition, `frobnicate`: - -```unison -master.y = "updated y" -master.frobnicate n = n + 1 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - master.frobnicate : Nat -> Nat - master.y : Text - -``` -```ucm -.> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -.> view master.y - - master.y : Text - master.y = "updated y" - -.> view master.frobnicate - - master.frobnicate : Nat -> Nat - master.frobnicate n = - use Nat + - n + 1 - -``` -At this point, `master` and `feature2` both have some changes the other doesn't know about. Let's merge them. - -```ucm -.> merge.old feature2 master - - Here's what's changed in master after the merge: - - Added definitions: - - 1. z : Nat - - Removed definitions: - - 2. x : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` -Notice that `x` is deleted in the merged branch (it was deleted in `feature2` and untouched by `master`): - -```ucm -.> view master.x - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - master.x - -``` -And notice that `y` has the most recent value, and that `z` and `frobnicate` both exist as well: - -```ucm -.> view master.y - - master.y : Text - master.y = "updated y" - -.> view master.z - - master.z : Nat - master.z = 99 - -.> view master.frobnicate - - master.frobnicate : Nat -> Nat - master.frobnicate n = - use Nat + - n + 1 - -``` -## FAQ - -* What happens if namespace1 deletes a name that namespace2 has updated? A: ??? -* ... From c5f4d6d5b7dff2e5ced8f9a1d0419a3a8c6a2518 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 26 Jun 2024 12:26:14 -0400 Subject: [PATCH 260/631] delete project-merge.md --- unison-src/transcripts/project-merge.md | 39 ---- .../transcripts/project-merge.output.md | 193 ------------------ 2 files changed, 232 deletions(-) delete mode 100644 unison-src/transcripts/project-merge.md delete mode 100644 unison-src/transcripts/project-merge.output.md diff --git a/unison-src/transcripts/project-merge.md b/unison-src/transcripts/project-merge.md deleted file mode 100644 index d18fd89cfd..0000000000 --- a/unison-src/transcripts/project-merge.md +++ /dev/null @@ -1,39 +0,0 @@ -# projects merge - -```ucm -.> builtins.merge -``` - -```unison -zonk = 0 -``` - -```ucm -.foo> add -.> project.create-empty foo -.> merge.old foo foo/main -``` - -```unison -bonk = 2 -``` - -```ucm -foo/main> add -``` - -```ucm -.> project.create-empty bar -bar/main> merge.old foo/main -bar/main> branch /topic -``` - -```unison -xonk = 1 -``` - -```ucm -bar/main> add -bar/topic> merge.old /main -.bar> merge.old foo/main -``` diff --git a/unison-src/transcripts/project-merge.output.md b/unison-src/transcripts/project-merge.output.md deleted file mode 100644 index 98f20e79d7..0000000000 --- a/unison-src/transcripts/project-merge.output.md +++ /dev/null @@ -1,193 +0,0 @@ -# projects merge - -```ucm -.> builtins.merge - - Done. - -``` -```unison -zonk = 0 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - zonk : Nat - -``` -```ucm - ☝️ The namespace .foo is empty. - -.foo> add - - ⍟ I've added these definitions: - - zonk : ##Nat - -.> project.create-empty foo - - 🎉 I've created the project foo. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - -.> merge.old foo foo/main - - Here's what's changed in foo/main after the merge: - - Added definitions: - - 1. zonk : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` -```unison -bonk = 2 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - bonk : Nat - -``` -```ucm -foo/main> add - - ⍟ I've added these definitions: - - bonk : ##Nat - -``` -```ucm -.> project.create-empty bar - - 🎉 I've created the project bar. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - -bar/main> merge.old foo/main - - Here's what's changed in the current namespace after the - merge: - - Added definitions: - - 1. bonk : ##Nat - 2. zonk : ##Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -bar/main> branch /topic - - Done. I've created the topic branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic`. - -``` -```unison -xonk = 1 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - xonk : ##Nat - -``` -```ucm -bar/main> add - - ⍟ I've added these definitions: - - xonk : ##Nat - -bar/topic> merge.old /main - - Here's what's changed in the current namespace after the - merge: - - Added definitions: - - 1. xonk : ##Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - - ☝️ The namespace .bar is empty. - -.bar> merge.old foo/main - - Here's what's changed in the current namespace after the - merge: - - Added definitions: - - 1. bonk : ##Nat - 2. zonk : ##Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -``` From 94580cc2185e04b90855a67631670cad940221b6 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 26 Jun 2024 12:27:49 -0400 Subject: [PATCH 261/631] delete squash.md --- unison-src/transcripts/squash.md | 157 ------- unison-src/transcripts/squash.output.md | 529 ------------------------ 2 files changed, 686 deletions(-) delete mode 100644 unison-src/transcripts/squash.md delete mode 100644 unison-src/transcripts/squash.output.md diff --git a/unison-src/transcripts/squash.md b/unison-src/transcripts/squash.md deleted file mode 100644 index f3b010944a..0000000000 --- a/unison-src/transcripts/squash.md +++ /dev/null @@ -1,157 +0,0 @@ - -```ucm:hide -.> builtins.merge -``` - -# Squash merges - -`squash src dest` merges can be used to merge from `src` to `dest`, discarding the history of `src`. It's useful when the source namespace history is irrelevant or has a bunch of churn you wish to discard. Often when merging small pull requests, you'll use a squash merge. - -Let's look at some examples. We'll start with a namespace with just the builtins. Let's take a look at the hash of this namespace: - -```ucm -.> history builtin -.> fork builtin builtin2 -``` - -(We make a copy of `builtin` for use later in this transcript.) - -Now suppose we `fork` a copy of builtin, then rename `Nat.+` to `frobnicate`, then rename it back. Notice this produces multiple entries in the history: - -```ucm -.> fork builtin mybuiltin -.mybuiltin> rename.term Nat.+ Nat.frobnicate -.mybuiltin> rename.term Nat.frobnicate Nat.+ -.mybuiltin> history -``` - -If we merge that back into `builtin`, we get that same chain of history: - -```ucm -.> merge.old mybuiltin builtin -.> history builtin -``` - -Let's try again, but using a `merge.squash` (or just `squash`) instead. The history will be unchanged: - -```ucm -.> merge.old.squash mybuiltin builtin2 -.> history builtin2 -``` - -The churn that happened in `mybuiltin` namespace ended up back in the same spot, so the squash merge of that namespace with our original namespace had no effect. - -## Another example - -Let's look at a more interesting example, where the two namespaces have diverged a bit. Here's our starting namespace: - -```unison:hide -x = 1 -``` - -```ucm -.trunk> add -.> fork trunk alice -.> fork trunk bob -``` - -Alice now does some hacking: - -```unison:hide -radNumber = 348 -bodaciousNumero = 2394 -neatoFun x = x -``` - -```ucm -.alice> add -.alice> rename.term radNumber superRadNumber -.alice> rename.term neatoFun productionReadyId -``` - -Meanwhile, Bob does his own hacking: - -```unison:hide -whatIsLove = "?" -babyDon'tHurtMe = ".. Don't hurt me..." -no more = no more -``` - -```ucm -.bob> add -``` - -At this point, Alice and Bob both have some history beyond what's in trunk: - -```ucm -.> history trunk -.> history alice -.> history bob -``` - -Alice then squash merges into `trunk`, as does Bob. It's as if Alice and Bob both made their changes in one single commit. - -```ucm -.> merge.old.squash alice trunk -.> history trunk -.> merge.old.squash bob trunk -.> history trunk -``` - -Since squash merges don't produce any merge nodes, we can `undo` a couple times to get back to our starting state: - -```ucm -.> undo -.> undo -.> history trunk -``` - -This time, we'll first squash Alice and Bob's changes together before squashing their combined changes into `trunk`. The resulting `trunk` will have just a single entry in it, combining both Alice and Bob's changes: - -```ucm -.> merge.old.squash alice bob -.> merge.old.squash bob trunk -.> history trunk -``` - -So, there you have it. With squashing, you can control the granularity of your history. - -## Throwing out all history - -Another thing we can do is `squash` into an empty namespace. This effectively makes a copy of the namespace, but without any of its history: - -```ucm -.> merge.old.squash alice nohistoryalice -.> history nohistoryalice -``` - -There's nothing really special here, `squash src dest` discards `src` history that comes after the LCA of `src` and `dest`, it's just that in the case of an empty namespace, that LCA is the beginning of time (the empty namespace), so all the history of `src` is discarded. - -## Checking for handling of deletes - -This checks to see that squashing correctly preserves deletions: - -```ucm -.delete> builtins.merge -.delete> fork builtin builtin2 -.delete> delete.term.verbose builtin2.Nat.+ -.delete> delete.term.verbose builtin2.Nat.* -.delete> merge.old.squash builtin2 builtin -.delete> history builtin -``` - -Notice that `Nat.+` and `Nat.*` are deleted by the squash, and we see them deleted in one atomic step in the history. - -Just confirming that those two definitions are in fact removed: - -```ucm:error -.delete> view .delete.builtin.Nat.+ -``` - -```ucm:error -.delete> view .delete.builtin.Nat.* -``` - -## Caveats - -If you `squash mystuff trunk`, you're discarding any history of `mystuff` and just cons'ing onto the history of `trunk`. Thus, don't expect to be able to `merge trunk mystuff` later and get great results. Squashing should only be used when you don't care about the history (and you know others haven't pulled and built on your line of history being discarded, so they don't care about the history either). diff --git a/unison-src/transcripts/squash.output.md b/unison-src/transcripts/squash.output.md deleted file mode 100644 index 3698fdfe6a..0000000000 --- a/unison-src/transcripts/squash.output.md +++ /dev/null @@ -1,529 +0,0 @@ - -# Squash merges - -`squash src dest` merges can be used to merge from `src` to `dest`, discarding the history of `src`. It's useful when the source namespace history is irrelevant or has a bunch of churn you wish to discard. Often when merging small pull requests, you'll use a squash merge. - -Let's look at some examples. We'll start with a namespace with just the builtins. Let's take a look at the hash of this namespace: - -```ucm -.> history builtin - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #i3vp9o9btm (start of history) - -.> fork builtin builtin2 - - Done. - -``` -(We make a copy of `builtin` for use later in this transcript.) - -Now suppose we `fork` a copy of builtin, then rename `Nat.+` to `frobnicate`, then rename it back. Notice this produces multiple entries in the history: - -```ucm -.> fork builtin mybuiltin - - Done. - -.mybuiltin> rename.term Nat.+ Nat.frobnicate - - Done. - -.mybuiltin> rename.term Nat.frobnicate Nat.+ - - Done. - -.mybuiltin> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #tpkjb488ei - - > Moves: - - Original name New name - Nat.frobnicate Nat.+ - - ⊙ 2. #334ak3epqt - - > Moves: - - Original name New name - Nat.+ Nat.frobnicate - - □ 3. #i3vp9o9btm (start of history) - -``` -If we merge that back into `builtin`, we get that same chain of history: - -```ucm -.> merge.old mybuiltin builtin - - Nothing changed as a result of the merge. - - Applying changes from patch... - -.> history builtin - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #tpkjb488ei - - > Moves: - - Original name New name - Nat.frobnicate Nat.+ - - ⊙ 2. #334ak3epqt - - > Moves: - - Original name New name - Nat.+ Nat.frobnicate - - □ 3. #i3vp9o9btm (start of history) - -``` -Let's try again, but using a `merge.squash` (or just `squash`) instead. The history will be unchanged: - -```ucm -.> merge.old.squash mybuiltin builtin2 - - Nothing changed as a result of the merge. - - 😶 - - builtin2 was already up-to-date with mybuiltin. - -.> history builtin2 - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #i3vp9o9btm (start of history) - -``` -The churn that happened in `mybuiltin` namespace ended up back in the same spot, so the squash merge of that namespace with our original namespace had no effect. - -## Another example - -Let's look at a more interesting example, where the two namespaces have diverged a bit. Here's our starting namespace: - -```unison -x = 1 -``` - -```ucm - ☝️ The namespace .trunk is empty. - -.trunk> add - - ⍟ I've added these definitions: - - x : ##Nat - -.> fork trunk alice - - Done. - -.> fork trunk bob - - Done. - -``` -Alice now does some hacking: - -```unison -radNumber = 348 -bodaciousNumero = 2394 -neatoFun x = x -``` - -```ucm -.alice> add - - ⍟ I've added these definitions: - - bodaciousNumero : ##Nat - neatoFun : x -> x - radNumber : ##Nat - -.alice> rename.term radNumber superRadNumber - - Done. - -.alice> rename.term neatoFun productionReadyId - - Done. - -``` -Meanwhile, Bob does his own hacking: - -```unison -whatIsLove = "?" -babyDon'tHurtMe = ".. Don't hurt me..." -no more = no more -``` - -```ucm -.bob> add - - ⍟ I've added these definitions: - - babyDon'tHurtMe : ##Text - no : more -> r - whatIsLove : ##Text - -``` -At this point, Alice and Bob both have some history beyond what's in trunk: - -```ucm -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #i52j9fd57b (start of history) - -.> history alice - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #e9jd55555o - - > Moves: - - Original name New name - neatoFun productionReadyId - - ⊙ 2. #l5ocoo2eac - - > Moves: - - Original name New name - radNumber superRadNumber - - ⊙ 3. #i1vq05628n - - + Adds / updates: - - bodaciousNumero neatoFun radNumber - - □ 4. #i52j9fd57b (start of history) - -.> history bob - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #brr4400742 - - + Adds / updates: - - babyDon'tHurtMe no whatIsLove - - □ 2. #i52j9fd57b (start of history) - -``` -Alice then squash merges into `trunk`, as does Bob. It's as if Alice and Bob both made their changes in one single commit. - -```ucm -.> merge.old.squash alice trunk - - Here's what's changed in trunk after the merge: - - Added definitions: - - 1. bodaciousNumero : Nat - 2. productionReadyId : x -> x - 3. superRadNumber : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #f9lvm9gd2k - - + Adds / updates: - - bodaciousNumero productionReadyId superRadNumber - - □ 2. #i52j9fd57b (start of history) - -.> merge.old.squash bob trunk - - Here's what's changed in trunk after the merge: - - Added definitions: - - 1. babyDon'tHurtMe : Text - 2. no : more -> r - 3. whatIsLove : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #dbp78ts6q3 - - + Adds / updates: - - babyDon'tHurtMe no whatIsLove - - ⊙ 2. #f9lvm9gd2k - - + Adds / updates: - - bodaciousNumero productionReadyId superRadNumber - - □ 3. #i52j9fd57b (start of history) - -``` -Since squash merges don't produce any merge nodes, we can `undo` a couple times to get back to our starting state: - -```ucm -.> undo - - Here are the changes I undid - - Name changes: - - Original Changes - 1. bob.babyDon'tHurtMe 2. trunk.babyDon'tHurtMe (added) - - 3. bob.no 4. trunk.no (added) - - 5. bob.whatIsLove 6. trunk.whatIsLove (added) - -.> undo - - Here are the changes I undid - - Name changes: - - Original Changes - 1. alice.bodaciousNumero 2. trunk.bodaciousNumero (added) - - 3. alice.productionReadyId 4. trunk.productionReadyId (added) - - 5. alice.superRadNumber 6. trunk.superRadNumber (added) - -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #i52j9fd57b (start of history) - -``` -This time, we'll first squash Alice and Bob's changes together before squashing their combined changes into `trunk`. The resulting `trunk` will have just a single entry in it, combining both Alice and Bob's changes: - -```ucm -.> merge.old.squash alice bob - - Here's what's changed in bob after the merge: - - Added definitions: - - 1. bodaciousNumero : Nat - 2. productionReadyId : x -> x - 3. superRadNumber : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> merge.old.squash bob trunk - - Here's what's changed in trunk after the merge: - - Added definitions: - - 1. babyDon'tHurtMe : Text - 2. bodaciousNumero : Nat - 3. no : more -> r - 4. productionReadyId : x -> x - 5. superRadNumber : Nat - 6. whatIsLove : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history trunk - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #qtotqgds4i - - + Adds / updates: - - babyDon'tHurtMe bodaciousNumero no productionReadyId - superRadNumber whatIsLove - - □ 2. #i52j9fd57b (start of history) - -``` -So, there you have it. With squashing, you can control the granularity of your history. - -## Throwing out all history - -Another thing we can do is `squash` into an empty namespace. This effectively makes a copy of the namespace, but without any of its history: - -```ucm -.> merge.old.squash alice nohistoryalice - - Here's what's changed in nohistoryalice after the merge: - - Added definitions: - - 1. bodaciousNumero : Nat - 2. productionReadyId : x -> x - 3. superRadNumber : Nat - 4. x : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.> history nohistoryalice - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #1d9haupn3d (start of history) - -``` -There's nothing really special here, `squash src dest` discards `src` history that comes after the LCA of `src` and `dest`, it's just that in the case of an empty namespace, that LCA is the beginning of time (the empty namespace), so all the history of `src` is discarded. - -## Checking for handling of deletes - -This checks to see that squashing correctly preserves deletions: - -```ucm - ☝️ The namespace .delete is empty. - -.delete> builtins.merge - - Done. - -.delete> fork builtin builtin2 - - Done. - -.delete> delete.term.verbose builtin2.Nat.+ - - Name changes: - - Original Changes - 1. builtin.Nat.+ ┐ 2. builtin2.Nat.+ (removed) - 3. builtin2.Nat.+ ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.delete> delete.term.verbose builtin2.Nat.* - - Name changes: - - Original Changes - 1. builtin.Nat.* ┐ 2. builtin2.Nat.* (removed) - 3. builtin2.Nat.* ┘ - - Tip: You can use `undo` or `reflog` to undo this change. - -.delete> merge.old.squash builtin2 builtin - - Here's what's changed in builtin after the merge: - - Removed definitions: - - 1. Nat.* : Nat -> Nat -> Nat - 2. Nat.+ : Nat -> Nat -> Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - -.delete> history builtin - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #dv00hf6vmg - - - Deletes: - - Nat.* Nat.+ - - □ 2. #i3vp9o9btm (start of history) - -``` -Notice that `Nat.+` and `Nat.*` are deleted by the squash, and we see them deleted in one atomic step in the history. - -Just confirming that those two definitions are in fact removed: - -```ucm -.delete> view .delete.builtin.Nat.+ - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - .delete.builtin.Nat.+ - -``` -```ucm -.delete> view .delete.builtin.Nat.* - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - .delete.builtin.Nat.* - -``` -## Caveats - -If you `squash mystuff trunk`, you're discarding any history of `mystuff` and just cons'ing onto the history of `trunk`. Thus, don't expect to be able to `merge trunk mystuff later and get great results. Squashing should only be used when you don't care about the history (and you know others haven't pulled and built on your line of history being discarded, so they don't care about the history either). From 2fd585e1d32d80e1dd25f55da830fbe6971a0431 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 25 Jun 2024 17:30:45 -0700 Subject: [PATCH 262/631] Port doc1 transcript to projects --- unison-src/transcripts/doc1.md | 12 +- unison-src/transcripts/doc1.output.md | 151 ++++++++++++++++++++++++-- 2 files changed, 147 insertions(+), 16 deletions(-) diff --git a/unison-src/transcripts/doc1.md b/unison-src/transcripts/doc1.md index 1288d9d3f4..6f8459395c 100644 --- a/unison-src/transcripts/doc1.md +++ b/unison-src/transcripts/doc1.md @@ -1,13 +1,13 @@ # Documenting Unison code ```ucm:hide -scratch/main> builtins.merge +scratch/main> builtins.merge lib.builtins ``` Unison documentation is written in Unison. Documentation is a value of the following type: ```ucm -scratch/main builtin> view Doc +scratch/main> view lib.builtins.Doc ``` You can create these `Doc` values with ordinary code, or you can use the special syntax. A value of structural type `Doc` can be created via syntax like: @@ -42,7 +42,7 @@ List.take.ex2 = take 2 [1,2,3,4,5] ``` ```ucm -scratch/main builtin> add +scratch/main> add ``` And now let's write our docs and reference these examples: @@ -67,17 +67,17 @@ List.take.doc = [: Let's add it to the codebase. ```ucm -scratch/main builtin> add +scratch/main> add ``` We can view it with `docs`, which shows the `Doc` value that is associated with a definition. ```ucm -scratch/main builtin> docs List.take +scratch/main> docs List.take ``` Note that if we view the source of the documentation, the various references are *not* expanded. ```ucm -scratch/main builtin> view List.take +scratch/main> view List.take ``` diff --git a/unison-src/transcripts/doc1.output.md b/unison-src/transcripts/doc1.output.md index 7f4b406469..563932e2bc 100644 --- a/unison-src/transcripts/doc1.output.md +++ b/unison-src/transcripts/doc1.output.md @@ -3,26 +3,157 @@ Unison documentation is written in Unison. Documentation is a value of the following type: ```ucm - ☝️ The namespace .builtin is empty. +scratch/main> view lib.builtins.Doc -.builtin> view Doc + type lib.builtins.Doc + = Blob Text + | Link Link + | Source Link + | Signature Term + | Evaluate Term + | Join [lib.builtins.Doc] - ⚠️ +``` +You can create these `Doc` values with ordinary code, or you can use the special syntax. A value of structural type `Doc` can be created via syntax like: + +```unison +doc1 = [: This is some documentation. + +It can span multiple lines. + +Can link to definitions like @List.drop or @List + +:] +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + doc1 : Doc + +``` +Syntax: + +`[:` starts a documentation block; `:]` finishes it. Within the block: + +* Links to definitions are done with `@List`. `\@` (and `\:]`) if you want to escape. +* `@[signature] List.take` expands to the type signature of `List.take` +* `@[source] List.map` expands to the full source of `List.map` +* `@[include] someOtherDoc`, inserts a value `someOtherDoc : Doc` here. +* `@[evaluate] someDefinition` expands to the result of evaluating `someDefinition`, which must be a pre-existing definition in the codebase (can't be an arbitrary expression). + +### An example + +We are going to document `List.take` using some verbiage and a few examples. First we have to add the examples to the codebase: + +```unison +List.take.ex1 = take 0 [1,2,3,4,5] +List.take.ex2 = take 2 [1,2,3,4,5] +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + List.take.ex1 : [Nat] + List.take.ex2 : [Nat] + +``` +```ucm +scratch/main> add + + ⍟ I've added these definitions: - The following names were not found in the codebase. Check your spelling. - Doc + List.take.ex1 : [Nat] + List.take.ex2 : [Nat] + +``` +And now let's write our docs and reference these examples: + +```unison +List.take.doc = [: +`@List.take n xs` returns the first `n` elements of `xs`. (No need to add line breaks manually. The display command will do wrapping of text for you. Indent any lines where you don't want it to do this.) + +## Examples: + + @[source] List.take.ex1 + 🔽 + @List.take.ex1 = @[evaluate] List.take.ex1 + + @[source] List.take.ex2 + 🔽 + @List.take.ex2 = @[evaluate] List.take.ex2 +:] ``` +```ucm + Loading changes detected in scratch.u. -🛑 + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + List.take.doc : Doc -The transcript failed due to an error in the stanza above. The error is: +``` +Let's add it to the codebase. +```ucm +scratch/main> add - ⚠️ + ⍟ I've added these definitions: - The following names were not found in the codebase. Check your spelling. - Doc + List.take.doc : Doc +``` +We can view it with `docs`, which shows the `Doc` value that is associated with a definition. + +```ucm +scratch/main> docs List.take + + `List.take n xs` returns the first `n` elements of `xs`. (No + need to add line breaks manually. The display command will do + wrapping of text for you. Indent any lines where you don't + want it to do this.) + + ## Examples: + + List.take.ex1 : [Nat] + List.take.ex1 = List.take 0 [1, 2, 3, 4, 5] + 🔽 + ex1 = [] + + + List.take.ex2 : [Nat] + List.take.ex2 = List.take 2 [1, 2, 3, 4, 5] + 🔽 + ex2 = [1, 2] + + +``` +Note that if we view the source of the documentation, the various references are *not* expanded. + +```ucm +scratch/main> view List.take + + builtin lib.builtins.List.take : + lib.builtins.Nat -> [a] -> [a] + +``` From 6a1ccd5a64335410759ba614d1c10468014843cf Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 10:58:27 -0700 Subject: [PATCH 263/631] Port empty-namespaces to projects --- unison-src/transcripts/empty-namespaces.md | 6 +++--- unison-src/transcripts/empty-namespaces.output.md | 14 ++++++-------- 2 files changed, 9 insertions(+), 11 deletions(-) diff --git a/unison-src/transcripts/empty-namespaces.md b/unison-src/transcripts/empty-namespaces.md index ef17ad2363..b992593973 100644 --- a/unison-src/transcripts/empty-namespaces.md +++ b/unison-src/transcripts/empty-namespaces.md @@ -31,9 +31,9 @@ scratch/main> history mynamespace Merging an empty namespace should be a no-op ```ucm:error -scratch/main empty> history -scratch/main empty> merge.old .mynamespace -scratch/main empty> history +scratch/main> history empty +scratch/main> merge.old empty .mynamespace +scratch/main> history empty ``` Add and then delete a term to add some history to a deleted namespace. diff --git a/unison-src/transcripts/empty-namespaces.output.md b/unison-src/transcripts/empty-namespaces.output.md index 092bebe1ee..2b53a52de8 100644 --- a/unison-src/transcripts/empty-namespaces.output.md +++ b/unison-src/transcripts/empty-namespaces.output.md @@ -58,21 +58,19 @@ scratch/main> history mynamespace Merging an empty namespace should be a no-op ```ucm - ☝️ The namespace .empty is empty. +scratch/main> history empty -.empty> history + ☝️ The namespace empty is empty. - ☝️ The namespace .empty is empty. - -.empty> merge.old .mynamespace +scratch/main> merge.old empty .mynamespace ⚠️ - The namespace .mynamespace doesn't exist. + The namespace empty doesn't exist. -.empty> history +scratch/main> history empty - ☝️ The namespace .empty is empty. + ☝️ The namespace empty is empty. ``` Add and then delete a term to add some history to a deleted namespace. From a92885a8bd990c0c7477207daa3c058c6ecaef07 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:01:11 -0700 Subject: [PATCH 264/631] Port emptyCodebase transcript to projects --- unison-src/transcripts/emptyCodebase.md | 8 ++++---- unison-src/transcripts/emptyCodebase.output.md | 15 +++++++-------- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/unison-src/transcripts/emptyCodebase.md b/unison-src/transcripts/emptyCodebase.md index 4aefd0dfda..03b4e44e9e 100644 --- a/unison-src/transcripts/emptyCodebase.md +++ b/unison-src/transcripts/emptyCodebase.md @@ -13,15 +13,15 @@ scratch/main> ls Technically, the definitions all exist, but they have no names. `builtins.merge` brings them into existence, under the current namespace: ```ucm -scratch/main foo> builtins.merge -scratch/main foo> ls +scratch/main> builtins.merge lib.builtins +scratch/main> ls lib ``` And for a limited time, you can get even more builtin goodies: ```ucm -scratch/main foo> builtins.mergeio -scratch/main foo> ls +scratch/main> builtins.mergeio lib.builtinsio +scratch/main> ls lib ``` More typically, you'd start out by pulling `base`. diff --git a/unison-src/transcripts/emptyCodebase.output.md b/unison-src/transcripts/emptyCodebase.output.md index efa0854ec0..bbb762a284 100644 --- a/unison-src/transcripts/emptyCodebase.output.md +++ b/unison-src/transcripts/emptyCodebase.output.md @@ -15,27 +15,26 @@ scratch/main> ls Technically, the definitions all exist, but they have no names. `builtins.merge` brings them into existence, under the current namespace: ```ucm - ☝️ The namespace .foo is empty. - -.foo> builtins.merge +scratch/main> builtins.merge lib.builtins Done. -.foo> ls +scratch/main> ls lib - 1. builtin/ (469 terms, 74 types) + 1. builtins/ (469 terms, 74 types) ``` And for a limited time, you can get even more builtin goodies: ```ucm -.foo> builtins.mergeio +scratch/main> builtins.mergeio lib.builtinsio Done. -.foo> ls +scratch/main> ls lib - 1. builtin/ (643 terms, 92 types) + 1. builtins/ (469 terms, 74 types) + 2. builtinsio/ (643 terms, 92 types) ``` More typically, you'd start out by pulling `base. From f71008b6a28151a7c9ce6979a357d72de4d6f9e6 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:03:22 -0700 Subject: [PATCH 265/631] Port find-command to projects --- unison-src/transcripts/find-command.md | 10 +++--- unison-src/transcripts/find-command.output.md | 31 +++++++++++-------- 2 files changed, 22 insertions(+), 19 deletions(-) diff --git a/unison-src/transcripts/find-command.md b/unison-src/transcripts/find-command.md index d4da9f237b..019903556a 100644 --- a/unison-src/transcripts/find-command.md +++ b/unison-src/transcripts/find-command.md @@ -1,6 +1,5 @@ ```ucm:hide -scratch/main> builtins.merge -scratch/main> move builtin lib.builtin +scratch/main> builtins.merge lib.builtin ``` ```unison:hide @@ -31,13 +30,12 @@ scratch/main> find-in.all cat foo scratch/main> view 1 ``` -```ucm -scratch/main somewhere> find bar -scratch/main somewhere> find.global bar -``` +Finding within a namespace ```ucm scratch/main> find bar +-- Shows UUIDs +-- scratch/main> find.global bar scratch/main> find-in somewhere bar ``` diff --git a/unison-src/transcripts/find-command.output.md b/unison-src/transcripts/find-command.output.md index 2b7ffcf65b..f75da189b8 100644 --- a/unison-src/transcripts/find-command.output.md +++ b/unison-src/transcripts/find-command.output.md @@ -57,10 +57,24 @@ scratch/main> view 1 cat.lib.foo = 5 ``` +Finding within a namespace + ```ucm - ☝️ The namespace .somewhere is empty. +scratch/main> find bar + + 1. somewhere.bar : Nat + -.somewhere> find bar +-- Shows UUIDs +-- scratch/main> find.global bar +scratch/main> find-in somewhere bar + + 1. bar : Nat + + +``` +```ucm +scratch/main> find baz ☝️ @@ -76,22 +90,13 @@ scratch/main> view 1 namespace. ``` - ```ucm -.somewhere> find bar.somewhere> find.global bar -``` - - -🛑 - -The transcript failed due to an error in the stanza above. The error is: - +scratch/main> find.global notHere 😶 No results. Check your spelling, or try using tab completion to supply command arguments. - `find.global` can be used to search outside the current - namespace. +``` From f3503cca97ba63162353a3ecdce3964eaee9a578 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:12:15 -0700 Subject: [PATCH 266/631] Port fix2243.md to projects --- unison-src/transcripts/fix2254.md | 36 +++-- unison-src/transcripts/fix2254.output.md | 176 +++++++++++++++++++++-- 2 files changed, 183 insertions(+), 29 deletions(-) diff --git a/unison-src/transcripts/fix2254.md b/unison-src/transcripts/fix2254.md index 17a2befbd2..7af9ffd9ff 100644 --- a/unison-src/transcripts/fix2254.md +++ b/unison-src/transcripts/fix2254.md @@ -1,6 +1,6 @@ ```ucm:hide -scratch/main a> builtins.merge +scratch/a> builtins.merge lib.builtins ``` This transcript checks that updates to data types propagate successfully to dependent types and dependent terms that do pattern matching. First let's create some types and terms: @@ -35,11 +35,12 @@ g = cases _ -> 43 ``` -We'll make our edits in a fork of the `a` namespace: +We'll make our edits in a new branch. ```ucm -scratch/main a> add -scratch/main> fork a a2 +scratch/a> add +scratch/a> branch a2 +scratch/a2> ``` First let's edit the `A` type, adding another constructor `E`. Note that the functions written against the old type have a wildcard in their pattern match, so they should work fine after the update. @@ -56,31 +57,29 @@ unique type A a b c d Let's do the update now, and verify that the definitions all look good and there's nothing `todo`: ```ucm -.a2> update.old -.a2> view A NeedsA f f2 f3 g -.a2> todo -``` - -```ucm:hide -.a2> builtins.merge +scratch/a2> update.old +scratch/a2> view A NeedsA f f2 f3 g +scratch/a2> todo ``` ## Record updates Here's a test of updating a record: +```ucm:hide +scratch/r1> builtins.merge lib.builtins +``` + + ```unison structural type Rec = { uno : Nat, dos : Nat } combine r = uno r + dos r ``` -```ucm:hide -.a3> builtins.merge -``` - ```ucm -.a3> add +scratch/r1> add +scratch/r1> branch r2 ``` ```unison @@ -90,7 +89,6 @@ structural type Rec = { uno : Nat, dos : Nat, tres : Text } And checking that after updating this record, there's nothing `todo`: ```ucm -scratch/main> fork a3 a4 -.a4> update.old -.a4> todo +scratch/r2> update.old +scratch/r2> todo ``` diff --git a/unison-src/transcripts/fix2254.output.md b/unison-src/transcripts/fix2254.output.md index b0b3f60b02..16e4285c17 100644 --- a/unison-src/transcripts/fix2254.output.md +++ b/unison-src/transcripts/fix2254.output.md @@ -31,13 +31,13 @@ g = cases _ -> 43 ``` -We'll make our edits in a fork of the `a` namespace: +We'll make our edits in a new branch. ```ucm -scratch/main a> add +scratch/a> add ⍟ I've added these definitions: - + type A a b c d structural type NeedsA a b f : A Nat Nat Nat Nat -> Nat @@ -45,22 +45,178 @@ scratch/main a> add f3 : NeedsA Nat Nat -> Nat g : A Nat Nat Nat Nat -> Nat -scratch/main> fork a a2 +scratch/a> branch a2 + + Done. I've created the a2 branch based off of a. + + Tip: To merge your work back into the a branch, first + `switch /a` then `merge /a2`. + +``` +First let's edit the `A` type, adding another constructor `E`. Note that the functions written against the old type have a wildcard in their pattern match, so they should work fine after the update. + +```unison +unique type A a b c d + = A a + | B b + | C c + | D d + | E a d +``` + +Let's do the update now, and verify that the definitions all look good and there's nothing `todo`: + +```ucm +scratch/a2> update.old + + ⍟ I've updated these names to your new definition: + + type A a b c d + +scratch/a2> view A NeedsA f f2 f3 g + + type A a b c d + = A a + | D d + | E a d + | B b + | C c + + structural type NeedsA a b + = NeedsA (A a b Nat Nat) + | Zoink Text + + f : A Nat Nat Nat Nat -> Nat + f = cases + A n -> n + _ -> 42 + + f2 : A Nat Nat Nat Nat -> Nat + f2 a = + use Nat + + n = f a + n + 1 + + f3 : NeedsA Nat Nat -> Nat + f3 = cases + NeedsA a -> f a Nat.+ 20 + _ -> 0 + + g : A Nat Nat Nat Nat -> Nat + g = cases + D n -> n + _ -> 43 + +scratch/a2> todo + + - ⚠️ +``` +## Record updates + +Here's a test of updating a record: - The namespace .__projects._ae607e42_8e50_43fc_bd62_57e211b16316.branches._04b92376_f428_4b46_8d52_c83ba75c6a15.a doesn't exist. +```unison +structural type Rec = { uno : Nat, dos : Nat } +combine r = uno r + dos r ``` +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + structural type Rec + Rec.dos : Rec -> Nat + Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.dos.set : Nat -> Rec -> Rec + Rec.uno : Rec -> Nat + Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.uno.set : Nat -> Rec -> Rec + combine : Rec -> Nat + +``` +```ucm +scratch/r1> add + + ⍟ I've added these definitions: + + structural type Rec + Rec.dos : Rec -> Nat + Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.dos.set : Nat -> Rec -> Rec + Rec.uno : Rec -> Nat + Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.uno.set : Nat -> Rec -> Rec + combine : Rec -> Nat + +scratch/r1> branch r2 + + Done. I've created the r2 branch based off of r1. + + Tip: To merge your work back into the r1 branch, first + `switch /r1` then `merge /r2`. +``` +```unison +structural type Rec = { uno : Nat, dos : Nat, tres : Text } +``` -🛑 +```ucm -The transcript failed due to an error in the stanza above. The error is: + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + Rec.tres : Rec -> Text + Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec + Rec.tres.set : Text -> Rec -> Rec + + ⍟ These names already exist. You can `update` them to your + new definition: + + structural type Rec + Rec.dos : Rec -> Nat + Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.dos.set : Nat -> Rec -> Rec + Rec.uno : Rec -> Nat + Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.uno.set : Nat -> Rec -> Rec +``` +And checking that after updating this record, there's nothing `todo`: - ⚠️ +```ucm +scratch/r2> update.old - The namespace .__projects._ae607e42_8e50_43fc_bd62_57e211b16316.branches._04b92376_f428_4b46_8d52_c83ba75c6a15.a doesn't exist. + ⍟ I've added these definitions: + + Rec.tres : Rec -> Text + Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec + Rec.tres.set : Text -> Rec -> Rec + + ⍟ I've updated these names to your new definition: + + structural type Rec + Rec.dos : Rec -> Nat + Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.dos.set : Nat -> Rec -> Rec + Rec.uno : Rec -> Nat + Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.uno.set : Nat -> Rec -> Rec + +scratch/r2> todo + + +``` From bcb3e46218c79d944ebf527a25188995eb90bd13 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:18:41 -0700 Subject: [PATCH 267/631] Fix 2628.md for projects --- unison-src/transcripts/fix2628.md | 2 +- unison-src/transcripts/fix2628.output.md | 30 ++++++++++++------------ 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/unison-src/transcripts/fix2628.md b/unison-src/transcripts/fix2628.md index 3e111226b5..cef5bd4a98 100644 --- a/unison-src/transcripts/fix2628.md +++ b/unison-src/transcripts/fix2628.md @@ -1,5 +1,5 @@ ```ucm:hide -scratch/main> alias.type ##Nat .base.Nat +scratch/main> alias.type ##Nat lib.base.Nat ``` ```unison:hide diff --git a/unison-src/transcripts/fix2628.output.md b/unison-src/transcripts/fix2628.output.md index 93e2bb13af..6dba18bfaf 100644 --- a/unison-src/transcripts/fix2628.output.md +++ b/unison-src/transcripts/fix2628.output.md @@ -4,23 +4,23 @@ unique type foo.bar.baz.MyRecord = { } ``` +```ucm +scratch/main> add + ⍟ I've added these definitions: + + type foo.bar.baz.MyRecord + foo.bar.baz.MyRecord.value : MyRecord -> Nat + foo.bar.baz.MyRecord.value.modify : (Nat ->{g} Nat) + -> MyRecord + ->{g} MyRecord + foo.bar.baz.MyRecord.value.set : Nat + -> MyRecord + -> MyRecord -🛑 - -The transcript failed due to an error in the stanza above. The error is: - +scratch/main> find : Nat -> MyRecord - - ❓ - - I couldn't resolve any of these symbols: - - 2 | value : Nat - - - Symbol Suggestions - - Nat No matches + 1. foo.bar.baz.MyRecord.MyRecord : Nat -> MyRecord +``` From 66259960390bb9101ec410dd166c7c765334cf01 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:20:19 -0700 Subject: [PATCH 268/631] Port fuzzy-option.md to projects --- unison-src/transcripts/fuzzy-options.md | 2 +- unison-src/transcripts/fuzzy-options.output.md | 9 ++++----- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/unison-src/transcripts/fuzzy-options.md b/unison-src/transcripts/fuzzy-options.md index 985173ae81..e460ce923a 100644 --- a/unison-src/transcripts/fuzzy-options.md +++ b/unison-src/transcripts/fuzzy-options.md @@ -12,7 +12,7 @@ If a fuzzy resolver doesn't have any options available it should print a message opening an empty fuzzy-select. ```ucm:error -scratch/main empty> view +scratch/empty> view ``` diff --git a/unison-src/transcripts/fuzzy-options.output.md b/unison-src/transcripts/fuzzy-options.output.md index b59ac3c34e..290d07aab1 100644 --- a/unison-src/transcripts/fuzzy-options.output.md +++ b/unison-src/transcripts/fuzzy-options.output.md @@ -14,9 +14,7 @@ If a fuzzy resolver doesn't have any options available it should print a message opening an empty fuzzy-select. ```ucm - ☝️ The namespace .empty is empty. - -scratch/main empty> view +scratch/empty> view ⚠️ @@ -35,7 +33,7 @@ Definition args scratch/main> add ⍟ I've added these definitions: - + nested.optionTwo : ##Nat optionOne : ##Nat @@ -66,7 +64,7 @@ Project Branch args myproject/main> branch mybranch Done. I've created the mybranch branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /mybranch`. @@ -75,6 +73,7 @@ scratch/main> debug.fuzzy-options switch _ Select a project or branch to switch to: * myproject/main * myproject/mybranch + * scratch/empty * scratch/main * myproject * scratch From 59aebe93a588105544dd6c51525fc30399432d58 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:22:32 -0700 Subject: [PATCH 269/631] remove ls-pretty-print-scope-bug.md, we don't really support subnamespaces for this any more --- .../transcripts/ls-pretty-print-scope-bug.md | 44 ------- .../ls-pretty-print-scope-bug.output.md | 115 ------------------ 2 files changed, 159 deletions(-) delete mode 100644 unison-src/transcripts/ls-pretty-print-scope-bug.md delete mode 100644 unison-src/transcripts/ls-pretty-print-scope-bug.output.md diff --git a/unison-src/transcripts/ls-pretty-print-scope-bug.md b/unison-src/transcripts/ls-pretty-print-scope-bug.md deleted file mode 100644 index 36ff971074..0000000000 --- a/unison-src/transcripts/ls-pretty-print-scope-bug.md +++ /dev/null @@ -1,44 +0,0 @@ -```unison -unique type Foo = Foo -``` - -```ucm -scratch/main a.b> add -scratch/main> fork .a.b .c.d.f -.c.g.f> -``` - -```unison -unique type Foo = Foo -``` - -```ucm -scratch/main c.g.f> add -.c> -``` - -```unison -foo = .d.f.Foo.Foo -``` - -```ucm -scratch/main c> add -``` - -At this point we have: -`.a.b.Foo` -`.c.d.f.Foo` which is equal to `.a.b.Foo` -`.c.g.f.Foo` which is distinct from the other `Foo` types - -```ucm -scratch/main> delete .c.d.f.Foo -``` -Once `.c.d.f.Foo` is deleted `.c.foo` should have the type `.a.b.Foo` -when viewed from `scratch/main>`, but an unnamed type when viewed from `.c>`, -since referencing `.a.b.Foo` would reference names outside of the -namespace rooted at `.c`. - -```ucm -scratch/main> ls c -scratch/main c> ls -``` diff --git a/unison-src/transcripts/ls-pretty-print-scope-bug.output.md b/unison-src/transcripts/ls-pretty-print-scope-bug.output.md deleted file mode 100644 index 5c0eab0b7b..0000000000 --- a/unison-src/transcripts/ls-pretty-print-scope-bug.output.md +++ /dev/null @@ -1,115 +0,0 @@ -```unison -unique type Foo = Foo -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - type Foo - -``` -```ucm - ☝️ The namespace .a.b is empty. - -.a.b> add - - ⍟ I've added these definitions: - - type Foo - -scratch/main> fork .a.b .c.d.f - - Done. - - ☝️ The namespace .c.g.f is empty. - -``` -```unison -unique type Foo = Foo -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - type Foo - -``` -```ucm -.c.g.f> add - - ⍟ I've added these definitions: - - type Foo - -``` -```unison -foo = .d.f.Foo.Foo -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - foo : d.f.Foo - -``` -```ucm -.c> add - - ⍟ I've added these definitions: - - foo : d.f.Foo - -``` -At this point we have: -`.a.b.Foo` -`.c.d.f.Foo` which is equal to `.a.b.Foo` -`.c.g.f.Foo` which is distinct from the other `Foo` types - -```ucm -scratch/main> delete .c.d.f.Foo - - Done. - -``` -Once `.c.d.f.Foo` is deleted `.c.foo` should have the type `.a.b.Foo` -when viewed from `scratch/main>`, but an unnamed type when viewed from `.c>`, -since referencing `.a.b.Foo` would reference names outside of the -namespace rooted at `.c`. - -```ucm -scratch/main> ls c - - nothing to show - -``` - - - -🛑 - -The transcript failed due to an error in the stanza above. The error is: - - - nothing to show - From bed7af2ab2c8673b1961eb9447b5b82e67bc7662 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:29:08 -0700 Subject: [PATCH 270/631] Half-convert move-namespace.md to projects --- unison-src/transcripts/move-namespace.md | 112 +++++++----- .../transcripts/move-namespace.output.md | 171 ++++++++++++------ 2 files changed, 178 insertions(+), 105 deletions(-) diff --git a/unison-src/transcripts/move-namespace.md b/unison-src/transcripts/move-namespace.md index 87480d5748..0d1c7ba3e5 100644 --- a/unison-src/transcripts/move-namespace.md +++ b/unison-src/transcripts/move-namespace.md @@ -1,9 +1,47 @@ # Tests for `move.namespace` + +## Moving the Root + +I should be able to move the root into a sub-namespace + +```unison:hide +foo = 1 +``` + +```ucm +.> add +-- Should request confirmation +.> move.namespace . .root.at.path +.> move.namespace . .root.at.path +.> ls +.> history +``` + +```ucm +.> ls .root.at.path +.> history .root.at.path +``` + +I should be able to move a sub namespace _over_ the root. + +```ucm +-- Should request confirmation +.> move.namespace .root.at.path . +.> move.namespace .root.at.path . +.> ls +.> history +``` + + +```ucm:error +-- should be empty +.> ls .root.at.path +.> history .root.at.path +``` + ```ucm:hide -scratch/main happy> builtins.merge -scratch/main history> builtins.merge -scratch/main existing> builtins.merge +scratch/happy> builtins.merge lib.builtins ``` ## Happy path @@ -16,7 +54,7 @@ unique type a.T = T ``` ```ucm -scratch/main happy> add +scratch/happy> add ``` ```unison @@ -25,20 +63,23 @@ unique type a.T = T1 | T2 ``` ```ucm -scratch/main happy> update +scratch/happy> update ``` Should be able to move the namespace, including its types, terms, and sub-namespaces. ```ucm -scratch/main happy> move.namespace a b -scratch/main happy> ls b -scratch/main happy> history b +scratch/happy> move.namespace a b +scratch/happy> ls b +scratch/happy> history b ``` ## Namespace history +```ucm:hide +scratch/history> builtins.merge lib.builtins +``` Create some namespaces and add some history to them @@ -48,7 +89,7 @@ b.termInB = 10 ``` ```ucm -scratch/main history> add +scratch/history> add ``` ```unison @@ -57,7 +98,7 @@ b.termInB = 11 ``` ```ucm -scratch/main history> update +scratch/history> update ``` Deleting a namespace should not leave behind any history, @@ -65,17 +106,21 @@ if we move another to that location we expect the history to simply be the histo of the moved namespace. ```ucm -scratch/main history> delete.namespace b -scratch/main history> move.namespace a b +scratch/history> delete.namespace b +scratch/history> move.namespace a b -- Should be the history from 'a' -scratch/main history> history b +scratch/history> history b -- Should be empty -scratch/main history> history a +scratch/history> history a ``` ## Moving over an existing branch +```ucm:hide +scratch/existing> builtins.merge lib.builtins +``` + Create some namespace and add some history to them ```unison @@ -84,7 +129,7 @@ b.termInB = 10 ``` ```ucm -scratch/main existing> add +scratch/existing> add ``` ```unison @@ -93,40 +138,7 @@ b.termInB = 11 ``` ```ucm -scratch/main existing> update -scratch/main existing> move.namespace a b +scratch/existing> update +scratch/existing> move.namespace a b ``` -## Moving the Root - -I should be able to move the root into a sub-namespace - -```ucm --- Should request confirmation -scratch/main> move.namespace . .root.at.path -scratch/main> move.namespace . .root.at.path -scratch/main> ls -scratch/main> history -``` - -```ucm -scratch/main> ls .root.at.path -scratch/main> history .root.at.path -``` - -I should be able to move a sub namespace _over_ the root. - -```ucm --- Should request confirmation -scratch/main> move.namespace .root.at.path.happy . -scratch/main> move.namespace .root.at.path.happy . -scratch/main> ls -scratch/main> history -``` - - -```ucm:error --- should be empty -scratch/main> ls .root.at.path.happy -scratch/main> history .root.at.path.happy -``` diff --git a/unison-src/transcripts/move-namespace.output.md b/unison-src/transcripts/move-namespace.output.md index b044a08910..257365dbdc 100644 --- a/unison-src/transcripts/move-namespace.output.md +++ b/unison-src/transcripts/move-namespace.output.md @@ -1,5 +1,102 @@ # Tests for `move.namespace` + +## Moving the Root + +I should be able to move the root into a sub-namespace + +```unison +foo = 1 +``` + +```ucm +.> add + + ⍟ I've added these definitions: + + foo : ##Nat + +-- Should request confirmation +.> move.namespace . .root.at.path + + ⚠️ + + Moves which affect the root branch cannot be undone, are you sure? + Re-run the same command to proceed. + +.> move.namespace . .root.at.path + + Done. + +.> ls + + 1. root/ (1 term) + +.> history + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #g97lh1m2v7 (start of history) + +``` +```ucm +.> ls .root.at.path + + 1. foo (##Nat) + +.> history .root.at.path + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #08a6hgi6s4 (start of history) + +``` +I should be able to move a sub namespace _over_ the root. + +```ucm +-- Should request confirmation +.> move.namespace .root.at.path . + + ⚠️ + + Moves which affect the root branch cannot be undone, are you sure? + Re-run the same command to proceed. + +.> move.namespace .root.at.path . + + Done. + +.> ls + + 1. foo (##Nat) + +.> history + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #08a6hgi6s4 (start of history) + +``` +```ucm +-- should be empty +.> ls .root.at.path + + nothing to show + +.> history .root.at.path + + ☝️ The namespace .root.at.path is empty. + +``` ## Happy path Create a namespace and add some history to it @@ -24,7 +121,7 @@ unique type a.T = T ``` ```ucm -.happy> add +scratch/happy> add ⍟ I've added these definitions: @@ -53,7 +150,7 @@ unique type a.T = T1 | T2 ``` ```ucm -.happy> update +scratch/happy> update Okay, I'm searching the branch for code that needs to be updated... @@ -64,22 +161,22 @@ unique type a.T = T1 | T2 Should be able to move the namespace, including its types, terms, and sub-namespaces. ```ucm -.happy> move.namespace a b +scratch/happy> move.namespace a b Done. -.happy> ls b +scratch/happy> ls b 1. T (type) 2. T/ (2 terms) 3. termInA (Nat) -.happy> history b +scratch/happy> history b Note: The most recent namespace hash is immediately below this message. - ⊙ 1. #4j747vnmdk + ⊙ 1. #rkvfe5p8fu + Adds / updates: @@ -89,12 +186,11 @@ Should be able to move the namespace, including its types, terms, and sub-namesp T.T - □ 2. #r71j4144fe (start of history) + □ 2. #avlnmh0erc (start of history) ``` ## Namespace history - Create some namespaces and add some history to them ```unison @@ -117,7 +213,7 @@ b.termInB = 10 ``` ```ucm -.history> add +scratch/history> add ⍟ I've added these definitions: @@ -146,7 +242,7 @@ b.termInB = 11 ``` ```ucm -.history> update +scratch/history> update Okay, I'm searching the branch for code that needs to be updated... @@ -156,19 +252,19 @@ b.termInB = 11 ``` Deleting a namespace should not leave behind any history, if we move another to that location we expect the history to simply be the history -of the moved namespace. +of the moved namespace. ```ucm -.history> delete.namespace b +scratch/history> delete.namespace b Done. -.history> move.namespace a b +scratch/history> move.namespace a b Done. -- Should be the history from 'a' -.history> history b +scratch/history> history b Note: The most recent namespace hash is immediately below this message. @@ -182,12 +278,12 @@ of the moved namespace. □ 2. #m8smmmgjso (start of history) -- Should be empty -.history> history a +scratch/history> history a - ☝️ The namespace .history.a is empty. + ☝️ The namespace a is empty. ``` -## Moving over an existing branch +## Moving over an existing branch Create some namespace and add some history to them @@ -211,7 +307,7 @@ b.termInB = 10 ``` ```ucm -.existing> add +scratch/existing> add ⍟ I've added these definitions: @@ -240,14 +336,14 @@ b.termInB = 11 ``` ```ucm -.existing> update +scratch/existing> update Okay, I'm searching the branch for code that needs to be updated... Done. -.existing> move.namespace a b +scratch/existing> move.namespace a b ⚠️ @@ -258,38 +354,3 @@ b.termInB = 11 Done. ``` -## Moving the Root - -I should be able to move the root into a sub-namespace - -```ucm --- Should request confirmation -scratch/main> move.namespace . .root.at.path - - ⚠️ - - Moves which affect the root branch cannot be undone, are you sure? - Re-run the same command to proceed. - -scratch/main> move.namespace . .root.at.path - - Done. - -scratch/main> ls - - nothing to show - -``` - -```ucm --- Should request confirmationscratch/main> move.namespace . .root.at.pathscratch/main> move.namespace . .root.at.pathscratch/main> lsscratch/main> history -``` - - -🛑 - -The transcript failed due to an error in the stanza above. The error is: - - - nothing to show - From 6e549469cd53511e19fdaf00e26af9a52b3e473e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:45:20 -0700 Subject: [PATCH 271/631] Port namespace-deletion-regression.md to projects --- .../namespace-deletion-regression.md | 2 +- .../namespace-deletion-regression.output.md | 19 +++++++++---------- 2 files changed, 10 insertions(+), 11 deletions(-) diff --git a/unison-src/transcripts/namespace-deletion-regression.md b/unison-src/transcripts/namespace-deletion-regression.md index f9d5fd7410..a1bc14ca3c 100644 --- a/unison-src/transcripts/namespace-deletion-regression.md +++ b/unison-src/transcripts/namespace-deletion-regression.md @@ -8,7 +8,7 @@ Previously the following sequence delete the current namespace unexpectedly 😬. ```ucm -scratch/main> alias.term ##Nat.+ .Nat.+ +scratch/main> alias.term ##Nat.+ Nat.+ scratch/main> ls Nat scratch/main> move.namespace Nat Nat.operators scratch/main> ls Nat diff --git a/unison-src/transcripts/namespace-deletion-regression.output.md b/unison-src/transcripts/namespace-deletion-regression.output.md index 624501a17b..21e0866f75 100644 --- a/unison-src/transcripts/namespace-deletion-regression.output.md +++ b/unison-src/transcripts/namespace-deletion-regression.output.md @@ -8,25 +8,24 @@ Previously the following sequence delete the current namespace unexpectedly 😬. ```ucm -scratch/main> alias.term ##Nat.+ .Nat.+ +scratch/main> alias.term ##Nat.+ Nat.+ Done. scratch/main> ls Nat - nothing to show + 1. + (##Nat -> ##Nat -> ##Nat) -``` - -```ucm -scratch/main> alias.term ##Nat.+ .Nat.+scratch/main> ls Natscratch/main> move.namespace Nat Nat.operatorsscratch/main> ls Natscratch/main> ls Nat.operators -``` +scratch/main> move.namespace Nat Nat.operators + Done. -🛑 +scratch/main> ls Nat -The transcript failed due to an error in the stanza above. The error is: + 1. operators/ (1 term) +scratch/main> ls Nat.operators - nothing to show + 1. + (##Nat -> ##Nat -> ##Nat) +``` From 3ab92ec80db2a101ee4ed6f1fd635fdd4542dceb Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:47:03 -0700 Subject: [PATCH 272/631] Leave namespace-dependencies for later --- .../namespace-dependencies.md | 4 +-- .../namespace-dependencies.output.md | 29 ++++++------------- 2 files changed, 11 insertions(+), 22 deletions(-) diff --git a/unison-src/transcripts-using-base/namespace-dependencies.md b/unison-src/transcripts-using-base/namespace-dependencies.md index 226da3c1cd..d338c05432 100644 --- a/unison-src/transcripts-using-base/namespace-dependencies.md +++ b/unison-src/transcripts-using-base/namespace-dependencies.md @@ -6,6 +6,6 @@ mynamespace.dependsOnText = external.mynat Nat.+ 10 ``` ```ucm -scratch/main> add -scratch/main mynamespace> namespace.dependencies +.> add +.mynamespace> namespace.dependencies ``` diff --git a/unison-src/transcripts-using-base/namespace-dependencies.output.md b/unison-src/transcripts-using-base/namespace-dependencies.output.md index 7c4f828d0f..44e03276dd 100644 --- a/unison-src/transcripts-using-base/namespace-dependencies.output.md +++ b/unison-src/transcripts-using-base/namespace-dependencies.output.md @@ -6,31 +6,20 @@ mynamespace.dependsOnText = external.mynat Nat.+ 10 ``` ```ucm -scratch/main> add +.> add ⍟ I've added these definitions: - + external.mynat : Nat mynamespace.dependsOnText : Nat - ☝️ The namespace .mynamespace is empty. - -scratch/main mynamespace> namespace.dependencies - - ⚠️ +.mynamespace> namespace.dependencies - .mynamespace is an empty namespace. + External dependency Dependents in .mynamespace + .__projects._00d11f84_cb58_44e7_9f94_a609484f5480.branches._4d14ef03_be64_4fbe_bbfd_0c32f444600d.builtin.Nat 1. dependsOnText + + .__projects._00d11f84_cb58_44e7_9f94_a609484f5480.branches._4d14ef03_be64_4fbe_bbfd_0c32f444600d.builtin.Nat.+ 1. dependsOnText + + .external.mynat 1. dependsOnText ``` - - - -🛑 - -The transcript failed due to an error in the stanza above. The error is: - - - ⚠️ - - .mynamespace is an empty namespace. - From 1014ff7a1ac785730e7654b0f6f995f3a0aa3161 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:48:47 -0700 Subject: [PATCH 273/631] Port numbered-args to projects --- unison-src/transcripts/numbered-args.md | 22 +++++++++---------- .../transcripts/numbered-args.output.md | 20 ++++++++--------- 2 files changed, 21 insertions(+), 21 deletions(-) diff --git a/unison-src/transcripts/numbered-args.md b/unison-src/transcripts/numbered-args.md index d895be6cb8..02172710bc 100644 --- a/unison-src/transcripts/numbered-args.md +++ b/unison-src/transcripts/numbered-args.md @@ -1,7 +1,7 @@ # Using numbered arguments in UCM ```ucm:hide -scratch/main temp> alias.type ##Text Text +scratch/main> alias.type ##Text Text ``` First lets add some contents to our codebase. @@ -16,41 +16,41 @@ corge = "corge" ``` ```ucm -scratch/main temp> add +scratch/main> add ``` We can get the list of things in the namespace, and UCM will give us a numbered list: ```ucm -scratch/main temp> find +scratch/main> find ``` We can ask to `view` the second element of this list: ```ucm -scratch/main temp> find -scratch/main temp> view 2 +scratch/main> find +scratch/main> view 2 ``` And we can `view` multiple elements by separating with spaces: ```ucm -scratch/main temp> find -scratch/main temp> view 2 3 5 +scratch/main> find +scratch/main> view 2 3 5 ``` We can also ask for a range: ```ucm -scratch/main temp> find -scratch/main temp> view 2-4 +scratch/main> find +scratch/main> view 2-4 ``` And we can ask for multiple ranges and use mix of ranges and numbers: ```ucm -scratch/main temp> find -scratch/main temp> view 1-3 4 5-6 +scratch/main> find +scratch/main> view 1-3 4 5-6 ``` diff --git a/unison-src/transcripts/numbered-args.output.md b/unison-src/transcripts/numbered-args.output.md index b8dfce49f2..883a319de6 100644 --- a/unison-src/transcripts/numbered-args.output.md +++ b/unison-src/transcripts/numbered-args.output.md @@ -30,7 +30,7 @@ corge = "corge" ``` ```ucm -.temp> add +scratch/main> add ⍟ I've added these definitions: @@ -46,7 +46,7 @@ We can get the list of things in the namespace, and UCM will give us a numbered list: ```ucm -.temp> find +scratch/main> find 1. bar : Text 2. baz : Text @@ -61,7 +61,7 @@ list: We can ask to `view` the second element of this list: ```ucm -.temp> find +scratch/main> find 1. bar : Text 2. baz : Text @@ -72,7 +72,7 @@ We can ask to `view` the second element of this list: 7. builtin type Text -.temp> view 2 +scratch/main> view 2 baz : Text baz = "baz" @@ -81,7 +81,7 @@ We can ask to `view` the second element of this list: And we can `view` multiple elements by separating with spaces: ```ucm -.temp> find +scratch/main> find 1. bar : Text 2. baz : Text @@ -92,7 +92,7 @@ And we can `view` multiple elements by separating with spaces: 7. builtin type Text -.temp> view 2 3 5 +scratch/main> view 2 3 5 baz : Text baz = "baz" @@ -107,7 +107,7 @@ And we can `view` multiple elements by separating with spaces: We can also ask for a range: ```ucm -.temp> find +scratch/main> find 1. bar : Text 2. baz : Text @@ -118,7 +118,7 @@ We can also ask for a range: 7. builtin type Text -.temp> view 2-4 +scratch/main> view 2-4 baz : Text baz = "baz" @@ -133,7 +133,7 @@ We can also ask for a range: And we can ask for multiple ranges and use mix of ranges and numbers: ```ucm -.temp> find +scratch/main> find 1. bar : Text 2. baz : Text @@ -144,7 +144,7 @@ And we can ask for multiple ranges and use mix of ranges and numbers: 7. builtin type Text -.temp> view 1-3 4 5-6 +scratch/main> view 1-3 4 5-6 bar : Text bar = "bar" From 2e1a95443ae471081f55fcb09856b351778b7c4f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:49:49 -0700 Subject: [PATCH 274/631] Partially convert propagate.md to projects --- unison-src/transcripts/propagate.md | 31 ++++--- unison-src/transcripts/propagate.output.md | 97 ++++++++++++++++++---- 2 files changed, 95 insertions(+), 33 deletions(-) diff --git a/unison-src/transcripts/propagate.md b/unison-src/transcripts/propagate.md index 61237912c9..b5eaf3ede2 100644 --- a/unison-src/transcripts/propagate.md +++ b/unison-src/transcripts/propagate.md @@ -1,7 +1,7 @@ # Propagating type edits ```ucm:hide -scratch/main subpath.lib> builtins.merge +scratch/main> builtins.merge lib.builtins ``` We introduce a type `Foo` with a function dependent `fooToInt`. @@ -16,9 +16,9 @@ fooToInt _ = +42 And then we add it. ```ucm -scratch/main subpath> add -scratch/main subpath> find.verbose -scratch/main subpath> view fooToInt +scratch/main> add +scratch/main> find.verbose +scratch/main> view fooToInt ``` Then if we change the type `Foo`... @@ -30,13 +30,13 @@ unique type Foo = Foo | Bar and update the codebase to use the new type `Foo`... ```ucm -scratch/main subpath> update.old +scratch/main> update.old ``` ... it should automatically propagate the type to `fooToInt`. ```ucm -scratch/main subpath> view fooToInt +scratch/main> view fooToInt ``` ### Preserving user type variables @@ -55,7 +55,7 @@ preserve.otherTerm y = someTerm y Add that to the codebase: ```ucm -scratch/main subpath> add +scratch/main> add ``` Let's now edit the dependency: @@ -68,15 +68,15 @@ preserve.someTerm _ = None Update... ```ucm -scratch/main subpath> update.old +scratch/main> update.old ``` Now the type of `someTerm` should be `Optional x -> Optional x` and the type of `otherTerm` should remain the same. ```ucm -scratch/main subpath> view preserve.someTerm -scratch/main subpath> view preserve.otherTerm +scratch/main> view preserve.someTerm +scratch/main> view preserve.otherTerm ``` ### Propagation only applies to the local branch @@ -84,8 +84,7 @@ scratch/main subpath> view preserve.otherTerm Cleaning up a bit... ```ucm -scratch/main> delete.namespace subpath -scratch/main subpath.lib> builtins.merge +.subpath.lib> builtins.merge ``` Now, we make two terms, where one depends on the other. @@ -101,8 +100,8 @@ one.otherTerm y = someTerm y We'll make two copies of this namespace. ```ucm -scratch/main subpath> add -scratch/main subpath> fork one two +.subpath> add +.subpath> fork one two ``` Now let's edit one of the terms... @@ -115,11 +114,11 @@ someTerm _ = None ... in one of the namespaces... ```ucm -scratch/main subpath.one> update.old +.subpath.one> update.old ``` The other namespace should be left alone. ```ucm -scratch/main subpath> view two.someTerm +.subpath> view two.someTerm ``` diff --git a/unison-src/transcripts/propagate.output.md b/unison-src/transcripts/propagate.output.md index db8dceb6d4..5e16983bc3 100644 --- a/unison-src/transcripts/propagate.output.md +++ b/unison-src/transcripts/propagate.output.md @@ -26,14 +26,14 @@ fooToInt _ = +42 And then we add it. ```ucm -.subpath> add +scratch/main> add ⍟ I've added these definitions: type Foo fooToInt : Foo -> Int -.subpath> find.verbose +scratch/main> find.verbose 1. -- #uj8oalgadr2f52qloufah6t8vsvbc76oqijkotek87vooih7aqu44k20hrs34kartusapghp4jmfv6g1409peklv3r6a527qpk52soo type Foo @@ -46,7 +46,7 @@ And then we add it. -.subpath> view fooToInt +scratch/main> view fooToInt fooToInt : Foo -> Int fooToInt _ = +42 @@ -75,7 +75,7 @@ unique type Foo = Foo | Bar and update the codebase to use the new type `Foo`... ```ucm -.subpath> update.old +scratch/main> update.old ⍟ I've updated these names to your new definition: @@ -85,7 +85,7 @@ and update the codebase to use the new type `Foo`... ... it should automatically propagate the type to `fooToInt`. ```ucm -.subpath> view fooToInt +scratch/main> view fooToInt fooToInt : Foo -> Int fooToInt _ = +42 @@ -121,7 +121,7 @@ preserve.otherTerm y = someTerm y Add that to the codebase: ```ucm -.subpath> add +scratch/main> add ⍟ I've added these definitions: @@ -153,7 +153,7 @@ preserve.someTerm _ = None Update... ```ucm -.subpath> update.old +scratch/main> update.old ⍟ I've updated these names to your new definition: @@ -164,12 +164,12 @@ Now the type of `someTerm` should be `Optional x -> Optional x` and the type of `otherTerm` should remain the same. ```ucm -.subpath> view preserve.someTerm +scratch/main> view preserve.someTerm preserve.someTerm : Optional x -> Optional x preserve.someTerm _ = None -.subpath> view preserve.otherTerm +scratch/main> view preserve.otherTerm preserve.otherTerm : Optional baz -> Optional baz preserve.otherTerm y = someTerm y @@ -180,25 +180,88 @@ type of `otherTerm` should remain the same. Cleaning up a bit... ```ucm -scratch/main> delete.namespace subpath + ☝️ The namespace .subpath.lib is empty. + +.subpath.lib> builtins.merge + + Done. + +``` +Now, we make two terms, where one depends on the other. + +```unison +one.someTerm : Optional foo -> Optional foo +one.someTerm x = x + +one.otherTerm : Optional baz -> Optional baz +one.otherTerm y = someTerm y +``` + +```ucm - ⚠️ + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: - The namespace subpath doesn't exist. + ⍟ These new definitions are ok to `add`: + + one.otherTerm : Optional baz -> Optional baz + one.someTerm : Optional foo -> Optional foo ``` +We'll make two copies of this namespace. ```ucm -scratch/main> delete.namespace subpath.subpath.lib> builtins.merge +.subpath> add + + ⍟ I've added these definitions: + + one.otherTerm : Optional baz -> Optional baz + one.someTerm : Optional foo -> Optional foo + +.subpath> fork one two + + Done. + ``` +Now let's edit one of the terms... +```unison +someTerm : Optional x -> Optional x +someTerm _ = None +``` -🛑 +```ucm -The transcript failed due to an error in the stanza above. The error is: + Loading changes detected in scratch.u. + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + someTerm : Optional x -> Optional x - ⚠️ +``` +... in one of the namespaces... + +```ucm +.subpath.one> update.old + + ⍟ I've updated these names to your new definition: - The namespace subpath doesn't exist. + someTerm : #nirp5os0q6 x -> #nirp5os0q6 x +``` +The other namespace should be left alone. + +```ucm +.subpath> view two.someTerm + + two.someTerm : Optional foo -> Optional foo + two.someTerm x = x + +``` From c419cd088db3c5a4e799f62747521600b913fc19 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:53:59 -0700 Subject: [PATCH 275/631] Port sum-type-update-conflicts to projects --- unison-src/transcripts/sum-type-update-conflicts.md | 6 +++--- .../transcripts/sum-type-update-conflicts.output.md | 12 ++++++------ 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/unison-src/transcripts/sum-type-update-conflicts.md b/unison-src/transcripts/sum-type-update-conflicts.md index 852aa66f91..1abf98f3ba 100644 --- a/unison-src/transcripts/sum-type-update-conflicts.md +++ b/unison-src/transcripts/sum-type-update-conflicts.md @@ -3,7 +3,7 @@ https://github.com/unisonweb/unison/issues/2786 ```ucm:hide -scratch/main ns> builtins.merge +scratch/main> builtins.merge lib.builtins ``` First we add a sum-type to the codebase. @@ -13,7 +13,7 @@ structural type X = x ``` ```ucm -scratch/main ns> add +scratch/main> add ``` Now we update the type, changing the name of the constructors, _but_, we simultaneously @@ -32,5 +32,5 @@ This update should succeed since the conflicted constructor is removed in the same update that the new term is being added. ```ucm -scratch/main ns> update.old +scratch/main> update.old ``` diff --git a/unison-src/transcripts/sum-type-update-conflicts.output.md b/unison-src/transcripts/sum-type-update-conflicts.output.md index fc45a547bf..493a4d9407 100644 --- a/unison-src/transcripts/sum-type-update-conflicts.output.md +++ b/unison-src/transcripts/sum-type-update-conflicts.output.md @@ -19,16 +19,16 @@ structural type X = x ⍟ These new definitions are ok to `add`: structural type X - (also named builtin.Unit) + (also named lib.builtins.Unit) ``` ```ucm -.ns> add +scratch/main> add ⍟ I've added these definitions: structural type X - (also named builtin.Unit) + (also named lib.builtins.Unit) ``` Now we update the type, changing the name of the constructors, _but_, we simultaneously @@ -60,14 +60,14 @@ dependsOnX = Text.size X.x new definition: structural type X - (The old definition is also named builtin.Unit.) + (The old definition is also named lib.builtins.Unit.) ``` This update should succeed since the conflicted constructor is removed in the same update that the new term is being added. ```ucm -.ns> update.old +scratch/main> update.old ⍟ I've added these definitions: @@ -77,6 +77,6 @@ is removed in the same update that the new term is being added. ⍟ I've updated these names to your new definition: structural type X - (The old definition was also named builtin.Unit.) + (The old definition was also named lib.builtins.Unit.) ``` From bb41e55e077a7ab13a99a63e9353b4bd67ddde48 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 11:55:35 -0700 Subject: [PATCH 276/631] Port tab-completion mostly to projects --- unison-src/transcripts/tab-completion.md | 10 +++++++++- unison-src/transcripts/tab-completion.output.md | 16 +++++++++++++--- 2 files changed, 22 insertions(+), 4 deletions(-) diff --git a/unison-src/transcripts/tab-completion.md b/unison-src/transcripts/tab-completion.md index 65a7861f71..c270308fa7 100644 --- a/unison-src/transcripts/tab-completion.md +++ b/unison-src/transcripts/tab-completion.md @@ -36,8 +36,16 @@ scratch/main> debug.tab-complete view subnamespace2 -- Should prefix-filter by query suffix scratch/main> debug.tab-complete view subnamespace.some scratch/main> debug.tab-complete view subnamespace.someOther +``` + +```unison:hide +absolute.term = "absolute" +``` + +```ucm +.> add -- Should tab complete absolute names -scratch/main othernamespace> debug.tab-complete view .subnamespace.some +.> debug.tab-complete view .absolute.te ``` ## Tab complete namespaces diff --git a/unison-src/transcripts/tab-completion.output.md b/unison-src/transcripts/tab-completion.output.md index 3537f7e16d..c7730c17d5 100644 --- a/unison-src/transcripts/tab-completion.output.md +++ b/unison-src/transcripts/tab-completion.output.md @@ -88,12 +88,22 @@ scratch/main> debug.tab-complete view subnamespace.someOther * subnamespace.someOtherName --- Should tab complete absolute names - ☝️ The namespace .othernamespace is empty. +``` +```unison +absolute.term = "absolute" +``` -.othernamespace> debug.tab-complete view .subnamespace.some +```ucm +.> add + ⍟ I've added these definitions: + absolute.term : ##Text + +-- Should tab complete absolute names +.> debug.tab-complete view .absolute.te + + * .absolute.term ``` ## Tab complete namespaces From 5a68b4df78d2c4751e9a942f0dcdc79062974531 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 12:00:40 -0700 Subject: [PATCH 277/631] Port test-command.md to projects --- unison-src/transcripts/test-command.md | 10 ++--- unison-src/transcripts/test-command.output.md | 43 +++++++++++-------- 2 files changed, 30 insertions(+), 23 deletions(-) diff --git a/unison-src/transcripts/test-command.md b/unison-src/transcripts/test-command.md index 39a7b9bcad..aedcb1b59d 100644 --- a/unison-src/transcripts/test-command.md +++ b/unison-src/transcripts/test-command.md @@ -31,12 +31,12 @@ scratch/main> test `test` won't descend into the `lib` namespace, but `test.all` will. ```unison -testInLib : [Result] -testInLib = [Ok "testInLib"] +lib.dep.testInLib : [Result] +lib.dep.testInLib = [Ok "testInLib"] ``` ```ucm:hide -scratch/main lib> add +scratch/main> add ``` ```ucm @@ -44,10 +44,10 @@ scratch/main> test scratch/main> test.all ``` -`test` WILL run tests within `lib` if ucm is cd'd inside. +`test` WILL run tests within `lib` if specified explicitly. ```ucm -scratch/main lib> test +scratch/main> test lib.dep ``` `test` can be given a relative path, in which case it will only run tests found somewhere in that namespace. diff --git a/unison-src/transcripts/test-command.output.md b/unison-src/transcripts/test-command.output.md index b7c3eaa535..7e085d0d02 100644 --- a/unison-src/transcripts/test-command.output.md +++ b/unison-src/transcripts/test-command.output.md @@ -65,8 +65,8 @@ scratch/main> test `test` won't descend into the `lib` namespace, but `test.all` will. ```unison -testInLib : [Result] -testInLib = [Ok "testInLib"] +lib.dep.testInLib : [Result] +lib.dep.testInLib = [Ok "testInLib"] ``` ```ucm @@ -79,7 +79,7 @@ testInLib = [Ok "testInLib"] ⍟ These new definitions are ok to `add`: - testInLib : [Result] + lib.dep.testInLib : [Result] ``` ```ucm @@ -96,34 +96,41 @@ scratch/main> test scratch/main> test.all - Cached test results (`help testcache` to learn more) + + Cached test results (`help testcache` to learn more) + + ◉ foo.test2 test2 + ◉ test1 test1 + + ✅ 2 test(s) passing + + ✅ + - ◉ foo.test2 test2 - ◉ test1 test1 + - ✅ 2 test(s) passing + + New test results: - Tip: Use view foo.test2 to view the source of a test. + ◉ lib.dep.testInLib testInLib + + ✅ 1 test(s) passing + + Tip: Use view lib.dep.testInLib to view the source of a test. ``` `test` WILL run tests within `lib` if ucm is cd'd inside. ```ucm -.lib> test - - ✅ +scratch/main> test lib.dep + Cached test results (`help testcache` to learn more) - - - - New test results: - - ◉ testInLib testInLib + ◉ lib.dep.testInLib testInLib ✅ 1 test(s) passing - Tip: Use view testInLib to view the source of a test. + Tip: Use view lib.dep.testInLib to view the source of a test. ``` `test` can be given a relative path, in which case it will only run tests found somewhere in that namespace. From d4a08fdc0a13b73e5e515a99ad5b69c75b969346 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 12:02:55 -0700 Subject: [PATCH 278/631] Port unitnamespace to projecs --- unison-src/transcripts/unitnamespace.md | 4 +- .../transcripts/unitnamespace.output.md | 44 +++++-------------- 2 files changed, 13 insertions(+), 35 deletions(-) diff --git a/unison-src/transcripts/unitnamespace.md b/unison-src/transcripts/unitnamespace.md index 41884f13c4..c1f9f5fc5b 100644 --- a/unison-src/transcripts/unitnamespace.md +++ b/unison-src/transcripts/unitnamespace.md @@ -1,9 +1,9 @@ ```unison -foo = "bar" +`()`.foo = "bar" ``` ```ucm -.`()`> add +scratch/main> add scratch/main> find scratch/main> find-in `()` scratch/main> delete.namespace `()` diff --git a/unison-src/transcripts/unitnamespace.output.md b/unison-src/transcripts/unitnamespace.output.md index 1b5ee1893b..a3d7b39568 100644 --- a/unison-src/transcripts/unitnamespace.output.md +++ b/unison-src/transcripts/unitnamespace.output.md @@ -1,5 +1,5 @@ ```unison -foo = "bar" +`()`.foo = "bar" ``` ```ucm @@ -12,50 +12,28 @@ foo = "bar" ⍟ These new definitions are ok to `add`: - foo : ##Text + `()`.foo : ##Text ``` ```ucm - ☝️ The namespace .`()` is empty. - -.`()`> add +scratch/main> add ⍟ I've added these definitions: - foo : ##Text + `()`.foo : ##Text scratch/main> find - ☝️ - - I couldn't find matches in this namespace, searching in - 'lib'... - - 😶 - - No results. Check your spelling, or try using tab completion - to supply command arguments. + 1. `()`.foo : ##Text - `find.global` can be used to search outside the current - namespace. - -``` - -```ucm -.`()`> addscratch/main> findscratch/main> find-in `()`scratch/main> delete.namespace `()` -``` +scratch/main> find-in `()` -🛑 + 1. foo : ##Text + -The transcript failed due to an error in the stanza above. The error is: +scratch/main> delete.namespace `()` + Done. - 😶 - - No results. Check your spelling, or try using tab completion - to supply command arguments. - - `find.global` can be used to search outside the current - namespace. - +``` From 103569a5cd040c89f6ca59bc9dc88fc30b0a59e2 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 12:04:02 -0700 Subject: [PATCH 279/631] Port update-type-add-new-record to projects --- unison-src/transcripts/update-type-add-new-record.md | 2 +- unison-src/transcripts/update-type-add-new-record.output.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-src/transcripts/update-type-add-new-record.md b/unison-src/transcripts/update-type-add-new-record.md index 18abd8796c..a7f82df0c8 100644 --- a/unison-src/transcripts/update-type-add-new-record.md +++ b/unison-src/transcripts/update-type-add-new-record.md @@ -1,5 +1,5 @@ ```ucm:hide -scratch/main lib> builtins.merge +scratch/main> builtins.merge lib.builtins ``` ```unison diff --git a/unison-src/transcripts/update-type-add-new-record.output.md b/unison-src/transcripts/update-type-add-new-record.output.md index bc1fb44664..321ac28ec7 100644 --- a/unison-src/transcripts/update-type-add-new-record.output.md +++ b/unison-src/transcripts/update-type-add-new-record.output.md @@ -28,6 +28,6 @@ scratch/main> update scratch/main> view Foo - type Foo = { bar : ##Nat } + type Foo = { bar : Nat } ``` From c9c3abcd527a54da9d47f519c6d98dec594cd1ca Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 12:05:09 -0700 Subject: [PATCH 280/631] Revert view.md, will port later --- unison-src/transcripts/view.md | 12 ++++----- unison-src/transcripts/view.output.md | 35 ++++++++++++--------------- 2 files changed, 21 insertions(+), 26 deletions(-) diff --git a/unison-src/transcripts/view.md b/unison-src/transcripts/view.md index 9e6d59526b..89b81cf51f 100644 --- a/unison-src/transcripts/view.md +++ b/unison-src/transcripts/view.md @@ -1,7 +1,7 @@ # View commands ```ucm:hide -scratch/main> builtins.merge +.> builtins.merge ``` ```unison:hide @@ -10,16 +10,16 @@ b.thing = "b" ``` ```ucm:hide -scratch/main> add +.> add ``` ```ucm -- Should suffix-search and find values in sub-namespaces -scratch/main> view thing +.> view thing -- Should be local to namespace -scratch/main a> view thing +.a> view thing -- view.global should search globally and be absolutely qualified -scratch/main a> view.global thing +.a> view.global thing -- Should support absolute paths outside of current namespace -scratch/main a> view .b.thing +.a> view .b.thing ``` diff --git a/unison-src/transcripts/view.output.md b/unison-src/transcripts/view.output.md index c3777e0452..71ebf98da7 100644 --- a/unison-src/transcripts/view.output.md +++ b/unison-src/transcripts/view.output.md @@ -7,7 +7,7 @@ b.thing = "b" ```ucm -- Should suffix-search and find values in sub-namespaces -scratch/main> view thing +.> view thing a.thing : Text a.thing = "a" @@ -16,29 +16,24 @@ scratch/main> view thing b.thing = "b" -- Should be local to namespace - ☝️ The namespace .a is empty. - .a> view thing - ⚠️ - - The following names were not found in the codebase. Check your spelling. - thing - -``` + thing : ##Text + thing = "a" -```ucm --- Should suffix-search and find values in sub-namespacesscratch/main> view thing-- Should be local to namespace.a> view thing-- view.global should search globally and be absolutely qualified.a> view.global thing-- Should support absolute paths outside of current namespace.a> view .b.thing -``` +-- view.global should search globally and be absolutely qualified +.a> view.global thing + .a.thing : Text + .a.thing = "a" + + .b.thing : Text + .b.thing = "b" -🛑 - -The transcript failed due to an error in the stanza above. The error is: +-- Should support absolute paths outside of current namespace +.a> view .b.thing + .b.thing : Text + .b.thing = "b" - ⚠️ - - The following names were not found in the codebase. Check your spelling. - thing - +``` From 620a6334ff79827fa1b0bb1a1bd6fc693f82da48 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Wed, 26 Jun 2024 15:11:12 -0400 Subject: [PATCH 281/631] Add continuation representations and move some support around unison/data needs to have some of the continuation functions to allow using the struct wrappers like procedures. Includes some infrastructure for deserializing continuations. --- scheme-libs/racket/unison/boot.ss | 35 +---- scheme-libs/racket/unison/core.ss | 10 +- scheme-libs/racket/unison/data.ss | 130 +++++++++++++++++- .../racket/unison/primops-generated.rkt | 127 +++++++++++++---- 4 files changed, 237 insertions(+), 65 deletions(-) diff --git a/scheme-libs/racket/unison/boot.ss b/scheme-libs/racket/unison/boot.ss index e938e68ef8..b12f45cc45 100644 --- a/scheme-libs/racket/unison/boot.ss +++ b/scheme-libs/racket/unison/boot.ss @@ -126,7 +126,7 @@ ; (for (only (compatibility mlist) mlist->list list->mlist) expand) ; (for (only (racket base) quasisyntax/loc) expand) ; (for-syntax (only-in unison/core syntax->list)) - (only-in racket/control prompt0-at control0-at) + (only-in racket/control control0-at) racket/performance-hint unison/core unison/data @@ -445,41 +445,10 @@ (let ([v (f #:by-name #t . args)] ...) body ...))])) ; Wrapper that more closely matches `handle` constructs -; -; Note: this uses the prompt _twice_ to achieve the sort of dynamic -; scoping we want. First we push an outer delimiter, then install -; the continuation marks corresponding to the handled abilities -; (which tells which propt to use for that ability and which -; functions to use for each request). Then we re-delimit by the same -; prompt. -; -; If we just used one delimiter, we'd have a problem. If we pushed -; the marks _after_ the delimiter, then the continuation captured -; when handling would contain those marks, and would effectively -; retain the handler for requests within the continuation. If the -; marks were outside the prompt, we'd be in a similar situation, -; except where the handler would be automatically handling requests -; within its own implementation (although, in both these cases we'd -; get control errors, because we would be using the _function_ part -; of the handler without the necessary delimiters existing on the -; continuation). Both of these situations are wrong for _shallow_ -; handlers. -; -; Instead, what we need to be able to do is capture the continuation -; _up to_ the marks, then _discard_ the marks, and this is what the -; multiple delimiters accomplish. There might be more efficient ways -; to accomplish this with some specialized mark functions, but I'm -; uncertain of what pitfalls there are with regard to that (whehter -; they work might depend on exact frame structure of the -; metacontinuation). (define-syntax handle (syntax-rules () [(handle [r ...] h e ...) - (let ([p (make-prompt)]) - (prompt0-at p - (let ([v (let-marks (list r ...) (cons p h) - (prompt0-at p e ...))]) - (h (make-pure v)))))])) + (call-with-handler (list r ...) h (lambda () e ...))])) ; wrapper that more closely matches ability requests (define-syntax request diff --git a/scheme-libs/racket/unison/core.ss b/scheme-libs/racket/unison/core.ss index 0c6e85a59e..0985c20464 100644 --- a/scheme-libs/racket/unison/core.ss +++ b/scheme-libs/racket/unison/core.ss @@ -23,6 +23,7 @@ (struct-out exn:bug) let-marks + call-with-marks ref-mark chunked-string-foldMap-chunks @@ -192,6 +193,8 @@ (string-append "{Value " (describe-value v) "}")] [(unison-code v) (string-append "{Code " (describe-value v) "}")] + [(unison-cont-reflected fs) "{Continuation}"] + [(unison-cont-wrapped _) "{Continuation}"] [(unison-closure _ code env) (define dc (termlink->string (lookup-function-link code) #t)) @@ -437,13 +440,6 @@ ; [() '()] ; [(x . xs) (cons #'x (syntax->list #'xs))])) -(define (call-with-marks rs v f) - (cond - [(null? rs) (f)] - [else - (with-continuation-mark (car rs) v - (call-with-marks (cdr rs) v f))])) - (define-syntax let-marks (syntax-rules () [(let-marks ks bn e ...) diff --git a/scheme-libs/racket/unison/data.ss b/scheme-libs/racket/unison/data.ss index 02171a5411..a110be41f2 100644 --- a/scheme-libs/racket/unison/data.ss +++ b/scheme-libs/racket/unison/data.ss @@ -12,6 +12,12 @@ have-code? (struct-out unison-data) + (struct-out unison-continuation) + (struct-out unison-cont-wrapped) + (struct-out unison-cont-reflected) + (struct-out unison-frame) + (struct-out unison-frame-push) + (struct-out unison-frame-mark) (struct-out unison-sum) (struct-out unison-pure) (struct-out unison-request) @@ -27,6 +33,9 @@ (struct-out unison-quote) (struct-out unison-timespec) + call-with-handler + call-with-marks + define-builtin-link declare-builtin-link @@ -100,12 +109,15 @@ builtin-tls.version:typelink unison-tuple->list + unison-pair->cons typelink->string termlink->string) (require - racket + (rename-in racket + [make-continuation-prompt-tag make-prompt]) + (only-in racket/control prompt0-at control0-at) racket/fixnum (only-in "vector-trie.rkt" ->fx/wraparound) unison/bytevector) @@ -351,6 +363,115 @@ (list equal-proc (hash-proc 3) (hash-proc 5)))) +; This is the base struct for continuation representations. It has +; two possibilities seen below. +(struct unison-continuation () #:transparent) + +; This is a wrapper that allows for a struct representation of all +; continuations involved in unison. I.E. instead of just passing +; around a raw racket continuation, we wrap it in a box for easier +; identification. +(struct unison-cont-wrapped unison-continuation (cont) + ; Use the wrapped continuation for procedure calls. Continuations + ; will always be called via the jumpCont wrapper which exactly + ; applies them to one argument. + #:property prop:procedure 0) + +; Basic mechanism for installing handlers, defined here so that it +; can be used in the implementation of reflected continuations. +; +; Note: this uses the prompt _twice_ to achieve the sort of dynamic +; scoping we want. First we push an outer delimiter, then install +; the continuation marks corresponding to the handled abilities +; (which tells which propt to use for that ability and which +; functions to use for each request). Then we re-delimit by the same +; prompt. +; +; If we just used one delimiter, we'd have a problem. If we pushed +; the marks _after_ the delimiter, then the continuation captured +; when handling would contain those marks, and would effectively +; retain the handler for requests within the continuation. If the +; marks were outside the prompt, we'd be in a similar situation, +; except where the handler would be automatically handling requests +; within its own implementation (although, in both these cases we'd +; get control errors, because we would be using the _function_ part +; of the handler without the necessary delimiters existing on the +; continuation). Both of these situations are wrong for _shallow_ +; handlers. +; +; Instead, what we need to be able to do is capture the continuation +; _up to_ the marks, then _discard_ the marks, and this is what the +; multiple delimiters accomplish. There might be more efficient ways +; to accomplish this with some specialized mark functions, but I'm +; uncertain of what pitfalls there are with regard to that (whehter +; they work might depend on exact frame structure of the +; metacontinuation). +(define (call-with-handler rs h f) + (let ([p (make-prompt)]) + (prompt0-at p + (let ([v (call-with-marks rs (cons p h) + (lambda () (prompt0-at p (f))))]) + (h (make-pure v)))))) + +(define (call-with-marks rs v f) + (cond + [(null? rs) (f)] + [else + (with-continuation-mark (car rs) v + (call-with-marks (cdr rs) v f))])) + +; Version of the above for re-installing a handlers in the serialized +; format. In that case, there is an association list of links and +; handlers, rather than a single handler (although the separate +; handlers are likely duplicates). +(define (call-with-assoc-marks p hs f) + (match hs + ['() (f)] + [(cons (cons r h) rest) + (with-continuation-mark r (cons p h) + (call-with-assoc-marks rest f))])) + +(define (call-with-handler-assocs hs f) + (let ([p (make-prompt)]) + (prompt0-at p + (call-with-assoc-marks p hs + (lambda () (prompt0-at p (f))))))) + +(define (repush frames v) + (match frames + ['() v] + [(cons (unison-frame-mark as tls hs) frames) + ; handler frame; as are pending arguments, tls are typelinks + ; for handled abilities; hs are associations from links to + ; handler values. + ; + ; todo: args + (call-with-handler-assocs hs + (lambda () (repush frames v)))] + [(cons (unison-frame-push ls as rt) rest) + (displayln (list ls as rt)) + (raise "repush push: not implemented yet")])) + +; This is a *reflected* representation of continuations amenable +; to serialization. Most continuations won't be in this format, +; because it's foolish to eagerly parse the racket continuation if +; it's just going to be applied. But, a continuation that we've +; gotten from serialization will be in this format. +; +; `frames` should be a list of the below `unison-frame` structs. +(struct unison-cont-reflected unison-continuation (frames) + #:property prop:procedure + (lambda (cont v) (repush (unison-cont-reflected-frames cont) v))) + +; Stack frames for reflected continuations +(struct unison-frame () #:transparent) + +(struct unison-frame-push unison-frame + (locals args return-to)) + +(struct unison-frame-mark unison-frame + (args abilities handlers)) + (define-syntax (define-builtin-link stx) (syntax-case stx () [(_ name) @@ -561,6 +682,13 @@ [else (raise "unison-tuple->list: unexpected value")]))) +(define (unison-pair->cons t) + (match t + [(unison-data _ _ (list x (unison-data _ _ (list y _)))) + (cons x y)] + [else + (raise "unison-pair->cons: unexpected value")])) + (define (hash-string hs) (string-append "#" diff --git a/scheme-libs/racket/unison/primops-generated.rkt b/scheme-libs/racket/unison/primops-generated.rkt index 54bd9cd4c4..105d3ec205 100644 --- a/scheme-libs/racket/unison/primops-generated.rkt +++ b/scheme-libs/racket/unison/primops-generated.rkt @@ -210,20 +210,17 @@ (describe-value tl)))] [1 (rf) rf])) -(define-syntax make-group-ref-decoder - (lambda (stx) - (syntax-case stx () - [(_) - #`(lambda (gr) - (data-case (group-ref-ident gr) - [#,ref-schemeterm-ident:tag (name) name] - [else - (raise - (format - "decode-group-ref: unimplemented data case: ~a" - (describe-value gr)))]))]))) - -(define decode-group-ref (make-group-ref-decoder)) +(define (decode-group-ref gr0) + (match (group-ref-ident gr0) + [(unison-data _ t (list name)) + #:when (= t ref-schemeterm-ident:tag) + name] + [else + (raise + (format + "decode-group-ref: unimplemented data case: ~a" + (describe-value gr0)))])) + (define (group-ref-sym gr) (string->symbol (chunked-string->string @@ -316,6 +313,70 @@ [else (raise (format "decode-vlit: unimplemented case: !a" vl))])])) +(define (reify-handlers hs) + (for/list ([h (chunked-list->list hs)]) + (match (unison-pair->cons h) + [(cons r h) + (cons (reference->typelink r) + (reify-value h))]))) + +(define (reflect-handlers hs) + (list->chunked-list + (for/list ([h hs]) + (match h + [(cons r h) + (unison-tuple + (typelink->reference r) + (reflect-value h))])))) + +(define (reify-groupref gr0) + (match gr0 + [(unison-data _ t (list r i)) + #:when (= t ref-groupref-group:tag) + (cons (reference->typelink r) i)])) + +(define (reflect-groupref rt) + (match rt + [(cons l i) + (ref-groupref-group (typelink->reference l) i)])) + +(define (parse-continuation orig k0 vs0) + (let rec ([k k0] [vs vs0] [frames '()]) + (match k + [(unison-data _ t (list)) + #:when (= t ref-cont-empty:tag) + (unison-cont-reflected (reverse frames))] + [(unison-data _ t (list l a gr0 k)) + #:when (= t ref-cont-push:tag) + (cond + [(>= (length vs) (+ l a)) + (let*-values + ([(locals int) (split-at vs l)] + [(args rest) (split-at int a)] + [(gr) (reify-groupref gr0)] + [(fm) (unison-frame-push locals args gr)]) + (rec k rest (cons fm frames)))] + [else + (raise + (make-exn:bug + "reify-value: malformed continuation" + orig))])] + [(unison-data _ t (list a rs0 de0 k)) + #:when (= t ref-cont-mark:tag) + (cond + [(>= (length vs) a) + (let*-values + ([(args rest) (split-at vs a)] + [(rs) (map reference->termlink (chunked-list->list rs0))] + [(hs) (reify-handlers de0)] + [(fm) (unison-frame-mark args rs hs)]) + (rec k rest (cons fm frames)))] + [else + (raise + (make-exn:bug + "reify-value: malformed continuation" + orig))])]))) + (define (reify-value v) (match v [(unison-data _ t (list rf rt bs0)) @@ -342,16 +403,14 @@ #:when (= t ref-value-partial:tag) (let ([bs (map reify-value (chunked-list->list bs0))] [proc (resolve-proc gr)]) - (apply proc bs))] + (struct-copy unison-closure proc [env bs]))] [(unison-data _ t (list vl)) #:when (= t ref-value-vlit:tag) (reify-vlit vl)] - [(unison-data _ t (list bs0 k)) + [(unison-data _ t (list vs0 k)) #:when (= t ref-value-cont:tag) - (raise - (make-exn:bug - "reify-value: unimplemented cont case" - ref-unit-unit))] + (parse-continuation v k + (map reify-value (chunked-list->list vs0)))] [(unison-data r t fs) (raise (make-exn:bug @@ -428,14 +487,34 @@ (ref-value-vlit (ref-vlit-typelink (reflect-typelink v)))] [(unison-code sg) (ref-value-vlit (ref-vlit-code sg))] [(unison-quote q) (ref-value-vlit (ref-vlit-quote q))] + [(unison-cont-reflected frames0) + (for/foldr ([k ref-cont-empty] + [vs '()] + #:result + (ref-value-cont + (list->chunked-list (map reflect-value vs)) + k)) + ([frame frames0]) + (match frame + [(unison-frame-push locals args return-to) + (values + (ref-cont-push + (length locals) + (length args) + (reflect-groupref return-to) + k) + (append locals args vs))] + [(unison-frame-mark args refs hs) + (values + (ref-cont-mark + (length args) + (map typelink->reference refs) + (reflect-handlers hs)) + (append args vs))]))] [(unison-closure arity f as) (ref-value-partial (function->groupref f) (list->chunked-list (map reflect-value as)))] - [(? procedure?) - (ref-value-partial - (function->groupref v) - empty-chunked-list)] [(unison-data rf t fs) (ref-value-data (reflect-typelink rf) From cf1baee5236d49058bc1165f471e99b7ce02e1c9 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 26 Jun 2024 15:31:30 -0400 Subject: [PATCH 282/631] add debug.alias.type.force --- .../src/Unison/Codebase/Editor/HandleInput.hs | 10 ++--- .../src/Unison/Codebase/Editor/Input.hs | 2 +- .../src/Unison/CommandLine/InputPatterns.hs | 24 ++++++++-- unison-src/transcripts/alias-type.md | 28 ++++++++++++ unison-src/transcripts/alias-type.output.md | 44 +++++++++++++++++++ 5 files changed, 98 insertions(+), 10 deletions(-) create mode 100644 unison-src/transcripts/alias-type.md create mode 100644 unison-src/transcripts/alias-type.output.md diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 45efd7b338..639eaa27ea 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -494,7 +494,7 @@ loop e = do description <- inputDescription input Cli.stepAt description (BranchUtil.makeAddTermName (first Path.unabsolute dest) srcTerm) Cli.respond Success - AliasTypeI src' dest' -> do + AliasTypeI force src' dest' -> do src <- traverseOf _Right Cli.resolveSplit' src' srcTypes <- either @@ -512,7 +512,7 @@ loop e = do pure (DeleteNameAmbiguous hqLength name Set.empty srcTypes) dest <- Cli.resolveSplit' dest' destTypes <- Cli.getTypesAt (HQ'.NameOnly <$> dest) - when (not (Set.null destTypes)) do + when (not force && not (Set.null destTypes)) do Cli.returnEarly (TypeAlreadyExists dest' destTypes) description <- inputDescription input Cli.stepAt description (BranchUtil.makeAddTypeName (first Path.unabsolute dest) srcType) @@ -980,11 +980,11 @@ inputDescription input = AliasTermI force src0 dest0 -> do src <- hhqs' src0 dest <- ps' dest0 - pure ((if force then "alias.term.force " else "alias.term ") <> src <> " " <> dest) - AliasTypeI src0 dest0 -> do + pure ((if force then "debug.alias.term.force " else "alias.term ") <> src <> " " <> dest) + AliasTypeI force src0 dest0 -> do src <- hhqs' src0 dest <- ps' dest0 - pure ("alias.type " <> src <> " " <> dest) + pure ((if force then "debug.alias.type.force " else "alias.term ") <> src <> " " <> dest) AliasManyI srcs0 dest0 -> do srcs <- traverse hqs srcs0 dest <- p' dest0 diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 8dc38bb14d..86ecb38491 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -133,7 +133,7 @@ data Input -- > names #sdflkjsdfhsdf NamesI IsGlobal (HQ.HashQualified Name) | AliasTermI !Bool HashOrHQSplit' Path.Split' -- bool = force? - | AliasTypeI HashOrHQSplit' Path.Split' + | AliasTypeI !Bool HashOrHQSplit' Path.Split' -- bool = force? | AliasManyI [Path.HQSplit] Path' | MoveAllI Path.Path' Path.Path' | -- Move = Rename; It's an HQSplit' not an HQSplit', meaning the arg has to have a name. diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 7b395659a0..31fcd41ae6 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1392,8 +1392,8 @@ aliasTerm = _ -> Left . warn $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`." } -aliasTermForce :: InputPattern -aliasTermForce = +debugAliasTermForce :: InputPattern +debugAliasTermForce = InputPattern { patternName = "debug.alias.term.force", aliases = [], @@ -1416,9 +1416,24 @@ aliasType = [("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)] "`alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`." \case - [oldName, newName] -> Input.AliasTypeI <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + [oldName, newName] -> Input.AliasTypeI False <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName _ -> Left . warn $ P.wrap "`alias.type` takes two arguments, like `alias.type oldname newname`." +debugAliasTypeForce :: InputPattern +debugAliasTypeForce = + InputPattern + { patternName = "debug.alias.type.force", + aliases = [], + visibility = I.Hidden, + args = [("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)], + help = "`debug.alias.type.force Foo Bar` introduces `Bar` with the same definition as `Foo`.", + parse = \case + [oldName, newName] -> Input.AliasTypeI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + _ -> + Left . warn $ + P.wrap "`debug.alias.type.force` takes two arguments, like `debug.alias.type.force oldname newname`." + } + aliasMany :: InputPattern aliasMany = InputPattern @@ -3299,7 +3314,6 @@ validInputs = [ add, aliasMany, aliasTerm, - aliasTermForce, aliasType, api, authLogin, @@ -3313,6 +3327,8 @@ validInputs = clone, compileScheme, createAuthor, + debugAliasTermForce, + debugAliasTypeForce, debugClearWatchCache, debugDoctor, debugDumpNamespace, diff --git a/unison-src/transcripts/alias-type.md b/unison-src/transcripts/alias-type.md new file mode 100644 index 0000000000..b167daa2cc --- /dev/null +++ b/unison-src/transcripts/alias-type.md @@ -0,0 +1,28 @@ +`alias.type` makes a new name for a type. + +```ucm:hide +project/main> builtins.mergeio lib.builtins +``` + +```ucm +project/main> alias.type lib.builtins.Nat Foo +project/main> ls +``` + +It won't create a conflicted name, though. + +```ucm:error +project/main> alias.type lib.builtins.Int Foo +``` + +```ucm +project/main> ls +``` + +You can use `debug.alias.type.force` for that. + +```ucm +project/main> debug.alias.type.force lib.builtins.Int Foo +project/main> ls +``` + diff --git a/unison-src/transcripts/alias-type.output.md b/unison-src/transcripts/alias-type.output.md new file mode 100644 index 0000000000..820c817614 --- /dev/null +++ b/unison-src/transcripts/alias-type.output.md @@ -0,0 +1,44 @@ +`alias.type` makes a new name for a type. + +```ucm +project/main> alias.type lib.builtins.Nat Foo + + Done. + +project/main> ls + + 1. Foo (builtin type) + 2. lib/ (643 terms, 92 types) + +``` +It won't create a conflicted name, though. + +```ucm +project/main> alias.type lib.builtins.Int Foo + + ⚠️ + + A type by that name already exists. + +``` +```ucm +project/main> ls + + 1. Foo (builtin type) + 2. lib/ (643 terms, 92 types) + +``` +You can use `debug.alias.type.force` for that. + +```ucm +project/main> debug.alias.type.force lib.builtins.Int Foo + + Done. + +project/main> ls + + 1. Foo (builtin type) + 2. Foo (builtin type) + 3. lib/ (643 terms, 92 types) + +``` From 2cb85ae5df6633a7f4c5fe3d3fdf131227bae86d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 12:42:58 -0700 Subject: [PATCH 283/631] Fix up transcripts which mention __projects --- .../namespace-dependencies.output.md | 25 ------------ unison-src/transcripts/add-run.md | 6 +-- unison-src/transcripts/add-run.output.md | 12 +++--- unison-src/transcripts/api-find.md | 8 ++-- unison-src/transcripts/api-find.output.md | 40 +++++++++---------- unison-src/transcripts/bug-strange-closure.md | 18 ++++----- .../transcripts/bug-strange-closure.output.md | 20 ++++------ .../fix1709.md | 0 .../fix1709.output.md | 5 +-- .../namespace-dependencies.md | 3 +- .../namespace-dependencies.output.md | 27 +++++++++++++ 11 files changed, 77 insertions(+), 87 deletions(-) delete mode 100644 unison-src/transcripts-using-base/namespace-dependencies.output.md rename unison-src/{transcripts-using-base => transcripts}/fix1709.md (100%) rename unison-src/{transcripts-using-base => transcripts}/fix1709.output.md (79%) rename unison-src/{transcripts-using-base => transcripts}/namespace-dependencies.md (65%) create mode 100644 unison-src/transcripts/namespace-dependencies.output.md diff --git a/unison-src/transcripts-using-base/namespace-dependencies.output.md b/unison-src/transcripts-using-base/namespace-dependencies.output.md deleted file mode 100644 index 783dbad848..0000000000 --- a/unison-src/transcripts-using-base/namespace-dependencies.output.md +++ /dev/null @@ -1,25 +0,0 @@ -# namespace.dependencies command - -```unison -external.mynat = 1 -mynamespace.dependsOnText = external.mynat Nat.+ 10 -``` - -```ucm -.> add - - ⍟ I've added these definitions: - - external.mynat : Nat - mynamespace.dependsOnText : Nat - -.mynamespace> namespace.dependencies - - External dependency Dependents in .mynamespace - .__projects._f873814e_abb9_4340_a9ac_dc6afc8ecb35.branches._044aa60c_f8bb_4d48_8a31_7be34331fa69.builtin.Nat 1. dependsOnText - - .__projects._f873814e_abb9_4340_a9ac_dc6afc8ecb35.branches._044aa60c_f8bb_4d48_8a31_7be34331fa69.builtin.Nat.+ 1. dependsOnText - - .external.mynat 1. dependsOnText - -``` diff --git a/unison-src/transcripts/add-run.md b/unison-src/transcripts/add-run.md index 07fe99216d..3eeea7c031 100644 --- a/unison-src/transcripts/add-run.md +++ b/unison-src/transcripts/add-run.md @@ -123,7 +123,7 @@ main = '5 ``` ```ucm -scratch/main> run main -scratch/main> add.run .an.absolute.name -scratch/main> view .an.absolute.name +.> run main +.> add.run .an.absolute.name +.> view .an.absolute.name ``` diff --git a/unison-src/transcripts/add-run.output.md b/unison-src/transcripts/add-run.output.md index a4382a4b71..53cc27b943 100644 --- a/unison-src/transcripts/add-run.output.md +++ b/unison-src/transcripts/add-run.output.md @@ -290,21 +290,19 @@ main = '5 ``` ```ucm -scratch/main> run main +.> run main 5 -scratch/main> add.run .an.absolute.name +.> add.run .an.absolute.name ⍟ I've added these definitions: .an.absolute.name : Nat -scratch/main> view .an.absolute.name +.> view .an.absolute.name - .__projects._184d2977_a0ad_4969_9ec6_6c49b9f2cb01.branches._9f1d1b83_958a_42b7_a36c_7178447a7820.an.absolute.name : - Nat - .__projects._184d2977_a0ad_4969_9ec6_6c49b9f2cb01.branches._9f1d1b83_958a_42b7_a36c_7178447a7820.an.absolute.name = - 5 + .an.absolute.name : Nat + .an.absolute.name = 5 ``` diff --git a/unison-src/transcripts/api-find.md b/unison-src/transcripts/api-find.md index cf394bd6b6..f11d98bfcb 100644 --- a/unison-src/transcripts/api-find.md +++ b/unison-src/transcripts/api-find.md @@ -13,14 +13,14 @@ scratch/main> add ```api -- Namespace segment prefix search -GET /api/non-project-code/find?query=http +GET /api/projects/scratch/branches/main/find?query=http -- Namespace segment suffix search -GET /api/non-project-code/find?query=Server +GET /api/projects/scratch/branches/main/find?query=Server -- Substring search -GET /api/non-project-code/find?query=lesys +GET /api/projects/scratch/branches/main/find?query=lesys -- Cross-segment search -GET /api/non-project-code/find?query=joey.http +GET /api/projects/scratch/branches/main/find?query=joey.http ``` diff --git a/unison-src/transcripts/api-find.output.md b/unison-src/transcripts/api-find.output.md index 0c18ae91d5..d44200e7a2 100644 --- a/unison-src/transcripts/api-find.output.md +++ b/unison-src/transcripts/api-find.output.md @@ -36,14 +36,14 @@ scratch/main> add ``` ```api -- Namespace segment prefix search -GET /api/non-project-code/find?query=http +GET /api/projects/scratch/branches/main/find?query=http [ [ { "result": { "segments": [ { - "contents": "__projects._4fce1d94_a201_41dc_a510_587d6a61186d.branches._d229dbff_a479_40a3_82f9_17fa36448d18.ross.", + "contents": "ross.", "tag": "Gap" }, { @@ -56,14 +56,14 @@ GET /api/non-project-code/find?query=http } ] }, - "score": 170 + "score": 156 }, { "contents": { "bestFoundTermName": "y", "namedTerm": { "termHash": "#emomp74i93h6ps0b5sukke0tci0ooba3f9jk21qm919a7act9u7asani84c0mqbdk4lcjrdvr9olpedp23p6df78r4trqlg0cciadc8", - "termName": "__projects._4fce1d94_a201_41dc_a510_587d6a61186d.branches._d229dbff_a479_40a3_82f9_17fa36448d18.ross.httpClient.y", + "termName": "ross.httpClient.y", "termTag": "Plain", "termType": [ { @@ -84,7 +84,7 @@ GET /api/non-project-code/find?query=http "result": { "segments": [ { - "contents": "__projects._4fce1d94_a201_41dc_a510_587d6a61186d.branches._d229dbff_a479_40a3_82f9_17fa36448d18.joey.", + "contents": "joey.", "tag": "Gap" }, { @@ -97,14 +97,14 @@ GET /api/non-project-code/find?query=http } ] }, - "score": 170 + "score": 156 }, { "contents": { "bestFoundTermName": "z", "namedTerm": { "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "__projects._4fce1d94_a201_41dc_a510_587d6a61186d.branches._d229dbff_a479_40a3_82f9_17fa36448d18.joey.httpServer.z", + "termName": "joey.httpServer.z", "termTag": "Plain", "termType": [ { @@ -122,14 +122,14 @@ GET /api/non-project-code/find?query=http ] ] -- Namespace segment suffix search -GET /api/non-project-code/find?query=Server +GET /api/projects/scratch/branches/main/find?query=Server [ [ { "result": { "segments": [ { - "contents": "__projects._4fce1d94_a201_41dc_a510_587d6a61186d.branches._d229dbff_a479_40a3_82f9_17fa36448d18.joey.http", + "contents": "joey.http", "tag": "Gap" }, { @@ -142,14 +142,14 @@ GET /api/non-project-code/find?query=Server } ] }, - "score": 230 + "score": 223 }, { "contents": { "bestFoundTermName": "z", "namedTerm": { "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "__projects._4fce1d94_a201_41dc_a510_587d6a61186d.branches._d229dbff_a479_40a3_82f9_17fa36448d18.joey.httpServer.z", + "termName": "joey.httpServer.z", "termTag": "Plain", "termType": [ { @@ -167,14 +167,14 @@ GET /api/non-project-code/find?query=Server ] ] -- Substring search -GET /api/non-project-code/find?query=lesys +GET /api/projects/scratch/branches/main/find?query=lesys [ [ { "result": { "segments": [ { - "contents": "__projects._4fce1d94_a201_41dc_a510_587d6a61186d.branches._d229dbff_a479_40a3_82f9_17fa36448d18.rachel.fi", + "contents": "rachel.fi", "tag": "Gap" }, { @@ -187,14 +187,14 @@ GET /api/non-project-code/find?query=lesys } ] }, - "score": 185 + "score": 175 }, { "contents": { "bestFoundTermName": "x", "namedTerm": { "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "termName": "__projects._4fce1d94_a201_41dc_a510_587d6a61186d.branches._d229dbff_a479_40a3_82f9_17fa36448d18.rachel.filesystem.x", + "termName": "rachel.filesystem.x", "termTag": "Plain", "termType": [ { @@ -212,16 +212,12 @@ GET /api/non-project-code/find?query=lesys ] ] -- Cross-segment search -GET /api/non-project-code/find?query=joey.http +GET /api/projects/scratch/branches/main/find?query=joey.http [ [ { "result": { "segments": [ - { - "contents": "__projects._4fce1d94_a201_41dc_a510_587d6a61186d.branches._d229dbff_a479_40a3_82f9_17fa36448d18.", - "tag": "Gap" - }, { "contents": "joey.http", "tag": "Match" @@ -232,14 +228,14 @@ GET /api/non-project-code/find?query=joey.http } ] }, - "score": 333 + "score": 300 }, { "contents": { "bestFoundTermName": "z", "namedTerm": { "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "__projects._4fce1d94_a201_41dc_a510_587d6a61186d.branches._d229dbff_a479_40a3_82f9_17fa36448d18.joey.httpServer.z", + "termName": "joey.httpServer.z", "termTag": "Plain", "termType": [ { diff --git a/unison-src/transcripts/bug-strange-closure.md b/unison-src/transcripts/bug-strange-closure.md index bfce3c1422..f2f805d682 100644 --- a/unison-src/transcripts/bug-strange-closure.md +++ b/unison-src/transcripts/bug-strange-closure.md @@ -1,15 +1,15 @@ ```ucm:hide -scratch/main> builtins.mergeio -scratch/main> load unison-src/transcripts-using-base/doc.md.files/syntax.u +.> builtins.mergeio +.> load unison-src/transcripts-using-base/doc.md.files/syntax.u ``` We can display the guide before and after adding it to the codebase: ```ucm -scratch/main> display doc.guide -scratch/main> add -scratch/main> display doc.guide +.> display doc.guide +.> add +.> display doc.guide ``` But we can't display this due to a decompilation problem. @@ -19,10 +19,10 @@ rendered = Pretty.get (docFormatConsole doc.guide) ``` ```ucm -scratch/main> display rendered -scratch/main> add -scratch/main> display rendered -scratch/main> undo +.> display rendered +.> add +.> display rendered +.> undo ``` And then this sometimes generates a GHC crash "strange closure error" but doesn't seem deterministic. diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md index 5404081977..8b9f7fa75c 100644 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ b/unison-src/transcripts/bug-strange-closure.output.md @@ -2,7 +2,7 @@ We can display the guide before and after adding it to the codebase: ```ucm -scratch/main> display doc.guide +.> display doc.guide # Unison computable documentation @@ -200,7 +200,7 @@ scratch/main> display doc.guide rendered table. Some text More text Zounds! -scratch/main> add +.> add ⍟ I've added these definitions: @@ -213,7 +213,7 @@ scratch/main> add otherElements : Doc2 sqr : Nat -> Nat -scratch/main> display doc.guide +.> display doc.guide # Unison computable documentation @@ -432,7 +432,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) ``` ```ucm -scratch/main> display rendered +.> display rendered # Unison computable documentation @@ -630,13 +630,13 @@ scratch/main> display rendered rendered table. Some text More text Zounds! -scratch/main> add +.> add ⍟ I've added these definitions: rendered : Annotated () (Either SpecialForm ConsoleText) -scratch/main> display rendered +.> display rendered # Unison computable documentation @@ -834,17 +834,13 @@ scratch/main> display rendered rendered table. Some text More text Zounds! -scratch/main> undo +.> undo Here are the changes I undid Added definitions: - 1. __projects._567e16f7_c03b_4435_9ed7_2845d81ba835.branches._b666e957_74dc_4635_9d58_9ed04d0d29c9.rendered : Annotated - ( ) - (Either - SpecialForm - ConsoleText) + 1. rendered : Annotated () (Either SpecialForm ConsoleText) ``` And then this sometimes generates a GHC crash "strange closure error" but doesn't seem deterministic. diff --git a/unison-src/transcripts-using-base/fix1709.md b/unison-src/transcripts/fix1709.md similarity index 100% rename from unison-src/transcripts-using-base/fix1709.md rename to unison-src/transcripts/fix1709.md diff --git a/unison-src/transcripts-using-base/fix1709.output.md b/unison-src/transcripts/fix1709.output.md similarity index 79% rename from unison-src/transcripts-using-base/fix1709.output.md rename to unison-src/transcripts/fix1709.output.md index dd8b899c4f..8523d4e27b 100644 --- a/unison-src/transcripts-using-base/fix1709.output.md +++ b/unison-src/transcripts/fix1709.output.md @@ -17,18 +17,15 @@ id2 x = ⍟ These new definitions are ok to `add`: id : x -> x - (also named - __projects._c5503e83_aeeb_41a5_a993_a5710c894730.branches._760add7e_4d96_4853_9fd0_7461aa7775ee.id) id2 : x -> x ``` ```ucm scratch/main> add - ⊡ Ignored previously added definitions: id - ⍟ I've added these definitions: + id : x -> x id2 : x -> x ``` diff --git a/unison-src/transcripts-using-base/namespace-dependencies.md b/unison-src/transcripts/namespace-dependencies.md similarity index 65% rename from unison-src/transcripts-using-base/namespace-dependencies.md rename to unison-src/transcripts/namespace-dependencies.md index d338c05432..0e8223a6cc 100644 --- a/unison-src/transcripts-using-base/namespace-dependencies.md +++ b/unison-src/transcripts/namespace-dependencies.md @@ -1,8 +1,9 @@ # namespace.dependencies command ```unison:hide +const a b = a external.mynat = 1 -mynamespace.dependsOnText = external.mynat Nat.+ 10 +mynamespace.dependsOnText = const external.mynat 10 ``` ```ucm diff --git a/unison-src/transcripts/namespace-dependencies.output.md b/unison-src/transcripts/namespace-dependencies.output.md new file mode 100644 index 0000000000..0e7d298262 --- /dev/null +++ b/unison-src/transcripts/namespace-dependencies.output.md @@ -0,0 +1,27 @@ +# namespace.dependencies command + +```unison +const a b = a +external.mynat = 1 +mynamespace.dependsOnText = const external.mynat 10 +``` + +```ucm +.> add + + ⍟ I've added these definitions: + + const : a -> b -> a + external.mynat : ##Nat + mynamespace.dependsOnText : ##Nat + +.mynamespace> namespace.dependencies + + External dependency Dependents in .mynamespace + ##Nat 1. dependsOnText + + .const 1. dependsOnText + + .external.mynat 1. dependsOnText + +``` From f1fd05f03dfd11732e8fa5472ba8c1b09beec827 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 26 Jun 2024 14:31:49 -0600 Subject: [PATCH 284/631] Add a failing transcript for #5080 --- unison-src/transcripts/fix5080.md | 18 ++++ unison-src/transcripts/fix5080.output.md | 111 +++++++++++++++++++++++ 2 files changed, 129 insertions(+) create mode 100644 unison-src/transcripts/fix5080.md create mode 100644 unison-src/transcripts/fix5080.output.md diff --git a/unison-src/transcripts/fix5080.md b/unison-src/transcripts/fix5080.md new file mode 100644 index 0000000000..4c80c07602 --- /dev/null +++ b/unison-src/transcripts/fix5080.md @@ -0,0 +1,18 @@ +```ucm +.> project.create test-5080 +``` + +```unison +test> fix5080.tests.success = check (6 Nat.== 6) +test> fix5080.tests.failure = check (2 Nat.== 4) +``` + +```ucm:error +test-5080/main> add +test-5080/main> test +``` + +```ucm +test-5080/main> delete.term 2 +test-5080/main> test +``` diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md new file mode 100644 index 0000000000..b39894f7d2 --- /dev/null +++ b/unison-src/transcripts/fix5080.output.md @@ -0,0 +1,111 @@ +```ucm +.> project.create test-5080 + + 🎉 I've created the project test-5080. + + I'll now fetch the latest version of the base Unison + library... + + Downloaded 14053 entities. + + 🎨 Type `ui` to explore this project's code in your browser. + 🔭 Discover libraries at https://share.unison-lang.org + 📖 Use `help-topic projects` to learn more about projects. + + Write your first Unison code with UCM: + + 1. Open scratch.u. + 2. Write some Unison code and save the file. + 3. In UCM, type `add` to save it to your new project. + + 🎉 🥳 Happy coding! + +``` +```unison +test> fix5080.tests.success = check (6 Nat.== 6) +test> fix5080.tests.failure = check (2 Nat.== 4) +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + fix5080.tests.failure : [Result] + fix5080.tests.success : [Result] + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | test> fix5080.tests.success = check (6 Nat.== 6) + + ✅ Passed Passed + + 2 | test> fix5080.tests.failure = check (2 Nat.== 4) + + 🚫 FAILED Failed + +``` +```ucm +test-5080/main> add + + ⍟ I've added these definitions: + + fix5080.tests.failure : [Result] + fix5080.tests.success : [Result] + +test-5080/main> test + + Cached test results (`help testcache` to learn more) + + ◉ fix5080.tests.success Passed + + ✗ fix5080.tests.failure Failed + + 🚫 1 test(s) failing, ✅ 1 test(s) passing + + Tip: Use view fix5080.tests.failure to view the source of a + test. + +``` +```ucm +test-5080/main> delete.term 2 + +test-5080/main> test + + Cached test results (`help testcache` to learn more) + + ◉ fix5080.tests.success Passed + + ✗ fix5080.tests.failure Failed + + 🚫 1 test(s) failing, ✅ 1 test(s) passing + + Tip: Use view fix5080.tests.failure to view the source of a + test. + +``` + + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + + + Cached test results (`help testcache` to learn more) + + ◉ fix5080.tests.success Passed + + ✗ fix5080.tests.failure Failed + + 🚫 1 test(s) failing, ✅ 1 test(s) passing + + Tip: Use view fix5080.tests.failure to view the source of a + test. + From 77b46bce29936c516a365f4f3650a2e9051dc99a Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 26 Jun 2024 10:45:27 -0600 Subject: [PATCH 285/631] Eliminate `Path.unsafeToName` In every case, this was being used in conjunction with `unsplitHQ`. So this replaces `unsplitHQ` with `nameFromHQSplit`, which avoids converting the `Split` to a `Path` in the middle. --- .../src/Unison/Codebase/Path.hs | 26 +++++-------------- .../src/Unison/Codebase/Editor/HandleInput.hs | 18 ++++++++----- .../src/Unison/CommandLine/OutputMessages.hs | 2 +- 3 files changed, 18 insertions(+), 28 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Path.hs b/parser-typechecker/src/Unison/Codebase/Path.hs index 3c20dcd852..e97a93ce8c 100644 --- a/parser-typechecker/src/Unison/Codebase/Path.hs +++ b/parser-typechecker/src/Unison/Codebase/Path.hs @@ -56,15 +56,13 @@ module Unison.Codebase.Path toList, toName, toName', - unsafeToName, - unsafeToName', toText, toText', unsplit, unsplit', unsplitAbsolute, - unsplitHQ, - unsplitHQ', + nameFromHQSplit, + nameFromHQSplit', nameFromSplit', splitFromName, splitFromName', @@ -171,11 +169,11 @@ unsplitAbsolute :: (Absolute, NameSegment) -> Absolute unsplitAbsolute = coerce unsplit -unsplitHQ :: HQSplit -> HQ'.HashQualified Path -unsplitHQ (p, a) = fmap (snoc p) a +nameFromHQSplit :: HQSplit -> HQ'.HashQualified Name +nameFromHQSplit = nameFromHQSplit' . first (RelativePath' . Relative) -unsplitHQ' :: HQSplit' -> HQ'.HashQualified Path' -unsplitHQ' (p, a) = fmap (snoc' p) a +nameFromHQSplit' :: HQSplit' -> HQ'.HashQualified Name +nameFromHQSplit' (p, a) = fmap (nameFromSplit' . (p,)) a type Split = (Path, NameSegment) @@ -316,9 +314,6 @@ cons = Lens.cons snoc :: Path -> NameSegment -> Path snoc = Lens.snoc -snoc' :: Path' -> NameSegment -> Path' -snoc' = Lens.snoc - unsnoc :: Path -> Maybe (Path, NameSegment) unsnoc = Lens.unsnoc @@ -344,15 +339,6 @@ fromName' n where path = fromName n -unsafeToName :: Path -> Name -unsafeToName = - fromMaybe (error "empty path") . toName - --- | Convert a Path' to a Name -unsafeToName' :: Path' -> Name -unsafeToName' = - fromMaybe (error "empty path") . toName' - toName :: Path -> Maybe Name toName = \case Path Seq.Empty -> Nothing diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 4f883a9c8b..94be7f5fac 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -77,7 +77,6 @@ import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper) import Unison.Codebase.Editor.HandleInput.ProjectClone (handleClone) import Unison.Codebase.Editor.HandleInput.ProjectCreate (projectCreate) import Unison.Codebase.Editor.HandleInput.ProjectRename (handleProjectRename) -import Unison.Codebase.Editor.HandleInput.Todo (handleTodo) import Unison.Codebase.Editor.HandleInput.ProjectSwitch (projectSwitch) import Unison.Codebase.Editor.HandleInput.Projects (handleProjects) import Unison.Codebase.Editor.HandleInput.Pull (handlePull, mergeBranchAndPropagateDefaultPatch) @@ -88,6 +87,7 @@ import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions) import Unison.Codebase.Editor.HandleInput.TermResolution (resolveMainRef) import Unison.Codebase.Editor.HandleInput.Tests qualified as Tests +import Unison.Codebase.Editor.HandleInput.Todo (handleTodo) import Unison.Codebase.Editor.HandleInput.UI (openUI) import Unison.Codebase.Editor.HandleInput.Update (doSlurpAdds, handleUpdate) import Unison.Codebase.Editor.HandleInput.Update2 (handleUpdate2) @@ -104,7 +104,6 @@ import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.Codebase.IntegrityCheck qualified as IntegrityCheck (integrityCheckFullCodebase) import Unison.Codebase.Metadata qualified as Metadata import Unison.Codebase.Path (Path, Path' (..)) -import Unison.Codebase.Path qualified as HQSplit' import Unison.Codebase.Path qualified as Path import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash qualified as SCH @@ -119,7 +118,6 @@ import Unison.DataDeclaration qualified as DD import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' -import Unison.HashQualified' qualified as HashQualified import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.LabeledDependency qualified as LabeledDependency @@ -574,7 +572,7 @@ loop e = do (Just as1, Just as2) -> (missingSrcs, actions ++ as1 ++ as2) fixupOutput :: Path.HQSplit -> HQ.HashQualified Name - fixupOutput = fmap Path.unsafeToName . HQ'.toHQ . Path.unsplitHQ + fixupOutput = HQ'.toHQ . Path.nameFromHQSplit NamesI global query -> do hqLength <- Cli.runTransaction Codebase.hashLength root <- Cli.getRootBranch @@ -659,7 +657,7 @@ loop e = do description <- inputDescription input let toDelete = Names.prefix0 - (Path.unsafeToName (Path.unsplit (p))) + (Path.nameFromSplit' $ first (Path.RelativePath' . Path.Relative) p) (Branch.toNames (Branch.head branch)) afterDelete <- do names <- Cli.currentNames @@ -1540,7 +1538,7 @@ delete input doutput getTerms getTypes hqs' = do then do let toName :: [(Path.HQSplit', Set Reference, Set referent)] -> [Name] toName notFounds = - mapMaybe (\(split, _, _) -> Path.toName' $ HashQualified.toName (HQSplit'.unsplitHQ' split)) notFounds + map (\(split, _, _) -> HQ'.toName $ Path.nameFromHQSplit' split) notFounds Cli.returnEarly $ NamesNotFound (toName notFounds) else do checkDeletes typesTermsTuple doutput input @@ -1551,8 +1549,14 @@ checkDeletes typesTermsTuples doutput inputs = do (Path.HQSplit', Set Reference, Set Referent) -> Cli (Path.Split, Name, Set Reference, Set Referent) toSplitName hq = do + -- __FIXME__: `resolvedPath` is ostensiby `Absolute`, but the paths here must be `Relative` below resolvedPath <- first Path.unabsolute <$> Cli.resolveSplit' (HQ'.toName <$> hq ^. _1) - return (resolvedPath, Path.unsafeToName (Path.unsplit resolvedPath), hq ^. _2, hq ^. _3) + return + ( resolvedPath, + Path.nameFromSplit' $ first (Path.RelativePath' . Path.Relative) resolvedPath, + hq ^. _2, + hq ^. _3 + ) -- get the splits and names with terms and types splitsNames <- traverse toSplitName typesTermsTuples let toRel :: (Ord ref) => Set ref -> Name -> R.Relation Name ref diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 87e06282d0..a121326605 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1199,7 +1199,7 @@ notifyUser dir = \case ] where name :: Name - name = Path.unsafeToName' (HQ'.toName (Path.unsplitHQ' p)) + name = HQ'.toName $ Path.nameFromHQSplit' p qualifyTerm :: Referent -> Pretty qualifyTerm = P.syntaxToColor . prettyNamedReferent hashLen name qualifyType :: Reference -> Pretty From afa4b03f73fe5b7103e095cc34cda4c80111df1f Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 26 Jun 2024 13:50:49 -0600 Subject: [PATCH 286/631] Make `TestResult` a `NumberedOutput` Fixes #5080. --- .../src/Unison/Util/Pretty.hs | 14 ++-- .../Codebase/Editor/HandleInput/Tests.hs | 10 +-- .../src/Unison/Codebase/Editor/Output.hs | 16 ++-- .../src/Unison/CommandLine/OutputMessages.hs | 80 +++++++++---------- 4 files changed, 59 insertions(+), 61 deletions(-) diff --git a/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs b/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs index c19c030142..6f04fc1976 100644 --- a/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs +++ b/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs @@ -78,7 +78,7 @@ module Unison.Util.Pretty lineSkip, nonEmpty, numbered, - numberedColumn2, + numberedColumn2ListFrom, numberedColumn2Header, numberedColumnNHeader, numberedList, @@ -544,12 +544,12 @@ numberedHeader num ps = column2 (fmap num (Nothing : fmap Just [1 ..]) `zip` toL -- 1. one thing : this is a thing -- 2. another thing : this is another thing -- 3. and another : yet one more thing -numberedColumn2 :: - (Foldable f, LL.ListLike s Char, IsString s) => - (Int -> Pretty s) -> - f (Pretty s, Pretty s) -> - Pretty s -numberedColumn2 num ps = numbered num (align $ toList ps) +numberedColumn2ListFrom :: + (Foldable f) => + Int -> + f (Pretty ColorText, Pretty ColorText) -> + Pretty ColorText +numberedColumn2ListFrom num ps = numberedListFrom num (align $ toList ps) numberedColumn2Header :: (Foldable f, LL.ListLike s Char, IsString s) => diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs index 3eb3658004..b1c9f72d5c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs @@ -91,7 +91,7 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} = names <- Cli.currentNames pped <- Cli.prettyPrintEnvDeclFromNames names let fqnPPE = PPED.unsuffixifiedPPE pped - Cli.respond $ + Cli.respondNumbered $ TestResults stats fqnPPE @@ -124,7 +124,7 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} = let m = Map.fromList computedTests (mOks, mFails) = passFails m - Cli.respond $ TestResults Output.NewlyComputed fqnPPE showSuccesses showFailures mOks mFails + Cli.respondNumbered $ TestResults Output.NewlyComputed fqnPPE showSuccesses showFailures mOks mFails handleIOTest :: HQ.HashQualified Name -> Cli () handleIOTest main = do @@ -139,7 +139,7 @@ handleIOTest main = do when (not $ isIOTest typ) do Cli.returnEarly (BadMainFunction "io.test" main typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime)) runIOTest suffixifiedPPE ref - Cli.respond $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails + Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails findTermsOfTypes :: Codebase.Codebase m Symbol Ann -> Bool -> Path -> NESet (Type.Type Symbol Ann) -> Cli (Set TermReferenceId) findTermsOfTypes codebase includeLib path filterTypes = do @@ -163,7 +163,7 @@ handleAllIOTests = do let suffixifiedPPE = PPED.suffixifiedPPE pped ioTestRefs <- findTermsOfTypes codebase False Path.empty (Runtime.ioTestTypes runtime) case NESet.nonEmptySet ioTestRefs of - Nothing -> Cli.respond $ TestResults Output.NewlyComputed suffixifiedPPE True True [] [] + Nothing -> Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True [] [] Just neTestRefs -> do let total = NESet.size neTestRefs (fails, oks) <- @@ -172,7 +172,7 @@ handleAllIOTests = do (fails, oks) <- runIOTest suffixifiedPPE r Cli.respond $ TestIncrementalOutputEnd suffixifiedPPE (n, total) r (null fails) pure (fails, oks) - Cli.respond $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails + Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails resolveHQNames :: Names -> Set (HQ.HashQualified Name) -> Cli (Set (Reference.Id, Type.Type Symbol Ann)) resolveHQNames parseNames hqNames = diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index de47f53a83..7f80d24362 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -117,6 +117,13 @@ data NumberedOutput | ShowDiffAfterPull Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) | -- ShowDiffAfterCreateAuthor NameSegment Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann) + | TestResults + TestReportStats + PPE.PrettyPrintEnv + ShowSuccesses + ShowFailures + [(TermReferenceId, Text)] -- oks + [(TermReferenceId, Text)] -- fails | TodoOutput !Int !PPE.PrettyPrintEnvDecl !(TO.TodoOutput Symbol Ann) | -- | CantDeleteDefinitions ppe couldntDelete becauseTheseStillReferenceThem CantDeleteDefinitions PPE.PrettyPrintEnvDecl (Map LabeledDependency (NESet LabeledDependency)) @@ -253,13 +260,6 @@ data Output | LoadedDefinitionsToSourceFile FilePath Int | TestIncrementalOutputStart PPE.PrettyPrintEnv (Int, Int) TermReferenceId | TestIncrementalOutputEnd PPE.PrettyPrintEnv (Int, Int) TermReferenceId Bool {- True if success, False for Failure -} - | TestResults - TestReportStats - PPE.PrettyPrintEnv - ShowSuccesses - ShowFailures - [(TermReferenceId, Text)] -- oks - [(TermReferenceId, Text)] -- fails | CantUndo UndoFailureReason | -- new/unrepresented references followed by old/removed -- todo: eventually replace these sets with [SearchResult' v Ann] @@ -532,7 +532,6 @@ isFailure o = case o of DisplayRendered {} -> False TestIncrementalOutputStart {} -> False TestIncrementalOutputEnd {} -> False - TestResults _ _ _ _ _ fails -> not (null fails) CantUndo {} -> True BustedBuiltins {} -> True NoConfiguredRemoteMapping {} -> True @@ -667,4 +666,5 @@ isNumberedFailure = \case ShowDiffAfterUndo {} -> False ShowDiffNamespace _ _ _ bd -> BD.isEmpty bd ListNamespaceDependencies {} -> False + TestResults _ _ _ _ _ fails -> not (null fails) TodoOutput {} -> False diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index a121326605..f6ab5f69af 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -110,7 +110,7 @@ import Unison.PrintError renderCompilerBug, ) import Unison.Project (ProjectAndBranch (..)) -import Unison.Reference (Reference, TermReferenceId) +import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -307,6 +307,29 @@ notifyNumbered = \case ] ) (showDiffNamespace ShowNumbers ppe (absPathToBranchId bAbs) (absPathToBranchId bAbs) diff) + TestResults stats ppe _showSuccess _showFailures oksUnsorted failsUnsorted -> + let oks = Name.sortByText (HQ.toText . fst) [(name r, msg) | (r, msg) <- oksUnsorted] + fails = Name.sortByText (HQ.toText . fst) [(name r, msg) | (r, msg) <- failsUnsorted] + name r = PPE.termName ppe (Referent.fromTermReferenceId r) + in ( case stats of + CachedTests 0 _ -> P.callout "😶" $ "No tests to run." + CachedTests n n' | n == n' -> P.lines [cache, "", displayTestResults True oks fails] + CachedTests _n m -> + if m == 0 + then "✅ " + else + P.indentN 2 $ + P.lines ["", cache, "", displayTestResults False oks fails, "", "✅ "] + NewlyComputed -> + P.lines + [ " " <> P.bold "New test results:", + "", + displayTestResults True oks fails + ], + fmap (SA.HashQualified . fst) $ oks <> fails + ) + where + cache = P.bold "Cached test results " <> "(`help testcache` to learn more)" TodoOutput hashLen names todo -> todoOutput hashLen names todo CantDeleteDefinitions ppeDecl endangerments -> ( P.warnCallout $ @@ -638,29 +661,6 @@ notifyUser dir = \case OutputRewrittenFile dest vs -> displayOutputRewrittenFile dest vs DisplayRendered outputLoc pp -> displayRendered outputLoc pp - TestResults stats ppe _showSuccess _showFailures oks fails -> case stats of - CachedTests 0 _ -> pure . P.callout "😶" $ "No tests to run." - CachedTests n n' - | n == n' -> - pure $ - P.lines [cache, "", displayTestResults True ppe oks fails] - CachedTests _n m -> - pure $ - if m == 0 - then "✅ " - else - P.indentN 2 $ - P.lines ["", cache, "", displayTestResults False ppe oks fails, "", "✅ "] - NewlyComputed -> do - clearCurrentLine - pure $ - P.lines - [ " " <> P.bold "New test results:", - "", - displayTestResults True ppe oks fails - ] - where - cache = P.bold "Cached test results " <> "(`help testcache` to learn more)" TestIncrementalOutputStart ppe (n, total) r -> do putPretty' $ P.shown (total - n) @@ -2535,18 +2535,17 @@ displayRendered outputLoc pp = displayTestResults :: Bool -> -- whether to show the tip - PPE.PrettyPrintEnv -> - [(TermReferenceId, Text)] -> - [(TermReferenceId, Text)] -> + [(HQ.HashQualified Name, Text)] -> + [(HQ.HashQualified Name, Text)] -> Pretty -displayTestResults showTip ppe oksUnsorted failsUnsorted = - let oks = Name.sortByText fst [(name r, msg) | (r, msg) <- oksUnsorted] - fails = Name.sortByText fst [(name r, msg) | (r, msg) <- failsUnsorted] - name r = HQ.toText $ PPE.termName ppe (Referent.fromTermReferenceId r) +displayTestResults showTip oks fails = + let name = P.text . HQ.toText okMsg = if null oks then mempty - else P.column2 [(P.green "◉ " <> P.text r, " " <> P.green (P.text msg)) | (r, msg) <- oks] + else + P.indentN 2 $ + P.numberedColumn2ListFrom 0 [(P.green "◉ " <> name r, " " <> P.green (P.text msg)) | (r, msg) <- oks] okSummary = if null oks then mempty @@ -2554,7 +2553,11 @@ displayTestResults showTip ppe oksUnsorted failsUnsorted = failMsg = if null fails then mempty - else P.column2 [(P.red "✗ " <> P.text r, " " <> P.red (P.text msg)) | (r, msg) <- fails] + else + P.indentN 2 $ + P.numberedColumn2ListFrom + (length oks) + [(P.red "✗ " <> name r, " " <> P.red (P.text msg)) | (r, msg) <- fails] failSummary = if null fails then mempty @@ -2562,11 +2565,7 @@ displayTestResults showTip ppe oksUnsorted failsUnsorted = tipMsg = if not showTip || (null oks && null fails) then mempty - else - tip $ - "Use " - <> P.blue ("view " <> P.text (fst $ head (fails ++ oks))) - <> "to view the source of a test." + else tip $ "Use " <> P.blue "view 1" <> "to view the source of a test." in if null oks && null fails then "😶 No tests available." else @@ -3431,7 +3430,7 @@ listDependentsOrDependencies ppe labelStart label lds types terms = P.lines $ [ P.indentN 2 $ P.bold "Types:", "", - P.indentN 2 $ P.numbered (numFrom 0) $ c . prettyHashQualified <$> types + P.indentN 2 . P.numberedList $ c . prettyHashQualified <$> types ] termsOut = if null terms @@ -3440,7 +3439,6 @@ listDependentsOrDependencies ppe labelStart label lds types terms = P.lines [ P.indentN 2 $ P.bold "Terms:", "", - P.indentN 2 $ P.numbered (numFrom $ length types) $ c . prettyHashQualified <$> terms + P.indentN 2 . P.numberedListFrom (length types) $ c . prettyHashQualified <$> terms ] - numFrom k n = P.hiBlack $ P.shown (k + n) <> "." c = P.syntaxToColor From fd197f1369104880dd8f9df248b9413bd4b65f14 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 26 Jun 2024 14:01:36 -0600 Subject: [PATCH 287/631] Update the transcript outputs --- .../transcripts-using-base/_base.output.md | 6 +- .../binary-encoding-nats.output.md | 138 +++++++++--------- .../transcripts-using-base/codeops.output.md | 112 +++++++------- .../transcripts-using-base/hashing.output.md | 112 +++++++------- .../transcripts-using-base/mvar.output.md | 28 ++-- .../nat-coersion.output.md | 30 ++-- .../transcripts-using-base/net.output.md | 12 +- .../random-deserial.output.md | 12 +- .../ref-promise.output.md | 22 ++- .../transcripts-using-base/stm.output.md | 22 +-- .../transcripts-using-base/thread.output.md | 9 +- .../transcripts-using-base/tls.output.md | 19 ++- unison-src/transcripts/builtins.output.md | 60 ++++---- unison-src/transcripts/fix2049.output.md | 8 +- unison-src/transcripts/fix4172.output.md | 8 +- unison-src/transcripts/fix5080.output.md | 67 +++------ unison-src/transcripts/fix942.output.md | 4 +- .../transcripts/io-test-command.output.md | 18 +-- unison-src/transcripts/io.output.md | 104 +++++++------ unison-src/transcripts/test-command.output.md | 34 ++--- .../top-level-exceptions.output.md | 4 +- .../transcripts/unsafe-coerce.output.md | 4 +- .../transcripts/watch-expressions.output.md | 4 +- 23 files changed, 404 insertions(+), 433 deletions(-) diff --git a/unison-src/transcripts-using-base/_base.output.md b/unison-src/transcripts-using-base/_base.output.md index eeaebe564c..d0534691d3 100644 --- a/unison-src/transcripts-using-base/_base.output.md +++ b/unison-src/transcripts-using-base/_base.output.md @@ -63,11 +63,11 @@ testAutoClean _ = New test results: - ◉ testAutoClean our temporary directory should exist - ◉ testAutoClean our temporary directory should no longer exist + 1. ◉ testAutoClean our temporary directory should exist + 2. ◉ testAutoClean our temporary directory should no longer exist ✅ 2 test(s) passing - Tip: Use view testAutoClean to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/binary-encoding-nats.output.md b/unison-src/transcripts-using-base/binary-encoding-nats.output.md index 0227ff8e25..948bdd03ff 100644 --- a/unison-src/transcripts-using-base/binary-encoding-nats.output.md +++ b/unison-src/transcripts-using-base/binary-encoding-nats.output.md @@ -95,77 +95,77 @@ testABunchOfNats _ = New test results: - ◉ testABunchOfNats successfully decoded 4294967295 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4294967295 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4294967295 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4294967295 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 1090519040 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 1090519040 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 1090519040 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 1090519040 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4259840 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4259840 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4259840 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 4259840 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 16640 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 16640 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 16640 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 16640 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 16640 using 16 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 16640 using 16 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 2255827097 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 2255827097 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 2255827097 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 2255827097 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 65 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 65 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 65 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 65 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 65 using 16 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 65 using 16 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 0 using 64 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 0 using 64 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 0 using 32 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 0 using 32 bit Little Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 0 using 16 bit Big Endian - ◉ testABunchOfNats consumed all input - ◉ testABunchOfNats successfully decoded 0 using 16 bit Little Endian - ◉ testABunchOfNats consumed all input + 1. ◉ testABunchOfNats successfully decoded 4294967295 using 64 bit Big Endian + 2. ◉ testABunchOfNats consumed all input + 3. ◉ testABunchOfNats successfully decoded 4294967295 using 64 bit Little Endian + 4. ◉ testABunchOfNats consumed all input + 5. ◉ testABunchOfNats successfully decoded 4294967295 using 32 bit Big Endian + 6. ◉ testABunchOfNats consumed all input + 7. ◉ testABunchOfNats successfully decoded 4294967295 using 32 bit Little Endian + 8. ◉ testABunchOfNats consumed all input + 9. ◉ testABunchOfNats successfully decoded 1090519040 using 64 bit Big Endian + 10. ◉ testABunchOfNats consumed all input + 11. ◉ testABunchOfNats successfully decoded 1090519040 using 64 bit Little Endian + 12. ◉ testABunchOfNats consumed all input + 13. ◉ testABunchOfNats successfully decoded 1090519040 using 32 bit Big Endian + 14. ◉ testABunchOfNats consumed all input + 15. ◉ testABunchOfNats successfully decoded 1090519040 using 32 bit Little Endian + 16. ◉ testABunchOfNats consumed all input + 17. ◉ testABunchOfNats successfully decoded 4259840 using 64 bit Big Endian + 18. ◉ testABunchOfNats consumed all input + 19. ◉ testABunchOfNats successfully decoded 4259840 using 64 bit Little Endian + 20. ◉ testABunchOfNats consumed all input + 21. ◉ testABunchOfNats successfully decoded 4259840 using 32 bit Big Endian + 22. ◉ testABunchOfNats consumed all input + 23. ◉ testABunchOfNats successfully decoded 4259840 using 32 bit Little Endian + 24. ◉ testABunchOfNats consumed all input + 25. ◉ testABunchOfNats successfully decoded 16640 using 64 bit Big Endian + 26. ◉ testABunchOfNats consumed all input + 27. ◉ testABunchOfNats successfully decoded 16640 using 64 bit Little Endian + 28. ◉ testABunchOfNats consumed all input + 29. ◉ testABunchOfNats successfully decoded 16640 using 32 bit Big Endian + 30. ◉ testABunchOfNats consumed all input + 31. ◉ testABunchOfNats successfully decoded 16640 using 32 bit Little Endian + 32. ◉ testABunchOfNats consumed all input + 33. ◉ testABunchOfNats successfully decoded 16640 using 16 bit Big Endian + 34. ◉ testABunchOfNats consumed all input + 35. ◉ testABunchOfNats successfully decoded 16640 using 16 bit Little Endian + 36. ◉ testABunchOfNats consumed all input + 37. ◉ testABunchOfNats successfully decoded 2255827097 using 64 bit Big Endian + 38. ◉ testABunchOfNats consumed all input + 39. ◉ testABunchOfNats successfully decoded 2255827097 using 64 bit Little Endian + 40. ◉ testABunchOfNats consumed all input + 41. ◉ testABunchOfNats successfully decoded 2255827097 using 32 bit Big Endian + 42. ◉ testABunchOfNats consumed all input + 43. ◉ testABunchOfNats successfully decoded 2255827097 using 32 bit Little Endian + 44. ◉ testABunchOfNats consumed all input + 45. ◉ testABunchOfNats successfully decoded 65 using 64 bit Big Endian + 46. ◉ testABunchOfNats consumed all input + 47. ◉ testABunchOfNats successfully decoded 65 using 64 bit Little Endian + 48. ◉ testABunchOfNats consumed all input + 49. ◉ testABunchOfNats successfully decoded 65 using 32 bit Big Endian + 50. ◉ testABunchOfNats consumed all input + 51. ◉ testABunchOfNats successfully decoded 65 using 32 bit Little Endian + 52. ◉ testABunchOfNats consumed all input + 53. ◉ testABunchOfNats successfully decoded 65 using 16 bit Big Endian + 54. ◉ testABunchOfNats consumed all input + 55. ◉ testABunchOfNats successfully decoded 65 using 16 bit Little Endian + 56. ◉ testABunchOfNats consumed all input + 57. ◉ testABunchOfNats successfully decoded 0 using 64 bit Big Endian + 58. ◉ testABunchOfNats consumed all input + 59. ◉ testABunchOfNats successfully decoded 0 using 64 bit Little Endian + 60. ◉ testABunchOfNats consumed all input + 61. ◉ testABunchOfNats successfully decoded 0 using 32 bit Big Endian + 62. ◉ testABunchOfNats consumed all input + 63. ◉ testABunchOfNats successfully decoded 0 using 32 bit Little Endian + 64. ◉ testABunchOfNats consumed all input + 65. ◉ testABunchOfNats successfully decoded 0 using 16 bit Big Endian + 66. ◉ testABunchOfNats consumed all input + 67. ◉ testABunchOfNats successfully decoded 0 using 16 bit Little Endian + 68. ◉ testABunchOfNats consumed all input ✅ 68 test(s) passing - Tip: Use view testABunchOfNats to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/codeops.output.md b/unison-src/transcripts-using-base/codeops.output.md index 3f76560f4a..a3571968f0 100644 --- a/unison-src/transcripts-using-base/codeops.output.md +++ b/unison-src/transcripts-using-base/codeops.output.md @@ -364,33 +364,33 @@ to actual show that the serialization works. New test results: - ◉ tests (ext f) passed - ◉ tests (ext h) passed - ◉ tests (ident compound) passed - ◉ tests (ident fib10) passed - ◉ tests (ident effect) passed - ◉ tests (ident zero) passed - ◉ tests (ident h) passed - ◉ tests (ident text) passed - ◉ tests (ident int) passed - ◉ tests (ident float) passed - ◉ tests (ident termlink) passed - ◉ tests (ident bool) passed - ◉ tests (ident bytes) passed + 1. ◉ tests (ext f) passed + 2. ◉ tests (ext h) passed + 3. ◉ tests (ident compound) passed + 4. ◉ tests (ident fib10) passed + 5. ◉ tests (ident effect) passed + 6. ◉ tests (ident zero) passed + 7. ◉ tests (ident h) passed + 8. ◉ tests (ident text) passed + 9. ◉ tests (ident int) passed + 10. ◉ tests (ident float) passed + 11. ◉ tests (ident termlink) passed + 12. ◉ tests (ident bool) passed + 13. ◉ tests (ident bytes) passed ✅ 13 test(s) passing - Tip: Use view tests to view the source of a test. + Tip: Use view 1 to view the source of a test. .> io.test badLoad New test results: - ◉ badLoad serialized77 + 1. ◉ badLoad serialized77 ✅ 1 test(s) passing - Tip: Use view badLoad to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ```unison @@ -453,40 +453,40 @@ codeTests = New test results: - ◉ codeTests (idem f) passed - ◉ codeTests (idem h) passed - ◉ codeTests (idem rotate) passed - ◉ codeTests (idem zapper) passed - ◉ codeTests (idem showThree) passed - ◉ codeTests (idem concatMap) passed - ◉ codeTests (idem big) passed - ◉ codeTests (idem extensionality) passed - ◉ codeTests (idem identicality) passed - ◉ codeTests (verified f) passed - ◉ codeTests (verified h) passed - ◉ codeTests (verified rotate) passed - ◉ codeTests (verified zapper) passed - ◉ codeTests (verified showThree) passed - ◉ codeTests (verified concatMap) passed - ◉ codeTests (verified big) passed - ◉ codeTests (verified extensionality) passed - ◉ codeTests (verified identicality) passed - ◉ codeTests (verified mutual0) passed - ◉ codeTests (verified mutual1) passed - ◉ codeTests (verified mutual2) passed - ◉ codeTests (rejected missing mutual0) passed - ◉ codeTests (rejected missing mutual1) passed - ◉ codeTests (rejected missing mutual2) passed - ◉ codeTests (rejected swapped zapper) passed - ◉ codeTests (rejected swapped extensionality) passed - ◉ codeTests (rejected swapped identicality) passed - ◉ codeTests (rejected swapped mututal0) passed - ◉ codeTests (rejected swapped mututal1) passed - ◉ codeTests (rejected swapped mututal2) passed + 1. ◉ codeTests (idem f) passed + 2. ◉ codeTests (idem h) passed + 3. ◉ codeTests (idem rotate) passed + 4. ◉ codeTests (idem zapper) passed + 5. ◉ codeTests (idem showThree) passed + 6. ◉ codeTests (idem concatMap) passed + 7. ◉ codeTests (idem big) passed + 8. ◉ codeTests (idem extensionality) passed + 9. ◉ codeTests (idem identicality) passed + 10. ◉ codeTests (verified f) passed + 11. ◉ codeTests (verified h) passed + 12. ◉ codeTests (verified rotate) passed + 13. ◉ codeTests (verified zapper) passed + 14. ◉ codeTests (verified showThree) passed + 15. ◉ codeTests (verified concatMap) passed + 16. ◉ codeTests (verified big) passed + 17. ◉ codeTests (verified extensionality) passed + 18. ◉ codeTests (verified identicality) passed + 19. ◉ codeTests (verified mutual0) passed + 20. ◉ codeTests (verified mutual1) passed + 21. ◉ codeTests (verified mutual2) passed + 22. ◉ codeTests (rejected missing mutual0) passed + 23. ◉ codeTests (rejected missing mutual1) passed + 24. ◉ codeTests (rejected missing mutual2) passed + 25. ◉ codeTests (rejected swapped zapper) passed + 26. ◉ codeTests (rejected swapped extensionality) passed + 27. ◉ codeTests (rejected swapped identicality) passed + 28. ◉ codeTests (rejected swapped mututal0) passed + 29. ◉ codeTests (rejected swapped mututal1) passed + 30. ◉ codeTests (rejected swapped mututal2) passed ✅ 30 test(s) passing - Tip: Use view codeTests to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ```unison @@ -541,17 +541,17 @@ vtests _ = New test results: - ◉ vtests validated - ◉ vtests validated - ◉ vtests validated - ◉ vtests validated - ◉ vtests validated - ◉ vtests validated - ◉ vtests validated - ◉ vtests validated + 1. ◉ vtests validated + 2. ◉ vtests validated + 3. ◉ vtests validated + 4. ◉ vtests validated + 5. ◉ vtests validated + 6. ◉ vtests validated + 7. ◉ vtests validated + 8. ◉ vtests validated ✅ 8 test(s) passing - Tip: Use view vtests to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/hashing.output.md b/unison-src/transcripts-using-base/hashing.output.md index fee4fa0a27..e0b40f370e 100644 --- a/unison-src/transcripts-using-base/hashing.output.md +++ b/unison-src/transcripts-using-base/hashing.output.md @@ -316,36 +316,35 @@ test> crypto.hash.numTests = Cached test results (`help testcache` to learn more) - ◉ blake2b_512.tests.ex1 Passed - ◉ blake2b_512.tests.ex2 Passed - ◉ blake2b_512.tests.ex3 Passed - ◉ blake2s_256.tests.ex1 Passed - ◉ crypto.hash.numTests Passed - ◉ sha1.tests.ex1 Passed - ◉ sha1.tests.ex2 Passed - ◉ sha1.tests.ex3 Passed - ◉ sha1.tests.ex4 Passed - ◉ sha2_256.tests.ex1 Passed - ◉ sha2_256.tests.ex2 Passed - ◉ sha2_256.tests.ex3 Passed - ◉ sha2_256.tests.ex4 Passed - ◉ sha2_512.tests.ex1 Passed - ◉ sha2_512.tests.ex2 Passed - ◉ sha2_512.tests.ex3 Passed - ◉ sha2_512.tests.ex4 Passed - ◉ sha3_256.tests.ex1 Passed - ◉ sha3_256.tests.ex2 Passed - ◉ sha3_256.tests.ex3 Passed - ◉ sha3_256.tests.ex4 Passed - ◉ sha3_512.tests.ex1 Passed - ◉ sha3_512.tests.ex2 Passed - ◉ sha3_512.tests.ex3 Passed - ◉ sha3_512.tests.ex4 Passed + 1. ◉ blake2b_512.tests.ex1 Passed + 2. ◉ blake2b_512.tests.ex2 Passed + 3. ◉ blake2b_512.tests.ex3 Passed + 4. ◉ blake2s_256.tests.ex1 Passed + 5. ◉ crypto.hash.numTests Passed + 6. ◉ sha1.tests.ex1 Passed + 7. ◉ sha1.tests.ex2 Passed + 8. ◉ sha1.tests.ex3 Passed + 9. ◉ sha1.tests.ex4 Passed + 10. ◉ sha2_256.tests.ex1 Passed + 11. ◉ sha2_256.tests.ex2 Passed + 12. ◉ sha2_256.tests.ex3 Passed + 13. ◉ sha2_256.tests.ex4 Passed + 14. ◉ sha2_512.tests.ex1 Passed + 15. ◉ sha2_512.tests.ex2 Passed + 16. ◉ sha2_512.tests.ex3 Passed + 17. ◉ sha2_512.tests.ex4 Passed + 18. ◉ sha3_256.tests.ex1 Passed + 19. ◉ sha3_256.tests.ex2 Passed + 20. ◉ sha3_256.tests.ex3 Passed + 21. ◉ sha3_256.tests.ex4 Passed + 22. ◉ sha3_512.tests.ex1 Passed + 23. ◉ sha3_512.tests.ex2 Passed + 24. ◉ sha3_512.tests.ex3 Passed + 25. ◉ sha3_512.tests.ex4 Passed ✅ 25 test(s) passing - Tip: Use view blake2b_512.tests.ex1 to view the source of a - test. + Tip: Use view 1 to view the source of a test. ``` ## HMAC tests @@ -479,38 +478,37 @@ test> md5.tests.ex3 = Cached test results (`help testcache` to learn more) - ◉ blake2b_512.tests.ex1 Passed - ◉ blake2b_512.tests.ex2 Passed - ◉ blake2b_512.tests.ex3 Passed - ◉ blake2s_256.tests.ex1 Passed - ◉ crypto.hash.numTests Passed - ◉ md5.tests.ex1 Passed - ◉ md5.tests.ex2 Passed - ◉ md5.tests.ex3 Passed - ◉ sha1.tests.ex1 Passed - ◉ sha1.tests.ex2 Passed - ◉ sha1.tests.ex3 Passed - ◉ sha1.tests.ex4 Passed - ◉ sha2_256.tests.ex1 Passed - ◉ sha2_256.tests.ex2 Passed - ◉ sha2_256.tests.ex3 Passed - ◉ sha2_256.tests.ex4 Passed - ◉ sha2_512.tests.ex1 Passed - ◉ sha2_512.tests.ex2 Passed - ◉ sha2_512.tests.ex3 Passed - ◉ sha2_512.tests.ex4 Passed - ◉ sha3_256.tests.ex1 Passed - ◉ sha3_256.tests.ex2 Passed - ◉ sha3_256.tests.ex3 Passed - ◉ sha3_256.tests.ex4 Passed - ◉ sha3_512.tests.ex1 Passed - ◉ sha3_512.tests.ex2 Passed - ◉ sha3_512.tests.ex3 Passed - ◉ sha3_512.tests.ex4 Passed + 1. ◉ blake2b_512.tests.ex1 Passed + 2. ◉ blake2b_512.tests.ex2 Passed + 3. ◉ blake2b_512.tests.ex3 Passed + 4. ◉ blake2s_256.tests.ex1 Passed + 5. ◉ crypto.hash.numTests Passed + 6. ◉ md5.tests.ex1 Passed + 7. ◉ md5.tests.ex2 Passed + 8. ◉ md5.tests.ex3 Passed + 9. ◉ sha1.tests.ex1 Passed + 10. ◉ sha1.tests.ex2 Passed + 11. ◉ sha1.tests.ex3 Passed + 12. ◉ sha1.tests.ex4 Passed + 13. ◉ sha2_256.tests.ex1 Passed + 14. ◉ sha2_256.tests.ex2 Passed + 15. ◉ sha2_256.tests.ex3 Passed + 16. ◉ sha2_256.tests.ex4 Passed + 17. ◉ sha2_512.tests.ex1 Passed + 18. ◉ sha2_512.tests.ex2 Passed + 19. ◉ sha2_512.tests.ex3 Passed + 20. ◉ sha2_512.tests.ex4 Passed + 21. ◉ sha3_256.tests.ex1 Passed + 22. ◉ sha3_256.tests.ex2 Passed + 23. ◉ sha3_256.tests.ex3 Passed + 24. ◉ sha3_256.tests.ex4 Passed + 25. ◉ sha3_512.tests.ex1 Passed + 26. ◉ sha3_512.tests.ex2 Passed + 27. ◉ sha3_512.tests.ex3 Passed + 28. ◉ sha3_512.tests.ex4 Passed ✅ 28 test(s) passing - Tip: Use view blake2b_512.tests.ex1 to view the source of a - test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/mvar.output.md b/unison-src/transcripts-using-base/mvar.output.md index 26cccc7baf..244d700d87 100644 --- a/unison-src/transcripts-using-base/mvar.output.md +++ b/unison-src/transcripts-using-base/mvar.output.md @@ -77,22 +77,22 @@ testMvars _ = New test results: - ◉ testMvars ma should not be empty - ◉ testMvars should read what you sow - ◉ testMvars should reap what you sow - ◉ testMvars ma should be empty - ◉ testMvars swap returns old contents - ◉ testMvars swap returns old contents - ◉ testMvars tryRead should succeed when not empty - ◉ testMvars tryPut should fail when not empty - ◉ testMvars tryTake should succeed when not empty - ◉ testMvars tryTake should not succeed when empty - ◉ testMvars ma2 should be empty - ◉ testMvars tryTake should fail when empty - ◉ testMvars tryRead should fail when empty + 1. ◉ testMvars ma should not be empty + 2. ◉ testMvars should read what you sow + 3. ◉ testMvars should reap what you sow + 4. ◉ testMvars ma should be empty + 5. ◉ testMvars swap returns old contents + 6. ◉ testMvars swap returns old contents + 7. ◉ testMvars tryRead should succeed when not empty + 8. ◉ testMvars tryPut should fail when not empty + 9. ◉ testMvars tryTake should succeed when not empty + 10. ◉ testMvars tryTake should not succeed when empty + 11. ◉ testMvars ma2 should be empty + 12. ◉ testMvars tryTake should fail when empty + 13. ◉ testMvars tryRead should fail when empty ✅ 13 test(s) passing - Tip: Use view testMvars to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/nat-coersion.output.md b/unison-src/transcripts-using-base/nat-coersion.output.md index 38ab4450f0..234ca77d13 100644 --- a/unison-src/transcripts-using-base/nat-coersion.output.md +++ b/unison-src/transcripts-using-base/nat-coersion.output.md @@ -63,23 +63,23 @@ test = 'let New test results: - ◉ test expected 0.0 got 0.0 - ◉ test round trip though float, expected 0 got 0 - ◉ test expected 0 got 0 - ◉ test round trip though Int, expected 0 got 0 - ◉ test skipped - ◉ test expected 1 got 1 - ◉ test round trip though Int, expected 1 got 1 - ◉ test skipped - ◉ test expected -1 got -1 - ◉ test round trip though Int, expected 18446744073709551615 got 18446744073709551615 - ◉ test expected 1.0000000000000002 got 1.0000000000000002 - ◉ test round trip though float, expected 4607182418800017409 got 4607182418800017409 - ◉ test expected 4607182418800017409 got 4607182418800017409 - ◉ test round trip though Int, expected 4607182418800017409 got 4607182418800017409 + 1. ◉ test expected 0.0 got 0.0 + 2. ◉ test round trip though float, expected 0 got 0 + 3. ◉ test expected 0 got 0 + 4. ◉ test round trip though Int, expected 0 got 0 + 5. ◉ test skipped + 6. ◉ test expected 1 got 1 + 7. ◉ test round trip though Int, expected 1 got 1 + 8. ◉ test skipped + 9. ◉ test expected -1 got -1 + 10. ◉ test round trip though Int, expected 18446744073709551615 got 18446744073709551615 + 11. ◉ test expected 1.0000000000000002 got 1.0000000000000002 + 12. ◉ test round trip though float, expected 4607182418800017409 got 4607182418800017409 + 13. ◉ test expected 4607182418800017409 got 4607182418800017409 + 14. ◉ test round trip though Int, expected 4607182418800017409 got 4607182418800017409 ✅ 14 test(s) passing - Tip: Use view test to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/net.output.md b/unison-src/transcripts-using-base/net.output.md index 572ef0fbff..fcd072ca0c 100644 --- a/unison-src/transcripts-using-base/net.output.md +++ b/unison-src/transcripts-using-base/net.output.md @@ -119,13 +119,13 @@ testDefaultPort _ = New test results: - ◉ testDefaultPort successfully created socket - ◉ testDefaultPort port should be > 1024 - ◉ testDefaultPort port should be < 65536 + 1. ◉ testDefaultPort successfully created socket + 2. ◉ testDefaultPort port should be > 1024 + 3. ◉ testDefaultPort port should be < 65536 ✅ 3 test(s) passing - Tip: Use view testDefaultPort to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` This example demonstrates connecting a TCP client socket to a TCP server socket. A thread is started for both client and server. The server socket asks for any availalbe port (by passing "0" as the port number). The server thread then queries for the actual assigned port number, and puts that into an MVar which the client thread can read. The client thread then reads a string from the server and reports it back to the main thread via a different MVar. @@ -206,10 +206,10 @@ testTcpConnect = 'let New test results: - ◉ testTcpConnect should have reaped what we've sown + 1. ◉ testTcpConnect should have reaped what we've sown ✅ 1 test(s) passing - Tip: Use view testTcpConnect to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/random-deserial.output.md b/unison-src/transcripts-using-base/random-deserial.output.md index 48ff86e187..305cf5848f 100644 --- a/unison-src/transcripts-using-base/random-deserial.output.md +++ b/unison-src/transcripts-using-base/random-deserial.output.md @@ -89,14 +89,14 @@ serialTests = do New test results: - ◉ serialTests case-00 - ◉ serialTests case-01 - ◉ serialTests case-02 - ◉ serialTests case-03 - ◉ serialTests case-04 + 1. ◉ serialTests case-00 + 2. ◉ serialTests case-01 + 3. ◉ serialTests case-02 + 4. ◉ serialTests case-03 + 5. ◉ serialTests case-04 ✅ 5 test(s) passing - Tip: Use view serialTests to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/ref-promise.output.md b/unison-src/transcripts-using-base/ref-promise.output.md index 727f62e89e..9def3379e1 100644 --- a/unison-src/transcripts-using-base/ref-promise.output.md +++ b/unison-src/transcripts-using-base/ref-promise.output.md @@ -42,12 +42,12 @@ casTest = do New test results: - ◉ casTest CAS is successful is there were no conflicting writes - ◉ casTest CAS fails when there was an intervening write + 1. ◉ casTest CAS is successful is there were no conflicting writes + 2. ◉ casTest CAS fails when there was an intervening write ✅ 2 test(s) passing - Tip: Use view casTest to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` Promise is a simple one-shot awaitable condition. @@ -106,24 +106,22 @@ promiseConcurrentTest = do New test results: - ◉ promiseSequentialTest Should read a value that's been written - ◉ promiseSequentialTest Promise can only be written to once + 1. ◉ promiseSequentialTest Should read a value that's been written + 2. ◉ promiseSequentialTest Promise can only be written to once ✅ 2 test(s) passing - Tip: Use view promiseSequentialTest to view the source of a - test. + Tip: Use view 1 to view the source of a test. .> io.test promiseConcurrentTest New test results: - ◉ promiseConcurrentTest Reads awaits for completion of the Promise + 1. ◉ promiseConcurrentTest Reads awaits for completion of the Promise ✅ 1 test(s) passing - Tip: Use view promiseConcurrentTest to view the source of a - test. + Tip: Use view 1 to view the source of a test. ``` CAS can be used to write an atomic update function. @@ -248,10 +246,10 @@ fullTest = do New test results: - ◉ fullTest The state of the counter is consistent + 1. ◉ fullTest The state of the counter is consistent ✅ 1 test(s) passing - Tip: Use view fullTest to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/stm.output.md b/unison-src/transcripts-using-base/stm.output.md index a5d87ed520..8d129b66ac 100644 --- a/unison-src/transcripts-using-base/stm.output.md +++ b/unison-src/transcripts-using-base/stm.output.md @@ -119,19 +119,19 @@ tests = '(map spawn nats) New test results: - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified - ◉ tests verified + 1. ◉ tests verified + 2. ◉ tests verified + 3. ◉ tests verified + 4. ◉ tests verified + 5. ◉ tests verified + 6. ◉ tests verified + 7. ◉ tests verified + 8. ◉ tests verified + 9. ◉ tests verified + 10. ◉ tests verified ✅ 10 test(s) passing - Tip: Use view tests to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/thread.output.md b/unison-src/transcripts-using-base/thread.output.md index 76c28fa213..d5160f22c6 100644 --- a/unison-src/transcripts-using-base/thread.output.md +++ b/unison-src/transcripts-using-base/thread.output.md @@ -82,12 +82,11 @@ testBasicMultiThreadMVar = 'let New test results: - ◉ testBasicMultiThreadMVar other thread should have incremented + 1. ◉ testBasicMultiThreadMVar other thread should have incremented ✅ 1 test(s) passing - Tip: Use view testBasicMultiThreadMVar to view the source of a - test. + Tip: Use view 1 to view the source of a test. ``` ```unison @@ -158,10 +157,10 @@ testTwoThreads = 'let New test results: - ◉ testTwoThreads + 1. ◉ testTwoThreads ✅ 1 test(s) passing - Tip: Use view testTwoThreads to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/tls.output.md b/unison-src/transcripts-using-base/tls.output.md index 135f490186..f3b992baf7 100644 --- a/unison-src/transcripts-using-base/tls.output.md +++ b/unison-src/transcripts-using-base/tls.output.md @@ -55,12 +55,12 @@ what_should_work _ = this_should_work ++ this_should_not_work New test results: - ◉ what_should_work succesfully decoded self_signed_pem - ◉ what_should_work failed + 1. ◉ what_should_work succesfully decoded self_signed_pem + 2. ◉ what_should_work failed ✅ 2 test(s) passing - Tip: Use view what_should_work to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` Test handshaking a client/server a local TCP connection using our @@ -255,31 +255,30 @@ testCNReject _ = New test results: - ◉ testConnectSelfSigned should have reaped what we've sown + 1. ◉ testConnectSelfSigned should have reaped what we've sown ✅ 1 test(s) passing - Tip: Use view testConnectSelfSigned to view the source of a - test. + Tip: Use view 1 to view the source of a test. .> io.test testCAReject New test results: - ◉ testCAReject correctly rejected self-signed cert + 1. ◉ testCAReject correctly rejected self-signed cert ✅ 1 test(s) passing - Tip: Use view testCAReject to view the source of a test. + Tip: Use view 1 to view the source of a test. .> io.test testCNReject New test results: - ◉ testCNReject correctly rejected self-signed cert + 1. ◉ testCNReject correctly rejected self-signed cert ✅ 1 test(s) passing - Tip: Use view testCNReject to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/builtins.output.md b/unison-src/transcripts/builtins.output.md index 4d3089d35e..0de060002f 100644 --- a/unison-src/transcripts/builtins.output.md +++ b/unison-src/transcripts/builtins.output.md @@ -490,11 +490,11 @@ openFilesIO = do New test results: - ◉ openFilesIO Passed + 1. ◉ openFilesIO Passed ✅ 1 test(s) passing - Tip: Use view openFilesIO to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ## Universal hash functions @@ -539,36 +539,36 @@ Now that all the tests have been added to the codebase, let's view the test repo Cached test results (`help testcache` to learn more) - ◉ Any.test1 Passed - ◉ Any.test2 Passed - ◉ Boolean.tests.andTable Passed - ◉ Boolean.tests.notTable Passed - ◉ Boolean.tests.orTable Passed - ◉ Bytes.tests.at Passed - ◉ Bytes.tests.compression Passed - ◉ Bytes.tests.fromBase64UrlUnpadded Passed - ◉ Bytes.tests.indexOf Passed - ◉ Int.tests.arithmetic Passed - ◉ Int.tests.bitTwiddling Passed - ◉ Int.tests.conversions Passed - ◉ Nat.tests.arithmetic Passed - ◉ Nat.tests.bitTwiddling Passed - ◉ Nat.tests.conversions Passed - ◉ Sandbox.test1 Passed - ◉ Sandbox.test2 Passed - ◉ Sandbox.test3 Passed - ◉ test.rtjqan7bcs Passed - ◉ Text.tests.alignment Passed - ◉ Text.tests.indexOf Passed - ◉ Text.tests.indexOfEmoji Passed - ◉ Text.tests.literalsEq Passed - ◉ Text.tests.patterns Passed - ◉ Text.tests.repeat Passed - ◉ Text.tests.takeDropAppend Passed - ◉ Universal.murmurHash.tests Passed + 1. ◉ Any.test1 Passed + 2. ◉ Any.test2 Passed + 3. ◉ Boolean.tests.andTable Passed + 4. ◉ Boolean.tests.notTable Passed + 5. ◉ Boolean.tests.orTable Passed + 6. ◉ Bytes.tests.at Passed + 7. ◉ Bytes.tests.compression Passed + 8. ◉ Bytes.tests.fromBase64UrlUnpadded Passed + 9. ◉ Bytes.tests.indexOf Passed + 10. ◉ Int.tests.arithmetic Passed + 11. ◉ Int.tests.bitTwiddling Passed + 12. ◉ Int.tests.conversions Passed + 13. ◉ Nat.tests.arithmetic Passed + 14. ◉ Nat.tests.bitTwiddling Passed + 15. ◉ Nat.tests.conversions Passed + 16. ◉ Sandbox.test1 Passed + 17. ◉ Sandbox.test2 Passed + 18. ◉ Sandbox.test3 Passed + 19. ◉ test.rtjqan7bcs Passed + 20. ◉ Text.tests.alignment Passed + 21. ◉ Text.tests.indexOf Passed + 22. ◉ Text.tests.indexOfEmoji Passed + 23. ◉ Text.tests.literalsEq Passed + 24. ◉ Text.tests.patterns Passed + 25. ◉ Text.tests.repeat Passed + 26. ◉ Text.tests.takeDropAppend Passed + 27. ◉ Universal.murmurHash.tests Passed ✅ 27 test(s) passing - Tip: Use view Any.test1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/fix2049.output.md b/unison-src/transcripts/fix2049.output.md index 7e18e1f6c9..c7c9932da5 100644 --- a/unison-src/transcripts/fix2049.output.md +++ b/unison-src/transcripts/fix2049.output.md @@ -132,12 +132,12 @@ tests _ = New test results: - ◉ tests caught - ◉ tests caught - ◉ tests got the right answer + 1. ◉ tests caught + 2. ◉ tests caught + 3. ◉ tests got the right answer ✅ 3 test(s) passing - Tip: Use view tests to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/fix4172.output.md b/unison-src/transcripts/fix4172.output.md index 59a5d83b87..a7125abe77 100644 --- a/unison-src/transcripts/fix4172.output.md +++ b/unison-src/transcripts/fix4172.output.md @@ -49,11 +49,11 @@ allowDebug = debug [1,2,3] Cached test results (`help testcache` to learn more) - ◉ t1 Yay + 1. ◉ t1 Yay ✅ 1 test(s) passing - Tip: Use view t1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ```unison @@ -91,10 +91,10 @@ bool = false New test results: - ✗ t1 [1, 2, 3] + 1. ✗ t1 [1, 2, 3] 🚫 1 test(s) failing - Tip: Use view t1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md index b39894f7d2..22bb35aa58 100644 --- a/unison-src/transcripts/fix5080.output.md +++ b/unison-src/transcripts/fix5080.output.md @@ -11,13 +11,13 @@ 🎨 Type `ui` to explore this project's code in your browser. 🔭 Discover libraries at https://share.unison-lang.org 📖 Use `help-topic projects` to learn more about projects. - + Write your first Unison code with UCM: - + 1. Open scratch.u. 2. Write some Unison code and save the file. 3. In UCM, type `add` to save it to your new project. - + 🎉 🥳 Happy coding! ``` @@ -33,21 +33,21 @@ test> fix5080.tests.failure = check (2 Nat.== 4) I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: - + fix5080.tests.failure : [Result] fix5080.tests.success : [Result] - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 1 | test> fix5080.tests.success = check (6 Nat.== 6) - + ✅ Passed Passed - + 2 | test> fix5080.tests.failure = check (2 Nat.== 4) - + 🚫 FAILED Failed ``` @@ -55,57 +55,36 @@ test> fix5080.tests.failure = check (2 Nat.== 4) test-5080/main> add ⍟ I've added these definitions: - + fix5080.tests.failure : [Result] fix5080.tests.success : [Result] test-5080/main> test Cached test results (`help testcache` to learn more) - - ◉ fix5080.tests.success Passed - - ✗ fix5080.tests.failure Failed - - 🚫 1 test(s) failing, ✅ 1 test(s) passing - - Tip: Use view fix5080.tests.failure to view the source of a - test. -``` -```ucm -test-5080/main> delete.term 2 + 1. ◉ fix5080.tests.success Passed -test-5080/main> test + 2. ✗ fix5080.tests.failure Failed - Cached test results (`help testcache` to learn more) - - ◉ fix5080.tests.success Passed - - ✗ fix5080.tests.failure Failed - 🚫 1 test(s) failing, ✅ 1 test(s) passing - - Tip: Use view fix5080.tests.failure to view the source of a - test. + + Tip: Use view 1 to view the source of a test. ``` +```ucm +test-5080/main> delete.term 2 + Done. +test-5080/main> test -🛑 + Cached test results (`help testcache` to learn more) -The transcript failed due to an error in the stanza above. The error is: + 1. ◉ fix5080.tests.success Passed + ✅ 1 test(s) passing - Cached test results (`help testcache` to learn more) - - ◉ fix5080.tests.success Passed - - ✗ fix5080.tests.failure Failed - - 🚫 1 test(s) failing, ✅ 1 test(s) passing - - Tip: Use view fix5080.tests.failure to view the source of a - test. + Tip: Use view 1 to view the source of a test. +``` diff --git a/unison-src/transcripts/fix942.output.md b/unison-src/transcripts/fix942.output.md index fd5f055d22..a4f3921316 100644 --- a/unison-src/transcripts/fix942.output.md +++ b/unison-src/transcripts/fix942.output.md @@ -116,10 +116,10 @@ test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] Cached test results (`help testcache` to learn more) - ◉ t1 great + 1. ◉ t1 great ✅ 1 test(s) passing - Tip: Use view t1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/io-test-command.output.md b/unison-src/transcripts/io-test-command.output.md index 840d72b4f7..23ac26d5e6 100644 --- a/unison-src/transcripts/io-test-command.output.md +++ b/unison-src/transcripts/io-test-command.output.md @@ -22,21 +22,21 @@ Run a IO tests one by one New test results: - ◉ ioAndExceptionTest Success + 1. ◉ ioAndExceptionTest Success ✅ 1 test(s) passing - Tip: Use view ioAndExceptionTest to view the source of a test. + Tip: Use view 1 to view the source of a test. .> io.test ioTest New test results: - ◉ ioTest Success + 1. ◉ ioTest Success ✅ 1 test(s) passing - Tip: Use view ioTest to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` `io.test` doesn't cache results @@ -46,11 +46,11 @@ Run a IO tests one by one New test results: - ◉ ioAndExceptionTest Success + 1. ◉ ioAndExceptionTest Success ✅ 1 test(s) passing - Tip: Use view ioAndExceptionTest to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` `io.test.all` will run all matching tests except those in the `lib` namespace. @@ -68,11 +68,11 @@ Run a IO tests one by one New test results: - ◉ ioAndExceptionTest Success - ◉ ioTest Success + 1. ◉ ioAndExceptionTest Success + 2. ◉ ioTest Success ✅ 2 test(s) passing - Tip: Use view ioAndExceptionTest to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/io.output.md b/unison-src/transcripts/io.output.md index 3a7d44d4db..15d91b0e47 100644 --- a/unison-src/transcripts/io.output.md +++ b/unison-src/transcripts/io.output.md @@ -69,17 +69,17 @@ testCreateRename _ = New test results: - ◉ testCreateRename create a foo directory - ◉ testCreateRename directory should exist - ◉ testCreateRename foo should no longer exist - ◉ testCreateRename directory should no longer exist - ◉ testCreateRename bar should now exist - ◉ testCreateRename removeDirectory works recursively - ◉ testCreateRename removeDirectory works recursively + 1. ◉ testCreateRename create a foo directory + 2. ◉ testCreateRename directory should exist + 3. ◉ testCreateRename foo should no longer exist + 4. ◉ testCreateRename directory should no longer exist + 5. ◉ testCreateRename bar should now exist + 6. ◉ testCreateRename removeDirectory works recursively + 7. ◉ testCreateRename removeDirectory works recursively ✅ 7 test(s) passing - Tip: Use view testCreateRename to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### Opening / Closing files @@ -151,16 +151,16 @@ testOpenClose _ = New test results: - ◉ testOpenClose file should be open - ◉ testOpenClose file handle buffering should match what we just set. - ◉ testOpenClose file should be closed - ◉ testOpenClose bytes have been written - ◉ testOpenClose bytes have been written - ◉ testOpenClose file should be closed + 1. ◉ testOpenClose file should be open + 2. ◉ testOpenClose file handle buffering should match what we just set. + 3. ◉ testOpenClose file should be closed + 4. ◉ testOpenClose bytes have been written + 5. ◉ testOpenClose bytes have been written + 6. ◉ testOpenClose file should be closed ✅ 6 test(s) passing - Tip: Use view testOpenClose to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### Reading files with getSomeBytes @@ -241,18 +241,18 @@ testGetSomeBytes _ = New test results: - ◉ testGetSomeBytes chunk size splits data into 2 uneven sides - ◉ testGetSomeBytes file should be closed - ◉ testGetSomeBytes first chunk matches first part of testData - ◉ testGetSomeBytes second chunk matches rest of testData - ◉ testGetSomeBytes should be at end of file - ◉ testGetSomeBytes reading at end of file results in Bytes.empty - ◉ testGetSomeBytes requesting many bytes results in what's available - ◉ testGetSomeBytes file should be closed + 1. ◉ testGetSomeBytes chunk size splits data into 2 uneven sides + 2. ◉ testGetSomeBytes file should be closed + 3. ◉ testGetSomeBytes first chunk matches first part of testData + 4. ◉ testGetSomeBytes second chunk matches rest of testData + 5. ◉ testGetSomeBytes should be at end of file + 6. ◉ testGetSomeBytes reading at end of file results in Bytes.empty + 7. ◉ testGetSomeBytes requesting many bytes results in what's available + 8. ◉ testGetSomeBytes file should be closed ✅ 8 test(s) passing - Tip: Use view testGetSomeBytes to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### Seeking in open files @@ -350,27 +350,27 @@ testAppend _ = New test results: - ◉ testSeek seeked - ◉ testSeek readable file should be seekable - ◉ testSeek shouldn't be the EOF - ◉ testSeek we should be at position 0 - ◉ testSeek we should be at position 1 - ◉ testSeek should be able to read our temporary file after seeking - ◉ testSeek getLine should get a line + 1. ◉ testSeek seeked + 2. ◉ testSeek readable file should be seekable + 3. ◉ testSeek shouldn't be the EOF + 4. ◉ testSeek we should be at position 0 + 5. ◉ testSeek we should be at position 1 + 6. ◉ testSeek should be able to read our temporary file after seeking + 7. ◉ testSeek getLine should get a line ✅ 7 test(s) passing - Tip: Use view testSeek to view the source of a test. + Tip: Use view 1 to view the source of a test. .> io.test testAppend New test results: - ◉ testAppend should be able to read our temporary file + 1. ◉ testAppend should be able to read our temporary file ✅ 1 test(s) passing - Tip: Use view testAppend to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### SystemTime @@ -408,11 +408,11 @@ testSystemTime _ = New test results: - ◉ testSystemTime systemTime should be sane + 1. ◉ testSystemTime systemTime should be sane ✅ 1 test(s) passing - Tip: Use view testSystemTime to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### Get temp directory @@ -438,13 +438,12 @@ testGetTempDirectory _ = New test results: - ◉ testGetTempDirectory Temp directory is directory - ◉ testGetTempDirectory Temp directory should exist + 1. ◉ testGetTempDirectory Temp directory is directory + 2. ◉ testGetTempDirectory Temp directory should exist ✅ 2 test(s) passing - Tip: Use view testGetTempDirectory to view the source of a - test. + Tip: Use view 1 to view the source of a test. ``` ### Get current directory @@ -470,13 +469,12 @@ testGetCurrentDirectory _ = New test results: - ◉ testGetCurrentDirectory Current directory is directory - ◉ testGetCurrentDirectory Current directory should exist + 1. ◉ testGetCurrentDirectory Current directory is directory + 2. ◉ testGetCurrentDirectory Current directory should exist ✅ 2 test(s) passing - Tip: Use view testGetCurrentDirectory to view the source of a - test. + Tip: Use view 1 to view the source of a test. ``` ### Get directory contents @@ -504,12 +502,12 @@ testDirContents _ = New test results: - ◉ testDirContents directory size should be - ◉ testDirContents directory contents should have current directory and parent + 1. ◉ testDirContents directory size should be + 2. ◉ testDirContents directory contents should have current directory and parent ✅ 2 test(s) passing - Tip: Use view testDirContents to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### Read environment variables @@ -537,12 +535,12 @@ testGetEnv _ = New test results: - ◉ testGetEnv PATH environent variable should be set - ◉ testGetEnv DOESNTEXIST didn't exist + 1. ◉ testGetEnv PATH environent variable should be set + 2. ◉ testGetEnv DOESNTEXIST didn't exist ✅ 2 test(s) passing - Tip: Use view testGetEnv to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ### Read command line args @@ -701,11 +699,11 @@ testRandom = do New test results: - ◉ testGetEnv PATH environent variable should be set - ◉ testGetEnv DOESNTEXIST didn't exist + 1. ◉ testGetEnv PATH environent variable should be set + 2. ◉ testGetEnv DOESNTEXIST didn't exist ✅ 2 test(s) passing - Tip: Use view testGetEnv to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/test-command.output.md b/unison-src/transcripts/test-command.output.md index a59faee54c..f0255893fa 100644 --- a/unison-src/transcripts/test-command.output.md +++ b/unison-src/transcripts/test-command.output.md @@ -39,12 +39,12 @@ foo.test2 = [Ok "test2"] New test results: - ◉ foo.test2 test2 - ◉ test1 test1 + 1. ◉ foo.test2 test2 + 2. ◉ test1 test1 ✅ 2 test(s) passing - Tip: Use view foo.test2 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` Tests should be cached if unchanged. @@ -54,12 +54,12 @@ Tests should be cached if unchanged. Cached test results (`help testcache` to learn more) - ◉ foo.test2 test2 - ◉ test1 test1 + 1. ◉ foo.test2 test2 + 2. ◉ test1 test1 ✅ 2 test(s) passing - Tip: Use view foo.test2 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` `test` won't descend into the `lib` namespace, but `test.all` will. @@ -87,20 +87,20 @@ testInLib = [Ok "testInLib"] Cached test results (`help testcache` to learn more) - ◉ foo.test2 test2 - ◉ test1 test1 + 1. ◉ foo.test2 test2 + 2. ◉ test1 test1 ✅ 2 test(s) passing - Tip: Use view foo.test2 to view the source of a test. + Tip: Use view 1 to view the source of a test. .> test.all Cached test results (`help testcache` to learn more) - ◉ foo.test2 test2 - ◉ test1 test1 + 1. ◉ foo.test2 test2 + 2. ◉ test1 test1 ✅ 2 test(s) passing @@ -112,11 +112,11 @@ testInLib = [Ok "testInLib"] New test results: - ◉ lib.testInLib testInLib + 1. ◉ lib.testInLib testInLib ✅ 1 test(s) passing - Tip: Use view lib.testInLib to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` `test` WILL run tests within `lib` if ucm is cd'd inside. @@ -126,11 +126,11 @@ testInLib = [Ok "testInLib"] Cached test results (`help testcache` to learn more) - ◉ testInLib testInLib + 1. ◉ testInLib testInLib ✅ 1 test(s) passing - Tip: Use view testInLib to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` `test` can be given a relative path, in which case it will only run tests found somewhere in that namespace. @@ -140,10 +140,10 @@ testInLib = [Ok "testInLib"] Cached test results (`help testcache` to learn more) - ◉ foo.test2 test2 + 1. ◉ foo.test2 test2 ✅ 1 test(s) passing - Tip: Use view foo.test2 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/top-level-exceptions.output.md b/unison-src/transcripts/top-level-exceptions.output.md index 745e94c657..b220d0272f 100644 --- a/unison-src/transcripts/top-level-exceptions.output.md +++ b/unison-src/transcripts/top-level-exceptions.output.md @@ -55,11 +55,11 @@ mytest _ = [Ok "Great"] New test results: - ◉ mytest Great + 1. ◉ mytest Great ✅ 1 test(s) passing - Tip: Use view mytest to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` Now a test to show the handling of uncaught exceptions: diff --git a/unison-src/transcripts/unsafe-coerce.output.md b/unison-src/transcripts/unsafe-coerce.output.md index 8736e6e9cd..777eb9f344 100644 --- a/unison-src/transcripts/unsafe-coerce.output.md +++ b/unison-src/transcripts/unsafe-coerce.output.md @@ -45,10 +45,10 @@ main _ = New test results: - ◉ main + 1. ◉ main ✅ 1 test(s) passing - Tip: Use view main to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts/watch-expressions.output.md b/unison-src/transcripts/watch-expressions.output.md index 3a12bbcac7..2a5fa08f55 100644 --- a/unison-src/transcripts/watch-expressions.output.md +++ b/unison-src/transcripts/watch-expressions.output.md @@ -64,11 +64,11 @@ test> pass = [Ok "Passed"] Cached test results (`help testcache` to learn more) - ◉ pass Passed + 1. ◉ pass Passed ✅ 1 test(s) passing - Tip: Use view pass to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` ```unison From 94d5ab03d9ef502d6b5861b9f30afc09055946b0 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 26 Jun 2024 16:05:48 -0600 Subject: [PATCH 288/631] Restore trailing whitespace in transcript --- unison-src/transcripts/fix5080.output.md | 34 ++++++++++++------------ 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md index 22bb35aa58..c2384f98b3 100644 --- a/unison-src/transcripts/fix5080.output.md +++ b/unison-src/transcripts/fix5080.output.md @@ -11,13 +11,13 @@ 🎨 Type `ui` to explore this project's code in your browser. 🔭 Discover libraries at https://share.unison-lang.org 📖 Use `help-topic projects` to learn more about projects. - + Write your first Unison code with UCM: - + 1. Open scratch.u. 2. Write some Unison code and save the file. 3. In UCM, type `add` to save it to your new project. - + 🎉 🥳 Happy coding! ``` @@ -33,21 +33,21 @@ test> fix5080.tests.failure = check (2 Nat.== 4) I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: - + fix5080.tests.failure : [Result] fix5080.tests.success : [Result] - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 1 | test> fix5080.tests.success = check (6 Nat.== 6) - + ✅ Passed Passed - + 2 | test> fix5080.tests.failure = check (2 Nat.== 4) - + 🚫 FAILED Failed ``` @@ -55,20 +55,20 @@ test> fix5080.tests.failure = check (2 Nat.== 4) test-5080/main> add ⍟ I've added these definitions: - + fix5080.tests.failure : [Result] fix5080.tests.success : [Result] test-5080/main> test Cached test results (`help testcache` to learn more) - + 1. ◉ fix5080.tests.success Passed - + 2. ✗ fix5080.tests.failure Failed - + 🚫 1 test(s) failing, ✅ 1 test(s) passing - + Tip: Use view 1 to view the source of a test. ``` @@ -80,11 +80,11 @@ test-5080/main> delete.term 2 test-5080/main> test Cached test results (`help testcache` to learn more) - + 1. ◉ fix5080.tests.success Passed - + ✅ 1 test(s) passing - + Tip: Use view 1 to view the source of a test. ``` From 568fe7bfb7fc8841dd425dc735dd1ca4b2fcc42c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 15:07:02 -0700 Subject: [PATCH 289/631] Fix reflog transcript --- unison-src/transcripts/reflog.md | 4 ---- unison-src/transcripts/reflog.output.md | 21 ++++++++++----------- 2 files changed, 10 insertions(+), 15 deletions(-) diff --git a/unison-src/transcripts/reflog.md b/unison-src/transcripts/reflog.md index 47f8aa598d..3ed770196a 100644 --- a/unison-src/transcripts/reflog.md +++ b/unison-src/transcripts/reflog.md @@ -1,7 +1,3 @@ -```ucm:hide -scratch/main> builtins.merge -``` - First we make two changes to the codebase, so that there's more than one line for the `reflog` command to display: diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index 47ff8d79f6..c72f84eca8 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -15,7 +15,7 @@ x = 1 ⍟ These new definitions are ok to `add`: - x : Nat + x : ##Nat ``` ```ucm @@ -23,7 +23,7 @@ scratch/main> add ⍟ I've added these definitions: - x : Nat + x : ##Nat ``` ```unison @@ -40,7 +40,7 @@ y = 2 ⍟ These new definitions are ok to `add`: - y : Nat + y : ##Nat ``` ```ucm @@ -48,11 +48,11 @@ scratch/main> add ⍟ I've added these definitions: - y : Nat + y : ##Nat scratch/main> view y - y : Nat + y : ##Nat y = 2 ``` @@ -63,18 +63,17 @@ scratch/main> reflog most recent, along with the command that got us there. Try: `fork 2 .old` - `fork #g5elf6c850 .old` to make an old namespace + `fork #7fp7j6976q .old` to make an old namespace accessible again, - `reset-root #g5elf6c850` to reset the root namespace and + `reset-root #7fp7j6976q` to reset the root namespace and its history to that of the specified namespace. When Root Hash Action - 1. now #fullnsagfj add - 2. now #g5elf6c850 add - 3. now #niau58230g builtins.merge - 4. #sg60bvjo91 history starts here + 1. now #8ur19pdmaa add + 2. now #7fp7j6976q add + 3. #sg60bvjo91 history starts here Tip: Use `diff.namespace 1 7` to compare namespaces between two points in history. From a23e7d233e3019553531f30b8e76b6bf173b51a8 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 15:47:56 -0700 Subject: [PATCH 290/631] Revert round-trip main.md transcript --- unison-src/transcripts-round-trip/main.md | 26 +++++++++++------------ 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/unison-src/transcripts-round-trip/main.md b/unison-src/transcripts-round-trip/main.md index a7479d758a..7287a7ddba 100644 --- a/unison-src/transcripts-round-trip/main.md +++ b/unison-src/transcripts-round-trip/main.md @@ -1,13 +1,13 @@ This transcript verifies that the pretty-printer produces code that can be successfully parsed, for a variety of examples. Terms or types that fail to round-trip can be added to either `reparses-with-same-hash.u` or `reparses.u` as regression tests. ```ucm:hide -scratch/main> builtins.mergeio +.> builtins.mergeio ``` ```ucm:hide -scratch/main> copy.namespace builtin a1.lib.builtin -scratch/main> copy.namespace builtin a2.lib.builtin -scratch/main> load unison-src/transcripts-round-trip/reparses-with-same-hash.u +.> copy.namespace builtin a1.lib.builtin +.> copy.namespace builtin a2.lib.builtin +.> load unison-src/transcripts-round-trip/reparses-with-same-hash.u .a1> add ``` @@ -41,12 +41,12 @@ So we can see the pretty-printed output: This diff should be empty if the two namespaces are equivalent. If it's nonempty, the diff will show us the hashes that differ. ```ucm:error -scratch/main> diff.namespace a1 a2 +.> diff.namespace a1 a2 ``` ```ucm:hide -scratch/main> undo -scratch/main> undo +.> undo +.> undo ``` Now check that definitions in 'reparses.u' at least parse on round trip: @@ -72,7 +72,7 @@ x = () ``` ```ucm:hide -scratch/main> move.namespace a3 a3_old +.> move.namespace a3 a3_old .a3> copy.namespace .builtin lib.builtin .a3> load .a3> add @@ -83,7 +83,7 @@ scratch/main> move.namespace a3 a3_old These are currently all expected to have different hashes on round trip. ```ucm -scratch/main> diff.namespace a3 a3_old +.> diff.namespace a3 a3_old ``` ## Other regression tests not covered by above @@ -93,8 +93,8 @@ scratch/main> diff.namespace a3 a3_old Regression test for https://github.com/unisonweb/unison/pull/3548 ```ucm:hide -scratch/main> alias.term ##Nat.+ plus -scratch/main> edit plus -scratch/main> load -scratch/main> undo +.> alias.term ##Nat.+ plus +.> edit plus +.> load +.> undo ``` From 20b5e933814fe2c92e9e10e7f633731e05270373 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 15:52:13 -0700 Subject: [PATCH 291/631] Update rewrites.md output --- .../transcripts-manual/rewrites.output.md | 26 +++++++++---------- unison-src/transcripts/reflog.output.md | 8 +++--- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/unison-src/transcripts-manual/rewrites.output.md b/unison-src/transcripts-manual/rewrites.output.md index 415330f135..d1ab897dc2 100644 --- a/unison-src/transcripts-manual/rewrites.output.md +++ b/unison-src/transcripts-manual/rewrites.output.md @@ -31,7 +31,7 @@ rule2 x = @rewrite signature Optional ==> Optional2 Let's rewrite these: ```ucm -.> rewrite rule1 +scratch/main> rewrite rule1 ☝️ @@ -39,7 +39,7 @@ Let's rewrite these: The rewritten file has been added to the top of scratch.u -.> rewrite eitherToOptional +scratch/main> rewrite eitherToOptional ☝️ @@ -112,7 +112,7 @@ rule2 x = @rewrite signature Optional ==> Optional2 After adding to the codebase, here's the rewritten source: ```ucm -.> view ex1 Either.mapRight rule1 +scratch/main> view ex1 Either.mapRight rule1 Either.mapRight : (a ->{g} b) -> Optional a ->{g} Optional b Either.mapRight f = cases @@ -158,7 +158,7 @@ blah2 = 456 Let's apply the rewrite `woot1to2`: ```ucm -.> rewrite woot1to2 +scratch/main> rewrite woot1to2 ☝️ @@ -194,7 +194,7 @@ blah2 = 456 After adding the rewritten form to the codebase, here's the rewritten `Woot1` to `Woot2`: ```ucm -.> view wootEx +scratch/main> view wootEx wootEx : Nat ->{Woot2} Nat wootEx a = @@ -226,7 +226,7 @@ sameFileEx = After adding the rewritten form to the codebase, here's the rewritten definitions: ```ucm -.> view foo1 foo2 sameFileEx +scratch/main> view foo1 foo2 sameFileEx foo1 : Nat foo1 = @@ -267,7 +267,7 @@ sameFileEx = In the above example, `bar2` is locally bound by the rule, so when applied, it should not refer to the `bar2` top level binding. ```ucm -.> rewrite rule +scratch/main> rewrite rule ☝️ @@ -301,7 +301,7 @@ sameFileEx = Instead, it should be an unbound free variable, which doesn't typecheck: ```ucm -.> load +scratch/main> load Loading changes detected in scratch.u. @@ -332,7 +332,7 @@ rule a = @rewrite ``` ```ucm -.> rewrite rule +scratch/main> rewrite rule ☝️ @@ -358,7 +358,7 @@ rule a = The `a` introduced will be freshened to not capture the `a` in scope, so it remains as an unbound variable and is a type error: ```ucm -.> load +scratch/main> load Loading changes detected in scratch.u. @@ -388,7 +388,7 @@ findEitherFailure = @rewrite signature a . Either Failure a ==> () ``` ```ucm -.> sfind findEitherEx +scratch/main> sfind findEitherEx 🔎 @@ -398,7 +398,7 @@ findEitherFailure = @rewrite signature a . Either Failure a ==> () Tip: Try `edit 1` to bring this into your scratch file. -.> sfind findEitherFailure +scratch/main> sfind findEitherFailure 🔎 @@ -413,7 +413,7 @@ findEitherFailure = @rewrite signature a . Either Failure a ==> () Tip: Try `edit 1` or `edit 1-5` to bring these into your scratch file. -.> find 1-5 +scratch/main> find 1-5 1. Exception.catch : '{g, Exception} a ->{g} Either Failure a 2. Exception.reraise : Either Failure a ->{Exception} a diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index c72f84eca8..08d80626be 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -63,16 +63,16 @@ scratch/main> reflog most recent, along with the command that got us there. Try: `fork 2 .old` - `fork #7fp7j6976q .old` to make an old namespace + `fork #tfjr264n82 .old` to make an old namespace accessible again, - `reset-root #7fp7j6976q` to reset the root namespace and + `reset-root #tfjr264n82` to reset the root namespace and its history to that of the specified namespace. When Root Hash Action - 1. now #8ur19pdmaa add - 2. now #7fp7j6976q add + 1. now #lt901sgk5s add + 2. now #tfjr264n82 add 3. #sg60bvjo91 history starts here Tip: Use `diff.namespace 1 7` to compare namespaces between From 1c75272e9bb134606e5d9ee25f63df54ef30444b Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 16:09:49 -0700 Subject: [PATCH 292/631] Revert reflog transcript to trunk for now --- unison-src/transcripts/reflog.md | 16 +++++++----- unison-src/transcripts/reflog.output.md | 33 +++++++++++++------------ 2 files changed, 27 insertions(+), 22 deletions(-) diff --git a/unison-src/transcripts/reflog.md b/unison-src/transcripts/reflog.md index 3ed770196a..202dc50820 100644 --- a/unison-src/transcripts/reflog.md +++ b/unison-src/transcripts/reflog.md @@ -1,3 +1,7 @@ +```ucm:hide +.> builtins.merge +``` + First we make two changes to the codebase, so that there's more than one line for the `reflog` command to display: @@ -5,23 +9,23 @@ for the `reflog` command to display: x = 1 ``` ```ucm -scratch/main> add +.> add ``` ```unison y = 2 ``` ```ucm -scratch/main> add -scratch/main> view y +.> add +.> view y ``` ```ucm -scratch/main> reflog +.> reflog ``` If we `reset-root` to its previous value, `y` disappears. ```ucm -scratch/main> reset-root 2 +.> reset-root 2 ``` ```ucm:error -scratch/main> view y +.> view y ``` diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index 08d80626be..96e68114ff 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -15,15 +15,15 @@ x = 1 ⍟ These new definitions are ok to `add`: - x : ##Nat + x : Nat ``` ```ucm -scratch/main> add +.> add ⍟ I've added these definitions: - x : ##Nat + x : Nat ``` ```unison @@ -40,40 +40,41 @@ y = 2 ⍟ These new definitions are ok to `add`: - y : ##Nat + y : Nat ``` ```ucm -scratch/main> add +.> add ⍟ I've added these definitions: - y : ##Nat + y : Nat -scratch/main> view y +.> view y - y : ##Nat + y : Nat y = 2 ``` ```ucm -scratch/main> reflog +.> reflog Here is a log of the root namespace hashes, starting with the most recent, along with the command that got us there. Try: `fork 2 .old` - `fork #tfjr264n82 .old` to make an old namespace + `fork #p611n6o5ve .old` to make an old namespace accessible again, - `reset-root #tfjr264n82` to reset the root namespace and + `reset-root #p611n6o5ve` to reset the root namespace and its history to that of the specified namespace. When Root Hash Action - 1. now #lt901sgk5s add - 2. now #tfjr264n82 add - 3. #sg60bvjo91 history starts here + 1. now #rmu2vgm86a add + 2. now #p611n6o5ve add + 3. now #4bigcpnl7t builtins.merge + 4. #sg60bvjo91 history starts here Tip: Use `diff.namespace 1 7` to compare namespaces between two points in history. @@ -81,13 +82,13 @@ scratch/main> reflog ``` If we `reset-root` to its previous value, `y` disappears. ```ucm -scratch/main> reset-root 2 +.> reset-root 2 Done. ``` ```ucm -scratch/main> view y +.> view y ⚠️ From 2d1bf19a65c5b3350d31203cfcf1fc6555595ece Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 16:27:04 -0700 Subject: [PATCH 293/631] Mostly Upgrade LTS to ghc 9.6.5 --- .../U/Util/Serialization.hs | 2 +- .../src/Unison/Sqlite/Connection.hs | 4 +- parser-typechecker/package.yaml | 1 - .../unison-parser-typechecker.cabal | 4 +- stack.yaml | 12 ++--- stack.yaml.lock | 45 ++++++++++++------- unison-share-api/package.yaml | 1 - .../src/Unison/Server/CodebaseServer.hs | 5 +-- unison-share-api/unison-share-api.cabal | 3 +- 9 files changed, 41 insertions(+), 36 deletions(-) diff --git a/codebase2/util-serialization/U/Util/Serialization.hs b/codebase2/util-serialization/U/Util/Serialization.hs index ecc90fe439..82d49e1408 100644 --- a/codebase2/util-serialization/U/Util/Serialization.hs +++ b/codebase2/util-serialization/U/Util/Serialization.hs @@ -8,7 +8,7 @@ module U.Util.Serialization where -import Control.Applicative (Applicative (liftA2), liftA3) +import Control.Applicative (liftA3) import Control.Monad (foldM, replicateM, replicateM_, when) import Data.Bits (Bits, clearBit, setBit, shiftL, shiftR, testBit, (.|.)) import Data.ByteString (ByteString, readFile, writeFile) diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs b/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs index f46917ddc8..b97643b572 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs @@ -172,7 +172,7 @@ execute conn@(Connection _ _ conn0) sql@(Sql s params) = do -- -- This function does not support parameters, and is mostly useful for executing DDL and migrations. executeStatements :: Connection -> Text -> IO () -executeStatements conn@(Connection _ _ (Sqlite.Connection database)) sql = do +executeStatements conn@(Connection _ _ (Sqlite.Connection database _tempNameCounter)) sql = do logQuery (Sql sql []) Nothing Direct.Sqlite.exec database sql `catch` \(exception :: Sqlite.SQLError) -> throwSqliteQueryException @@ -184,7 +184,7 @@ executeStatements conn@(Connection _ _ (Sqlite.Connection database)) sql = do -- With results, without checks -queryStreamRow :: Sqlite.FromRow a => Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r +queryStreamRow :: (Sqlite.FromRow a) => Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r queryStreamRow conn@(Connection _ _ conn0) sql@(Sql s params) callback = run `catch` \(exception :: Sqlite.SQLError) -> throwSqliteQueryException diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml index 8bb50c5183..d5e72df18c 100644 --- a/parser-typechecker/package.yaml +++ b/parser-typechecker/package.yaml @@ -20,7 +20,6 @@ when: dependencies: - ListLike - - NanoID - aeson - ansi-terminal - asn1-encoding diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 7a9a467093..958b590c7b 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -224,7 +224,6 @@ library build-depends: IntervalMap , ListLike - , NanoID , aeson , ansi-terminal , asn1-encoding @@ -420,7 +419,6 @@ test-suite parser-typechecker-tests build-depends: IntervalMap , ListLike - , NanoID , aeson , ansi-terminal , asn1-encoding diff --git a/stack.yaml b/stack.yaml index ff76c60ea6..76a2f98338 100644 --- a/stack.yaml +++ b/stack.yaml @@ -44,7 +44,7 @@ packages: - unison-syntax - yaks/easytest -resolver: lts-20.26 +resolver: lts-22.26 extra-deps: # broken version in snapshot @@ -57,16 +57,18 @@ extra-deps: - github: unisonweb/haskeline commit: 9275eea7982dabbf47be2ba078ced669ae7ef3d5 + - github: runarorama/fuzzyfind + commit: 213b71742839bdb26300463878c1856f76ce8855 + # not in stackage - - fuzzyfind-3.0.1 - guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078 - lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484 - - monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505 - - recover-rtti-0.4.2@sha256:c179a303921126d8d782264e14f386c96e54a270df74be002e4c4ec3c8c7aebd,4529 + - monad-validate-1.3.0.0@sha256:eb6ddd5c9cf72ff0563cba604fa00291376e96138fdb4932d00ff3a99d66706e,2605 + - recover-rtti-0.4.3@sha256:01adcbab70a6542914df28ac120a23a923d8566236f2c0295998e9419f53dd62,4672 - lsp-2.2.0.0@sha256:82fbf4b69d94d8d22543be71f89986b3e90050032d671fb3de3f8253ea1e5b6f,3550 - lsp-types-2.0.2.0@sha256:a9a51c3cea0726d91fe63fa0670935ee720f7b31bc3f3b33b2483fc538152677,29421 - row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071 - - network-udp-0.0.0 + - network-udp-0.0.0@sha256:408d2d4fa1a25e49e95752ee124cca641993404bb133ae10fb81daef22d876ae,1075 ghc-options: # All packages diff --git a/stack.yaml.lock b/stack.yaml.lock index 4f98b610bf..439a3fad86 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -27,12 +27,23 @@ packages: original: url: https://github.com/unisonweb/haskeline/archive/9275eea7982dabbf47be2ba078ced669ae7ef3d5.tar.gz - completed: - hackage: fuzzyfind-3.0.1@sha256:78f89c1d79adf0a15fa2e57c693d42b4765ccfbbe380d0c9d7da6bff9f124f85,1823 + name: fuzzyfind pantry-tree: - sha256: 46f001ec2725d3172161c993bc8fbcf0514e3ba736f868fe2c2655e1ff49dad1 - size: 542 + sha256: 38cdef9414d5700e7c735cfa20c6a5c4c347aff64213111c56abc76a80792d97 + size: 602 + sha256: 87c684a8f4bab514ecc5c989517a484f40003327a138ff449bb87ec2779696d6 + size: 388383 + url: https://github.com/runarorama/fuzzyfind/archive/213b71742839bdb26300463878c1856f76ce8855.tar.gz + version: 3.0.1 original: - hackage: fuzzyfind-3.0.1 + url: https://github.com/runarorama/fuzzyfind/archive/213b71742839bdb26300463878c1856f76ce8855.tar.gz +- completed: + hackage: jose-0.9@sha256:0a312116d10cbddc915b77dbf82958307702e8716f3366bf7d166776498857e2,3251 + pantry-tree: + sha256: b787b8fa8a0ffe381a55a8b66f088d80ed7be0bc5acaf2c54cee78c4ab5fee1b + size: 2105 + original: + hackage: jose-0.9 - completed: hackage: guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078 pantry-tree: @@ -48,19 +59,19 @@ packages: original: hackage: lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484 - completed: - hackage: monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505 + hackage: monad-validate-1.3.0.0@sha256:eb6ddd5c9cf72ff0563cba604fa00291376e96138fdb4932d00ff3a99d66706e,2605 pantry-tree: - sha256: 8e049bd12ce2bd470909578f2ee8eb80b89d5ff88860afa30e29dd4eafecfa3e - size: 713 + sha256: 0b2a3a57be48fcc739708b214fca202f1e95b1cd773dd3bb9589d3007cf8cf5e + size: 611 original: - hackage: monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505 + hackage: monad-validate-1.3.0.0@sha256:eb6ddd5c9cf72ff0563cba604fa00291376e96138fdb4932d00ff3a99d66706e,2605 - completed: - hackage: recover-rtti-0.4.2@sha256:c179a303921126d8d782264e14f386c96e54a270df74be002e4c4ec3c8c7aebd,4529 + hackage: recover-rtti-0.4.3@sha256:01adcbab70a6542914df28ac120a23a923d8566236f2c0295998e9419f53dd62,4672 pantry-tree: - sha256: ad6f24481ebd25a1456d5dfaf08d48d95394ce83eb82a267e01d87d34f13bb83 - size: 2488 + sha256: 59a5df9c88f83816a9826b1e9708153d06d64bd1aed6c1d71ef0a1f6db070599 + size: 2489 original: - hackage: recover-rtti-0.4.2@sha256:c179a303921126d8d782264e14f386c96e54a270df74be002e4c4ec3c8c7aebd,4529 + hackage: recover-rtti-0.4.3@sha256:01adcbab70a6542914df28ac120a23a923d8566236f2c0295998e9419f53dd62,4672 - completed: hackage: lsp-2.2.0.0@sha256:82fbf4b69d94d8d22543be71f89986b3e90050032d671fb3de3f8253ea1e5b6f,3550 pantry-tree: @@ -88,10 +99,10 @@ packages: sha256: ee19a66c9d420861c5cc1dfad3210e2a53cdc6088ff3dd90b44f7961f5caebee size: 284 original: - hackage: network-udp-0.0.0 + hackage: network-udp-0.0.0@sha256:408d2d4fa1a25e49e95752ee124cca641993404bb133ae10fb81daef22d876ae,1075 snapshots: - completed: - sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2 - size: 650475 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml - original: lts-20.26 + sha256: 8e7996960d864443a66eb4105338bbdd6830377b9f6f99cd5527ef73c10c01e7 + size: 719128 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/26.yaml + original: lts-22.26 diff --git a/unison-share-api/package.yaml b/unison-share-api/package.yaml index 6bea13f3dc..760f1b1edb 100644 --- a/unison-share-api/package.yaml +++ b/unison-share-api/package.yaml @@ -9,7 +9,6 @@ library: other-modules: Paths_unison_share_api dependencies: - - NanoID - aeson >= 2.0.0.0 - async - base diff --git a/unison-share-api/src/Unison/Server/CodebaseServer.hs b/unison-share-api/src/Unison/Server/CodebaseServer.hs index 7ceef3c0fe..8591d4b130 100644 --- a/unison-share-api/src/Unison/Server/CodebaseServer.hs +++ b/unison-share-api/src/Unison/Server/CodebaseServer.hs @@ -16,7 +16,6 @@ import Data.ByteString.Char8 (unpack) import Data.ByteString.Char8 qualified as C8 import Data.ByteString.Lazy qualified as Lazy import Data.ByteString.Lazy.UTF8 qualified as BLU -import Data.NanoID (customNanoID, defaultAlphabet, unNanoID) import Data.OpenApi (Info (..), License (..), OpenApi, URL (..)) import Data.OpenApi.Lens qualified as OpenApi import Data.Proxy (Proxy (..)) @@ -409,9 +408,7 @@ app env rt codebase uiPath expectedToken allowCorsHost = -- each others codebases. genToken :: IO Strict.ByteString genToken = do - g <- createSystemRandom - n <- customNanoID defaultAlphabet 16 g - pure $ unNanoID n + BSC.pack . UUID.toString <$> UUID.nextRandom data Waiter a = Waiter { notify :: a -> IO (), diff --git a/unison-share-api/unison-share-api.cabal b/unison-share-api/unison-share-api.cabal index 3741a18615..85b8b3452d 100644 --- a/unison-share-api/unison-share-api.cabal +++ b/unison-share-api/unison-share-api.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -84,7 +84,6 @@ library ghc-options: -Wall build-depends: Diff - , NanoID , aeson >=2.0.0.0 , async , base From 61b266615ebdbca32b73f6abdb6c777256843d02 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 17:19:01 -0700 Subject: [PATCH 294/631] Temporarily ignore deprecations from jose --- stack.yaml.lock | 7 ------- unison-share-projects-api/src/Unison/Share/API/Hash.hs | 1 + 2 files changed, 1 insertion(+), 7 deletions(-) diff --git a/stack.yaml.lock b/stack.yaml.lock index 439a3fad86..d0a66ca836 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -37,13 +37,6 @@ packages: version: 3.0.1 original: url: https://github.com/runarorama/fuzzyfind/archive/213b71742839bdb26300463878c1856f76ce8855.tar.gz -- completed: - hackage: jose-0.9@sha256:0a312116d10cbddc915b77dbf82958307702e8716f3366bf7d166776498857e2,3251 - pantry-tree: - sha256: b787b8fa8a0ffe381a55a8b66f088d80ed7be0bc5acaf2c54cee78c4ab5fee1b - size: 2105 - original: - hackage: jose-0.9 - completed: hackage: guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078 pantry-tree: diff --git a/unison-share-projects-api/src/Unison/Share/API/Hash.hs b/unison-share-projects-api/src/Unison/Share/API/Hash.hs index 1d975300a2..066716a517 100644 --- a/unison-share-projects-api/src/Unison/Share/API/Hash.hs +++ b/unison-share-projects-api/src/Unison/Share/API/Hash.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wno-deprecations #-} -- | Hash-related types in the Share API. module Unison.Share.API.Hash From 4a9b35867c5f691084b5643e12c2ae7b6cf22417 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 17:19:01 -0700 Subject: [PATCH 295/631] Swap from x509 to crypton-x509 since old packages are abandoned --- parser-typechecker/package.yaml | 6 +++--- parser-typechecker/unison-parser-typechecker.cabal | 12 ++++++------ 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml index d5e72df18c..8aa23a2938 100644 --- a/parser-typechecker/package.yaml +++ b/parser-typechecker/package.yaml @@ -139,9 +139,9 @@ dependencies: - warp - witch - witherable - - x509 - - x509-store - - x509-system + - crypton-x509 + - crypton-x509-store + - crypton-x509-system - yaml - zlib diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 958b590c7b..14c70b8fd8 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -243,6 +243,9 @@ library , concurrent-output , configurator , containers >=0.6.3 + , crypton-x509 + , crypton-x509-store + , crypton-x509-system , cryptonite , data-default , data-memocombinators @@ -342,9 +345,6 @@ library , warp , witch , witherable - , x509 - , x509-store - , x509-system , yaml , zlib default-language: Haskell2010 @@ -439,6 +439,9 @@ test-suite parser-typechecker-tests , concurrent-output , configurator , containers >=0.6.3 + , crypton-x509 + , crypton-x509-store + , crypton-x509-system , cryptonite , data-default , data-memocombinators @@ -543,9 +546,6 @@ test-suite parser-typechecker-tests , warp , witch , witherable - , x509 - , x509-store - , x509-system , yaml , zlib default-language: Haskell2010 From 61e0522d1e3675bd8ba0e32b03c80c76d92eeea2 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 17:19:01 -0700 Subject: [PATCH 296/631] Fix redundant liftA2 imports --- parser-typechecker/src/Unison/Runtime/MCode.hs | 1 - parser-typechecker/src/Unison/Runtime/Serialize.hs | 1 - 2 files changed, 2 deletions(-) diff --git a/parser-typechecker/src/Unison/Runtime/MCode.hs b/parser-typechecker/src/Unison/Runtime/MCode.hs index 28f821f231..c3d9c837bb 100644 --- a/parser-typechecker/src/Unison/Runtime/MCode.hs +++ b/parser-typechecker/src/Unison/Runtime/MCode.hs @@ -36,7 +36,6 @@ module Unison.Runtime.MCode ) where -import Control.Applicative (liftA2) import Data.Bifunctor (bimap, first) import Data.Bits (shiftL, shiftR, (.|.)) import Data.Coerce diff --git a/parser-typechecker/src/Unison/Runtime/Serialize.hs b/parser-typechecker/src/Unison/Runtime/Serialize.hs index 622fc11e79..1d1213cc45 100644 --- a/parser-typechecker/src/Unison/Runtime/Serialize.hs +++ b/parser-typechecker/src/Unison/Runtime/Serialize.hs @@ -2,7 +2,6 @@ module Unison.Runtime.Serialize where -import Control.Applicative (liftA2) import Control.Monad (replicateM) import Data.Bits (Bits) import Data.ByteString qualified as B From 745660d9724235a0cd1f94bdf4510ae12dfc4ec4 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 17:19:01 -0700 Subject: [PATCH 297/631] Fix servant request stuff --- unison-cli/src/Unison/Cli/Share/Projects.hs | 6 ++++-- unison-cli/src/Unison/Share/Sync.hs | 6 ++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/unison-cli/src/Unison/Cli/Share/Projects.hs b/unison-cli/src/Unison/Cli/Share/Projects.hs index 961ed69858..52fbc56e8e 100644 --- a/unison-cli/src/Unison/Cli/Share/Projects.hs +++ b/unison-cli/src/Unison/Cli/Share/Projects.hs @@ -258,8 +258,10 @@ servantClientToCli action = do (mkClientEnv httpManager hardCodedBaseUrl) { Servant.makeClientRequest = \url request -> (Servant.defaultMakeClientRequest url request) - { Http.Client.responseTimeout = Http.Client.responseTimeoutMicro (60 * 1000 * 1000 {- 60s -}) - } + <&> \req -> + req + { Http.Client.responseTimeout = Http.Client.responseTimeoutMicro (60 * 1000 * 1000 {- 60s -}) + } } liftIO (runClientM action clientEnv) diff --git a/unison-cli/src/Unison/Share/Sync.hs b/unison-cli/src/Unison/Share/Sync.hs index 8df14b8f99..f4334342a8 100644 --- a/unison-cli/src/Unison/Share/Sync.hs +++ b/unison-cli/src/Unison/Share/Sync.hs @@ -1053,8 +1053,10 @@ httpUploadEntities :: { Servant.makeClientRequest = \url request -> -- Disable client-side timeouts (Servant.defaultMakeClientRequest url request) - { Http.Client.responseTimeout = Http.Client.responseTimeoutNone - } + <&> \r -> + r + { Http.Client.responseTimeout = Http.Client.responseTimeoutNone + } } & runReaderT (f req) & runExceptT From a7f234a558e46c9f011d50015d6ab0aa3c7980fb Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 17:19:01 -0700 Subject: [PATCH 298/631] Use random token rather than NanoID --- unison-share-api/package.yaml | 1 + .../src/Unison/Server/CodebaseServer.hs | 14 ++++++++++++-- unison-share-api/unison-share-api.cabal | 1 + 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/unison-share-api/package.yaml b/unison-share-api/package.yaml index 760f1b1edb..132a623041 100644 --- a/unison-share-api/package.yaml +++ b/unison-share-api/package.yaml @@ -16,6 +16,7 @@ dependencies: - bytes - bytestring - containers + - cryptonite - Diff - directory - errors diff --git a/unison-share-api/src/Unison/Server/CodebaseServer.hs b/unison-share-api/src/Unison/Server/CodebaseServer.hs index 8591d4b130..3d8d145e7f 100644 --- a/unison-share-api/src/Unison/Server/CodebaseServer.hs +++ b/unison-share-api/src/Unison/Server/CodebaseServer.hs @@ -10,7 +10,9 @@ import Control.Concurrent.Async (race) import Control.Exception (ErrorCall (..), throwIO) import Control.Monad.Reader import Control.Monad.Trans.Except +import Crypto.Random qualified as Crypto import Data.Aeson () +import Data.ByteArray.Encoding qualified as BE import Data.ByteString qualified as Strict import Data.ByteString.Char8 (unpack) import Data.ByteString.Char8 qualified as C8 @@ -82,7 +84,6 @@ import System.Directory (canonicalizePath, doesFileExist) import System.Environment (getExecutablePath) import System.FilePath (()) import System.FilePath qualified as FilePath -import System.Random.MWC (createSystemRandom) import U.Codebase.HashTags (CausalHash) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase @@ -406,9 +407,18 @@ app env rt codebase uiPath expectedToken allowCorsHost = -- | The Token is used to help prevent multiple users on a machine gain access to -- each others codebases. +-- +-- Generate a cryptographically secure random token. +-- https://neilmadden.blog/2018/08/30/moving-away-from-uuids/ +-- +-- E.g. +-- >>> genToken +-- "uxf85C7Y0B6om47" genToken :: IO Strict.ByteString genToken = do - BSC.pack . UUID.toString <$> UUID.nextRandom + BE.convertToBase @ByteString BE.Base64URLUnpadded <$> Crypto.getRandomBytes numRandomBytes + where + numRandomBytes = 10 data Waiter a = Waiter { notify :: a -> IO (), diff --git a/unison-share-api/unison-share-api.cabal b/unison-share-api/unison-share-api.cabal index 85b8b3452d..776ad6e47f 100644 --- a/unison-share-api/unison-share-api.cabal +++ b/unison-share-api/unison-share-api.cabal @@ -91,6 +91,7 @@ library , bytes , bytestring , containers + , cryptonite , directory , errors , extra From f3d44557ecf9ecfad06d703f074803a0577d772c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 18:02:23 -0700 Subject: [PATCH 299/631] Update opt-parse help --- unison-cli/src/ArgParse.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/unison-cli/src/ArgParse.hs b/unison-cli/src/ArgParse.hs index 5e7032942a..7c2b1f6108 100644 --- a/unison-cli/src/ArgParse.hs +++ b/unison-cli/src/ArgParse.hs @@ -220,7 +220,7 @@ transcriptCommand = transcriptHelp = "Execute transcript markdown files" transcriptFooter = Just . fold . List.intersperse P.line $ - [ "For each .md file provided this executes the transcript and creates" <+> bold ".output.md" <+> "if successful.", + [ "For each .md file provided this executes the transcript and creates" <+> P.annotate bold ".output.md" <+> "if successful.", "Exits after completion, and deletes the temporary directory created, unless --save-codebase is provided", "Multiple transcript files may be provided; they are processed in sequence" <+> "starting from the same codebase." ] @@ -232,7 +232,7 @@ transcriptForkCommand = transcriptHelp = "Execute transcript markdown files in a sandboxed codebase" transcriptFooter = Just . fold . List.intersperse P.line $ - [ "For each .md file provided this executes the transcript in a sandbox codebase and creates" <+> bold ".output.md" <+> "if successful.", + [ "For each .md file provided this executes the transcript in a sandbox codebase and creates" <+> P.annotate bold ".output.md" <+> "if successful.", "Exits after completion, and deletes the temporary directory created, unless --save-codebase is provided", "Multiple transcript files may be provided; they are processed in sequence" <+> "starting from the same codebase." ] @@ -505,15 +505,15 @@ transcriptForkParser = do ) unisonHelp :: String -> String -> P.Doc -unisonHelp (P.text -> executable) (P.text -> version) = +unisonHelp (fromString -> executable) (fromString -> version) = fold . List.intersperse P.line $ - [ P.empty, + [ mempty, "🌻", - P.empty, - P.bold "Usage instructions for the Unison Codebase Manager", + mempty, + P.annotate P.bold "Usage instructions for the Unison Codebase Manager", "You are running version:" <+> version, - P.empty, - "To get started just run" <+> P.bold executable, - P.empty, - "Use" <+> P.bold (executable <+> "[command] --help") <+> "to show help for a command." + mempty, + "To get started just run" <+> P.annotate P.bold executable, + mempty, + "Use" <+> P.annotate P.bold (executable <+> "[command] --help") <+> "to show help for a command." ] From 75381119dca91191e252560cb60f747f44ec1e94 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 18:10:14 -0700 Subject: [PATCH 300/631] Upgrade watch expression stuff --- unison-cli/src/Unison/Codebase/Watch.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Watch.hs b/unison-cli/src/Unison/Codebase/Watch.hs index 54838c7a86..c587d6ece5 100644 --- a/unison-cli/src/Unison/Codebase/Watch.hs +++ b/unison-cli/src/Unison/Codebase/Watch.hs @@ -44,8 +44,8 @@ watchDirectory' d = do mvar <- newEmptyMVar let handler :: Event -> IO () handler e = case e of - Added fp t False -> doIt fp t - Modified fp t False -> doIt fp t + Added fp t FSNotify.IsFile -> doIt fp t + Modified fp t FSNotify.IsFile -> doIt fp t _ -> pure () where doIt fp t = do @@ -56,7 +56,7 @@ watchDirectory' d = do cleanupRef <- newEmptyMVar -- we don't like FSNotify's debouncing (it seems to drop later events) -- so we will be doing our own instead - let config = FSNotify.defaultConfig {FSNotify.confDebounce = FSNotify.NoDebounce} + let config = FSNotify.defaultConfig cancel <- liftIO $ forkIO $ FSNotify.withManagerConf config $ \mgr -> do From b85bea8abb4d2ffbf2c1ac5cec81a0537359127a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 18:14:52 -0700 Subject: [PATCH 301/631] Clean up stack.yaml pins --- stack.yaml | 6 +----- stack.yaml.lock | 26 ++++---------------------- 2 files changed, 5 insertions(+), 27 deletions(-) diff --git a/stack.yaml b/stack.yaml index 76a2f98338..844c3ebb05 100644 --- a/stack.yaml +++ b/stack.yaml @@ -57,16 +57,12 @@ extra-deps: - github: unisonweb/haskeline commit: 9275eea7982dabbf47be2ba078ced669ae7ef3d5 - - github: runarorama/fuzzyfind - commit: 213b71742839bdb26300463878c1856f76ce8855 - # not in stackage + - fuzzyfind-3.0.2@sha256:0fcd64eb1016fe0d0232abc26b2b80b32d676707ff41d155a28df8a9572603d4,1921 - guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078 - lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484 - monad-validate-1.3.0.0@sha256:eb6ddd5c9cf72ff0563cba604fa00291376e96138fdb4932d00ff3a99d66706e,2605 - recover-rtti-0.4.3@sha256:01adcbab70a6542914df28ac120a23a923d8566236f2c0295998e9419f53dd62,4672 - - lsp-2.2.0.0@sha256:82fbf4b69d94d8d22543be71f89986b3e90050032d671fb3de3f8253ea1e5b6f,3550 - - lsp-types-2.0.2.0@sha256:a9a51c3cea0726d91fe63fa0670935ee720f7b31bc3f3b33b2483fc538152677,29421 - row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071 - network-udp-0.0.0@sha256:408d2d4fa1a25e49e95752ee124cca641993404bb133ae10fb81daef22d876ae,1075 diff --git a/stack.yaml.lock b/stack.yaml.lock index d0a66ca836..a4510a322b 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -27,16 +27,12 @@ packages: original: url: https://github.com/unisonweb/haskeline/archive/9275eea7982dabbf47be2ba078ced669ae7ef3d5.tar.gz - completed: - name: fuzzyfind + hackage: fuzzyfind-3.0.2@sha256:0fcd64eb1016fe0d0232abc26b2b80b32d676707ff41d155a28df8a9572603d4,1921 pantry-tree: - sha256: 38cdef9414d5700e7c735cfa20c6a5c4c347aff64213111c56abc76a80792d97 - size: 602 - sha256: 87c684a8f4bab514ecc5c989517a484f40003327a138ff449bb87ec2779696d6 - size: 388383 - url: https://github.com/runarorama/fuzzyfind/archive/213b71742839bdb26300463878c1856f76ce8855.tar.gz - version: 3.0.1 + sha256: 5bb9d39dbc4a619cf9b65409dde0d58dd488c7abab030f71ac83ba849595ee05 + size: 542 original: - url: https://github.com/runarorama/fuzzyfind/archive/213b71742839bdb26300463878c1856f76ce8855.tar.gz + hackage: fuzzyfind-3.0.2@sha256:0fcd64eb1016fe0d0232abc26b2b80b32d676707ff41d155a28df8a9572603d4,1921 - completed: hackage: guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078 pantry-tree: @@ -65,20 +61,6 @@ packages: size: 2489 original: hackage: recover-rtti-0.4.3@sha256:01adcbab70a6542914df28ac120a23a923d8566236f2c0295998e9419f53dd62,4672 -- completed: - hackage: lsp-2.2.0.0@sha256:82fbf4b69d94d8d22543be71f89986b3e90050032d671fb3de3f8253ea1e5b6f,3550 - pantry-tree: - sha256: 88ea35fb71d377c035770d5f0d6a3aea51919223e3bc1e492deb6f7d9cda3a85 - size: 1043 - original: - hackage: lsp-2.2.0.0@sha256:82fbf4b69d94d8d22543be71f89986b3e90050032d671fb3de3f8253ea1e5b6f,3550 -- completed: - hackage: lsp-types-2.0.2.0@sha256:a9a51c3cea0726d91fe63fa0670935ee720f7b31bc3f3b33b2483fc538152677,29421 - pantry-tree: - sha256: 7a3f0b679066d5e4732dfa358d76e0969589d636f4012c9e87cbe3451aa3ee5e - size: 45527 - original: - hackage: lsp-types-2.0.2.0@sha256:a9a51c3cea0726d91fe63fa0670935ee720f7b31bc3f3b33b2483fc538152677,29421 - completed: hackage: row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071 pantry-tree: From 87e15d788de0f4b81633b95cd8ddbea2d2353252 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 18:30:52 -0700 Subject: [PATCH 302/631] Bump stack version in CI --- .github/workflows/bundle-ucm.yaml | 2 ++ .github/workflows/ci.yaml | 2 ++ .github/workflows/haddocks.yaml | 2 ++ .github/workflows/update-transcripts.yaml | 2 ++ 4 files changed, 8 insertions(+) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index d77ba14030..db53c80ac0 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -39,6 +39,8 @@ jobs: - name: install stack uses: unisonweb/actions/stack/install@main + with: + stack-version: 2.15.5 - name: build run: | diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 8a5e089ce4..0908d47218 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -102,6 +102,8 @@ jobs: - name: install stack if: steps.cache-ucm-binaries.outputs.cache-hit != 'true' uses: unisonweb/actions/stack/install@main + with: + stack-version: 2.15.5 # Build deps, then build local code. Splitting it into two steps just allows us to see how much time each step # takes. diff --git a/.github/workflows/haddocks.yaml b/.github/workflows/haddocks.yaml index 4b9179e562..2fb12dad65 100644 --- a/.github/workflows/haddocks.yaml +++ b/.github/workflows/haddocks.yaml @@ -27,6 +27,8 @@ jobs: - name: install stack uses: unisonweb/actions/stack/install@main + with: + stack-version: 2.15.5 - name: build with haddocks working-directory: unison diff --git a/.github/workflows/update-transcripts.yaml b/.github/workflows/update-transcripts.yaml index 68b7ec1e92..90c206d045 100644 --- a/.github/workflows/update-transcripts.yaml +++ b/.github/workflows/update-transcripts.yaml @@ -22,6 +22,8 @@ jobs: - name: install stack uses: unisonweb/actions/stack/install@main + with: + stack-version: 2.15.5 # One of the transcripts fails if the user's git name hasn't been set. - name: set git user info From 06e730d26fb696322dc53836e80249e6244874c6 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 26 Jun 2024 18:33:48 -0700 Subject: [PATCH 303/631] Attempt to bump nix flake --- flake.nix | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flake.nix b/flake.nix index 8c8725da3b..ebe95c1694 100644 --- a/flake.nix +++ b/flake.nix @@ -27,10 +27,10 @@ ] (system: let versions = { - ghc = "928"; + ghc = "965"; ormolu = "0.5.2.0"; - hls = "2.4.0.0"; - stack = "2.13.1"; + hls = "2.9.0.0"; + stack = "2.15.5"; hpack = "0.35.2"; }; overlays = [ From 1a753ffb5b035d66679ec63ed0a81528dcbbd23f Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 26 Jun 2024 23:14:37 -0600 Subject: [PATCH 304/631] Group test results by definition Follow-up to #5140. --- .../Codebase/Editor/HandleInput/Tests.hs | 68 +++++---- .../src/Unison/Codebase/Editor/Output.hs | 4 +- .../src/Unison/CommandLine/OutputMessages.hs | 16 +-- .../transcripts-manual/docs.to-html.output.md | 2 +- .../transcripts-using-base/_base.output.md | 4 +- .../binary-encoding-nats.output.md | 136 +++++++++--------- .../transcripts-using-base/codeops.output.md | 104 +++++++------- .../transcripts-using-base/hashing.output.md | 106 +++++++------- .../transcripts-using-base/mvar.output.md | 26 ++-- .../nat-coersion.output.md | 28 ++-- .../transcripts-using-base/net.output.md | 8 +- .../random-deserial.output.md | 10 +- .../ref-promise.output.md | 12 +- .../transcripts-using-base/stm.output.md | 20 +-- .../transcripts-using-base/thread.output.md | 4 +- .../transcripts-using-base/tls.output.md | 10 +- unison-src/transcripts/builtins.output.md | 56 ++++---- unison-src/transcripts/fix2049.output.md | 6 +- unison-src/transcripts/fix4172.output.md | 4 +- unison-src/transcripts/fix5080.output.md | 8 +- unison-src/transcripts/fix942.output.md | 2 +- .../transcripts/io-test-command.output.md | 10 +- unison-src/transcripts/io.output.md | 80 +++++------ unison-src/transcripts/test-command.output.md | 22 +-- .../top-level-exceptions.output.md | 2 +- .../transcripts/unsafe-coerce.output.md | 2 +- .../transcripts/watch-expressions.output.md | 2 +- 27 files changed, 380 insertions(+), 372 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs index b1c9f72d5c..172ceea300 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs @@ -14,7 +14,6 @@ import Data.Map qualified as Map import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) import Data.Set.NonEmpty qualified as NESet -import Data.Tuple qualified as Tuple import Unison.ABT qualified as ABT import Unison.Builtin.Decls qualified as DD import Unison.Cli.Monad (Cli) @@ -69,21 +68,24 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} = Map.fromList <$> Cli.runTransaction do Set.toList testRefs & wither \case rid -> fmap (rid,) <$> Codebase.getWatch codebase WK.TestWatch rid - let (oks, fails) = passFails cachedTests - passFails :: (Ord r) => Map r (Term v a) -> ([(r, Text)], [(r, Text)]) - passFails = Tuple.swap . partitionEithers . concat . map p . Map.toList + let (fails, oks) = passFails cachedTests + passFails :: (Ord r) => Map r (Term v a) -> (Map r [Text], Map r [Text]) + passFails = + Map.foldrWithKey + (\r v (f, o) -> bimap (\ts -> if null ts then f else Map.insert r ts f) (\ts -> if null ts then o else Map.insert r ts o) . partitionEithers $ p v) + (Map.empty, Map.empty) where - p :: (r, Term v a) -> [Either (r, Text) (r, Text)] - p (r, tm) = case tm of - Term.List' ts -> mapMaybe (q r) (toList ts) + p :: Term v a -> [Either Text Text] + p = \case + Term.List' ts -> mapMaybe q $ toList ts _ -> [] - q r = \case + q = \case Term.App' (Term.Constructor' (ConstructorReference ref cid)) (Term.Text' msg) -> if | ref == DD.testResultRef -> if - | cid == DD.okConstructorId -> Just (Right (r, msg)) - | cid == DD.failConstructorId -> Just (Left (r, msg)) + | cid == DD.okConstructorId -> Just (Right msg) + | cid == DD.failConstructorId -> Just (Left msg) | otherwise -> Nothing | otherwise -> Nothing _ -> Nothing @@ -123,7 +125,7 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} = pure [(r, tm')] let m = Map.fromList computedTests - (mOks, mFails) = passFails m + (mFails, mOks) = passFails m Cli.respondNumbered $ TestResults Output.NewlyComputed fqnPPE showSuccesses showFailures mOks mFails handleIOTest :: HQ.HashQualified Name -> Cli () @@ -135,10 +137,14 @@ handleIOTest main = do let isIOTest typ = Foldable.any (Typechecker.isSubtype typ) $ Runtime.ioTestTypes runtime refs <- resolveHQNames names (Set.singleton main) (fails, oks) <- - refs & foldMapM \(ref, typ) -> do - when (not $ isIOTest typ) do - Cli.returnEarly (BadMainFunction "io.test" main typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime)) - runIOTest suffixifiedPPE ref + Foldable.foldrM + ( \(ref, typ) (f, o) -> do + when (not $ isIOTest typ) $ + Cli.returnEarly (BadMainFunction "io.test" main typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime)) + bimap (\ts -> if null ts then f else Map.insert ref ts f) (\ts -> if null ts then o else Map.insert ref ts o) <$> runIOTest suffixifiedPPE ref + ) + (Map.empty, Map.empty) + refs Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails findTermsOfTypes :: Codebase.Codebase m Symbol Ann -> Bool -> Path -> NESet (Type.Type Symbol Ann) -> Cli (Set TermReferenceId) @@ -163,15 +169,20 @@ handleAllIOTests = do let suffixifiedPPE = PPED.suffixifiedPPE pped ioTestRefs <- findTermsOfTypes codebase False Path.empty (Runtime.ioTestTypes runtime) case NESet.nonEmptySet ioTestRefs of - Nothing -> Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True [] [] + Nothing -> Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True Map.empty Map.empty Just neTestRefs -> do let total = NESet.size neTestRefs (fails, oks) <- - toList neTestRefs & zip [1 :: Int ..] & foldMapM \(n, r) -> do - Cli.respond $ TestIncrementalOutputStart suffixifiedPPE (n, total) r - (fails, oks) <- runIOTest suffixifiedPPE r - Cli.respond $ TestIncrementalOutputEnd suffixifiedPPE (n, total) r (null fails) - pure (fails, oks) + toList neTestRefs + & zip [1 :: Int ..] + & Foldable.foldrM + ( \(n, r) (f, o) -> do + Cli.respond $ TestIncrementalOutputStart suffixifiedPPE (n, total) r + (fails, oks) <- runIOTest suffixifiedPPE r + Cli.respond $ TestIncrementalOutputEnd suffixifiedPPE (n, total) r (null fails) + pure (if null fails then f else Map.insert r fails f, if null oks then o else Map.insert r oks o) + ) + (Map.empty, Map.empty) Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails resolveHQNames :: Names -> Set (HQ.HashQualified Name) -> Cli (Set (Reference.Id, Type.Type Symbol Ann)) @@ -197,19 +208,16 @@ resolveHQNames parseNames hqNames = typ <- MaybeT (Codebase.getTypeOfReferent codebase (Referent.fromTermReferenceId ref)) pure (ref, typ) -runIOTest :: PPE.PrettyPrintEnv -> Reference.Id -> Cli ([(Reference.Id, Text)], [(Reference.Id, Text)]) +runIOTest :: PPE.PrettyPrintEnv -> Reference.Id -> Cli ([Text], [Text]) runIOTest ppe ref = do let a = ABT.annotation tm tm = DD.forceTerm a a (Term.refId a ref) -- Don't cache IO tests tm' <- RuntimeUtils.evalUnisonTerm False ppe False tm - pure $ partitionTestResults [(ref, tm')] + pure $ partitionTestResults tm' -partitionTestResults :: - [(Reference.Id, Term Symbol Ann)] -> - ([(Reference.Id, Text {- fails -})], [(Reference.Id, Text {- oks -})]) -partitionTestResults results = fold $ do - (ref, tm) <- results +partitionTestResults :: Term Symbol Ann -> ([Text {- fails -}], [Text {- oks -}]) +partitionTestResults tm = fold $ do element <- case tm of Term.List' ts -> toList ts _ -> empty @@ -217,8 +225,8 @@ partitionTestResults results = fold $ do Term.App' (Term.Constructor' (ConstructorReference conRef cid)) (Term.Text' msg) -> do guard (conRef == DD.testResultRef) if - | cid == DD.okConstructorId -> pure (mempty, [(ref, msg)]) - | cid == DD.failConstructorId -> pure ([(ref, msg)], mempty) + | cid == DD.okConstructorId -> pure (mempty, [msg]) + | cid == DD.failConstructorId -> pure ([msg], mempty) | otherwise -> empty _ -> empty diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index e0668113ba..b423079928 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -124,8 +124,8 @@ data NumberedOutput PPE.PrettyPrintEnv ShowSuccesses ShowFailures - [(TermReferenceId, Text)] -- oks - [(TermReferenceId, Text)] -- fails + (Map TermReferenceId [Text]) -- oks + (Map TermReferenceId [Text]) -- fails | Output'Todo !TodoOutput | -- | CantDeleteDefinitions ppe couldntDelete becauseTheseStillReferenceThem CantDeleteDefinitions PPE.PrettyPrintEnvDecl (Map LabeledDependency (NESet LabeledDependency)) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 9caaea3838..ff4f298728 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -308,8 +308,8 @@ notifyNumbered = \case ) (showDiffNamespace ShowNumbers ppe (absPathToBranchId bAbs) (absPathToBranchId bAbs) diff) TestResults stats ppe _showSuccess _showFailures oksUnsorted failsUnsorted -> - let oks = Name.sortByText (HQ.toText . fst) [(name r, msg) | (r, msg) <- oksUnsorted] - fails = Name.sortByText (HQ.toText . fst) [(name r, msg) | (r, msg) <- failsUnsorted] + let oks = Name.sortByText (HQ.toText . fst) [(name r, msgs) | (r, msgs) <- Map.toList oksUnsorted] + fails = Name.sortByText (HQ.toText . fst) [(name r, msgs) | (r, msgs) <- Map.toList failsUnsorted] name r = PPE.termName ppe (Referent.fromTermReferenceId r) in ( case stats of CachedTests 0 _ -> P.callout "😶" $ "No tests to run." @@ -2535,8 +2535,8 @@ displayRendered outputLoc pp = displayTestResults :: Bool -> -- whether to show the tip - [(HQ.HashQualified Name, Text)] -> - [(HQ.HashQualified Name, Text)] -> + [(HQ.HashQualified Name, [Text])] -> + [(HQ.HashQualified Name, [Text])] -> Pretty displayTestResults showTip oks fails = let name = P.text . HQ.toText @@ -2545,11 +2545,11 @@ displayTestResults showTip oks fails = then mempty else P.indentN 2 $ - P.numberedColumn2ListFrom 0 [(P.green "◉ " <> name r, " " <> P.green (P.text msg)) | (r, msg) <- oks] + P.numberedColumn2ListFrom 0 [(name r, P.lines $ P.green . (" ◉ " <>) . P.text <$> msgs) | (r, msgs) <- oks] okSummary = if null oks then mempty - else "✅ " <> P.bold (P.num (length oks)) <> P.green " test(s) passing" + else "✅ " <> P.bold (P.num (sum $ fmap (length . snd) oks)) <> P.green " test(s) passing" failMsg = if null fails then mempty @@ -2557,11 +2557,11 @@ displayTestResults showTip oks fails = P.indentN 2 $ P.numberedColumn2ListFrom (length oks) - [(P.red "✗ " <> name r, " " <> P.red (P.text msg)) | (r, msg) <- fails] + [(name r, P.lines $ P.red . (" ✗ " <>) . P.text <$> msgs) | (r, msgs) <- fails] failSummary = if null fails then mempty - else "🚫 " <> P.bold (P.num (length fails)) <> P.red " test(s) failing" + else "🚫 " <> P.bold (P.num (sum $ fmap (length . snd) fails)) <> P.red " test(s) failing" tipMsg = if not showTip || (null oks && null fails) then mempty diff --git a/unison-src/transcripts-manual/docs.to-html.output.md b/unison-src/transcripts-manual/docs.to-html.output.md index bdfc5fa4a6..d0ff08ce86 100644 --- a/unison-src/transcripts-manual/docs.to-html.output.md +++ b/unison-src/transcripts-manual/docs.to-html.output.md @@ -6,7 +6,7 @@ I'll now fetch the latest version of the base Unison library... - Downloaded 14053 entities. + Downloaded 14067 entities. 🎨 Type `ui` to explore this project's code in your browser. 🔭 Discover libraries at https://share.unison-lang.org diff --git a/unison-src/transcripts-using-base/_base.output.md b/unison-src/transcripts-using-base/_base.output.md index d0534691d3..28419d8c79 100644 --- a/unison-src/transcripts-using-base/_base.output.md +++ b/unison-src/transcripts-using-base/_base.output.md @@ -63,8 +63,8 @@ testAutoClean _ = New test results: - 1. ◉ testAutoClean our temporary directory should exist - 2. ◉ testAutoClean our temporary directory should no longer exist + 1. testAutoClean ◉ our temporary directory should exist + ◉ our temporary directory should no longer exist ✅ 2 test(s) passing diff --git a/unison-src/transcripts-using-base/binary-encoding-nats.output.md b/unison-src/transcripts-using-base/binary-encoding-nats.output.md index 948bdd03ff..669f89aa1b 100644 --- a/unison-src/transcripts-using-base/binary-encoding-nats.output.md +++ b/unison-src/transcripts-using-base/binary-encoding-nats.output.md @@ -95,74 +95,74 @@ testABunchOfNats _ = New test results: - 1. ◉ testABunchOfNats successfully decoded 4294967295 using 64 bit Big Endian - 2. ◉ testABunchOfNats consumed all input - 3. ◉ testABunchOfNats successfully decoded 4294967295 using 64 bit Little Endian - 4. ◉ testABunchOfNats consumed all input - 5. ◉ testABunchOfNats successfully decoded 4294967295 using 32 bit Big Endian - 6. ◉ testABunchOfNats consumed all input - 7. ◉ testABunchOfNats successfully decoded 4294967295 using 32 bit Little Endian - 8. ◉ testABunchOfNats consumed all input - 9. ◉ testABunchOfNats successfully decoded 1090519040 using 64 bit Big Endian - 10. ◉ testABunchOfNats consumed all input - 11. ◉ testABunchOfNats successfully decoded 1090519040 using 64 bit Little Endian - 12. ◉ testABunchOfNats consumed all input - 13. ◉ testABunchOfNats successfully decoded 1090519040 using 32 bit Big Endian - 14. ◉ testABunchOfNats consumed all input - 15. ◉ testABunchOfNats successfully decoded 1090519040 using 32 bit Little Endian - 16. ◉ testABunchOfNats consumed all input - 17. ◉ testABunchOfNats successfully decoded 4259840 using 64 bit Big Endian - 18. ◉ testABunchOfNats consumed all input - 19. ◉ testABunchOfNats successfully decoded 4259840 using 64 bit Little Endian - 20. ◉ testABunchOfNats consumed all input - 21. ◉ testABunchOfNats successfully decoded 4259840 using 32 bit Big Endian - 22. ◉ testABunchOfNats consumed all input - 23. ◉ testABunchOfNats successfully decoded 4259840 using 32 bit Little Endian - 24. ◉ testABunchOfNats consumed all input - 25. ◉ testABunchOfNats successfully decoded 16640 using 64 bit Big Endian - 26. ◉ testABunchOfNats consumed all input - 27. ◉ testABunchOfNats successfully decoded 16640 using 64 bit Little Endian - 28. ◉ testABunchOfNats consumed all input - 29. ◉ testABunchOfNats successfully decoded 16640 using 32 bit Big Endian - 30. ◉ testABunchOfNats consumed all input - 31. ◉ testABunchOfNats successfully decoded 16640 using 32 bit Little Endian - 32. ◉ testABunchOfNats consumed all input - 33. ◉ testABunchOfNats successfully decoded 16640 using 16 bit Big Endian - 34. ◉ testABunchOfNats consumed all input - 35. ◉ testABunchOfNats successfully decoded 16640 using 16 bit Little Endian - 36. ◉ testABunchOfNats consumed all input - 37. ◉ testABunchOfNats successfully decoded 2255827097 using 64 bit Big Endian - 38. ◉ testABunchOfNats consumed all input - 39. ◉ testABunchOfNats successfully decoded 2255827097 using 64 bit Little Endian - 40. ◉ testABunchOfNats consumed all input - 41. ◉ testABunchOfNats successfully decoded 2255827097 using 32 bit Big Endian - 42. ◉ testABunchOfNats consumed all input - 43. ◉ testABunchOfNats successfully decoded 2255827097 using 32 bit Little Endian - 44. ◉ testABunchOfNats consumed all input - 45. ◉ testABunchOfNats successfully decoded 65 using 64 bit Big Endian - 46. ◉ testABunchOfNats consumed all input - 47. ◉ testABunchOfNats successfully decoded 65 using 64 bit Little Endian - 48. ◉ testABunchOfNats consumed all input - 49. ◉ testABunchOfNats successfully decoded 65 using 32 bit Big Endian - 50. ◉ testABunchOfNats consumed all input - 51. ◉ testABunchOfNats successfully decoded 65 using 32 bit Little Endian - 52. ◉ testABunchOfNats consumed all input - 53. ◉ testABunchOfNats successfully decoded 65 using 16 bit Big Endian - 54. ◉ testABunchOfNats consumed all input - 55. ◉ testABunchOfNats successfully decoded 65 using 16 bit Little Endian - 56. ◉ testABunchOfNats consumed all input - 57. ◉ testABunchOfNats successfully decoded 0 using 64 bit Big Endian - 58. ◉ testABunchOfNats consumed all input - 59. ◉ testABunchOfNats successfully decoded 0 using 64 bit Little Endian - 60. ◉ testABunchOfNats consumed all input - 61. ◉ testABunchOfNats successfully decoded 0 using 32 bit Big Endian - 62. ◉ testABunchOfNats consumed all input - 63. ◉ testABunchOfNats successfully decoded 0 using 32 bit Little Endian - 64. ◉ testABunchOfNats consumed all input - 65. ◉ testABunchOfNats successfully decoded 0 using 16 bit Big Endian - 66. ◉ testABunchOfNats consumed all input - 67. ◉ testABunchOfNats successfully decoded 0 using 16 bit Little Endian - 68. ◉ testABunchOfNats consumed all input + 1. testABunchOfNats ◉ successfully decoded 4294967295 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 4294967295 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 4294967295 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 4294967295 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 1090519040 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 1090519040 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 1090519040 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 1090519040 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 4259840 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 4259840 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 4259840 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 4259840 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 16640 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 16640 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 16640 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 16640 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 16640 using 16 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 16640 using 16 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 2255827097 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 2255827097 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 2255827097 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 2255827097 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 65 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 65 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 65 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 65 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 65 using 16 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 65 using 16 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 0 using 64 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 0 using 64 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 0 using 32 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 0 using 32 bit Little Endian + ◉ consumed all input + ◉ successfully decoded 0 using 16 bit Big Endian + ◉ consumed all input + ◉ successfully decoded 0 using 16 bit Little Endian + ◉ consumed all input ✅ 68 test(s) passing diff --git a/unison-src/transcripts-using-base/codeops.output.md b/unison-src/transcripts-using-base/codeops.output.md index a3571968f0..d1acab398f 100644 --- a/unison-src/transcripts-using-base/codeops.output.md +++ b/unison-src/transcripts-using-base/codeops.output.md @@ -364,19 +364,19 @@ to actual show that the serialization works. New test results: - 1. ◉ tests (ext f) passed - 2. ◉ tests (ext h) passed - 3. ◉ tests (ident compound) passed - 4. ◉ tests (ident fib10) passed - 5. ◉ tests (ident effect) passed - 6. ◉ tests (ident zero) passed - 7. ◉ tests (ident h) passed - 8. ◉ tests (ident text) passed - 9. ◉ tests (ident int) passed - 10. ◉ tests (ident float) passed - 11. ◉ tests (ident termlink) passed - 12. ◉ tests (ident bool) passed - 13. ◉ tests (ident bytes) passed + 1. tests ◉ (ext f) passed + ◉ (ext h) passed + ◉ (ident compound) passed + ◉ (ident fib10) passed + ◉ (ident effect) passed + ◉ (ident zero) passed + ◉ (ident h) passed + ◉ (ident text) passed + ◉ (ident int) passed + ◉ (ident float) passed + ◉ (ident termlink) passed + ◉ (ident bool) passed + ◉ (ident bytes) passed ✅ 13 test(s) passing @@ -386,7 +386,7 @@ to actual show that the serialization works. New test results: - 1. ◉ badLoad serialized77 + 1. badLoad ◉ serialized77 ✅ 1 test(s) passing @@ -453,36 +453,36 @@ codeTests = New test results: - 1. ◉ codeTests (idem f) passed - 2. ◉ codeTests (idem h) passed - 3. ◉ codeTests (idem rotate) passed - 4. ◉ codeTests (idem zapper) passed - 5. ◉ codeTests (idem showThree) passed - 6. ◉ codeTests (idem concatMap) passed - 7. ◉ codeTests (idem big) passed - 8. ◉ codeTests (idem extensionality) passed - 9. ◉ codeTests (idem identicality) passed - 10. ◉ codeTests (verified f) passed - 11. ◉ codeTests (verified h) passed - 12. ◉ codeTests (verified rotate) passed - 13. ◉ codeTests (verified zapper) passed - 14. ◉ codeTests (verified showThree) passed - 15. ◉ codeTests (verified concatMap) passed - 16. ◉ codeTests (verified big) passed - 17. ◉ codeTests (verified extensionality) passed - 18. ◉ codeTests (verified identicality) passed - 19. ◉ codeTests (verified mutual0) passed - 20. ◉ codeTests (verified mutual1) passed - 21. ◉ codeTests (verified mutual2) passed - 22. ◉ codeTests (rejected missing mutual0) passed - 23. ◉ codeTests (rejected missing mutual1) passed - 24. ◉ codeTests (rejected missing mutual2) passed - 25. ◉ codeTests (rejected swapped zapper) passed - 26. ◉ codeTests (rejected swapped extensionality) passed - 27. ◉ codeTests (rejected swapped identicality) passed - 28. ◉ codeTests (rejected swapped mututal0) passed - 29. ◉ codeTests (rejected swapped mututal1) passed - 30. ◉ codeTests (rejected swapped mututal2) passed + 1. codeTests ◉ (idem f) passed + ◉ (idem h) passed + ◉ (idem rotate) passed + ◉ (idem zapper) passed + ◉ (idem showThree) passed + ◉ (idem concatMap) passed + ◉ (idem big) passed + ◉ (idem extensionality) passed + ◉ (idem identicality) passed + ◉ (verified f) passed + ◉ (verified h) passed + ◉ (verified rotate) passed + ◉ (verified zapper) passed + ◉ (verified showThree) passed + ◉ (verified concatMap) passed + ◉ (verified big) passed + ◉ (verified extensionality) passed + ◉ (verified identicality) passed + ◉ (verified mutual0) passed + ◉ (verified mutual1) passed + ◉ (verified mutual2) passed + ◉ (rejected missing mutual0) passed + ◉ (rejected missing mutual1) passed + ◉ (rejected missing mutual2) passed + ◉ (rejected swapped zapper) passed + ◉ (rejected swapped extensionality) passed + ◉ (rejected swapped identicality) passed + ◉ (rejected swapped mututal0) passed + ◉ (rejected swapped mututal1) passed + ◉ (rejected swapped mututal2) passed ✅ 30 test(s) passing @@ -541,14 +541,14 @@ vtests _ = New test results: - 1. ◉ vtests validated - 2. ◉ vtests validated - 3. ◉ vtests validated - 4. ◉ vtests validated - 5. ◉ vtests validated - 6. ◉ vtests validated - 7. ◉ vtests validated - 8. ◉ vtests validated + 1. vtests ◉ validated + ◉ validated + ◉ validated + ◉ validated + ◉ validated + ◉ validated + ◉ validated + ◉ validated ✅ 8 test(s) passing diff --git a/unison-src/transcripts-using-base/hashing.output.md b/unison-src/transcripts-using-base/hashing.output.md index e0b40f370e..56d0ec8cbf 100644 --- a/unison-src/transcripts-using-base/hashing.output.md +++ b/unison-src/transcripts-using-base/hashing.output.md @@ -316,31 +316,31 @@ test> crypto.hash.numTests = Cached test results (`help testcache` to learn more) - 1. ◉ blake2b_512.tests.ex1 Passed - 2. ◉ blake2b_512.tests.ex2 Passed - 3. ◉ blake2b_512.tests.ex3 Passed - 4. ◉ blake2s_256.tests.ex1 Passed - 5. ◉ crypto.hash.numTests Passed - 6. ◉ sha1.tests.ex1 Passed - 7. ◉ sha1.tests.ex2 Passed - 8. ◉ sha1.tests.ex3 Passed - 9. ◉ sha1.tests.ex4 Passed - 10. ◉ sha2_256.tests.ex1 Passed - 11. ◉ sha2_256.tests.ex2 Passed - 12. ◉ sha2_256.tests.ex3 Passed - 13. ◉ sha2_256.tests.ex4 Passed - 14. ◉ sha2_512.tests.ex1 Passed - 15. ◉ sha2_512.tests.ex2 Passed - 16. ◉ sha2_512.tests.ex3 Passed - 17. ◉ sha2_512.tests.ex4 Passed - 18. ◉ sha3_256.tests.ex1 Passed - 19. ◉ sha3_256.tests.ex2 Passed - 20. ◉ sha3_256.tests.ex3 Passed - 21. ◉ sha3_256.tests.ex4 Passed - 22. ◉ sha3_512.tests.ex1 Passed - 23. ◉ sha3_512.tests.ex2 Passed - 24. ◉ sha3_512.tests.ex3 Passed - 25. ◉ sha3_512.tests.ex4 Passed + 1. blake2b_512.tests.ex1 ◉ Passed + 2. blake2b_512.tests.ex2 ◉ Passed + 3. blake2b_512.tests.ex3 ◉ Passed + 4. blake2s_256.tests.ex1 ◉ Passed + 5. crypto.hash.numTests ◉ Passed + 6. sha1.tests.ex1 ◉ Passed + 7. sha1.tests.ex2 ◉ Passed + 8. sha1.tests.ex3 ◉ Passed + 9. sha1.tests.ex4 ◉ Passed + 10. sha2_256.tests.ex1 ◉ Passed + 11. sha2_256.tests.ex2 ◉ Passed + 12. sha2_256.tests.ex3 ◉ Passed + 13. sha2_256.tests.ex4 ◉ Passed + 14. sha2_512.tests.ex1 ◉ Passed + 15. sha2_512.tests.ex2 ◉ Passed + 16. sha2_512.tests.ex3 ◉ Passed + 17. sha2_512.tests.ex4 ◉ Passed + 18. sha3_256.tests.ex1 ◉ Passed + 19. sha3_256.tests.ex2 ◉ Passed + 20. sha3_256.tests.ex3 ◉ Passed + 21. sha3_256.tests.ex4 ◉ Passed + 22. sha3_512.tests.ex1 ◉ Passed + 23. sha3_512.tests.ex2 ◉ Passed + 24. sha3_512.tests.ex3 ◉ Passed + 25. sha3_512.tests.ex4 ◉ Passed ✅ 25 test(s) passing @@ -478,34 +478,34 @@ test> md5.tests.ex3 = Cached test results (`help testcache` to learn more) - 1. ◉ blake2b_512.tests.ex1 Passed - 2. ◉ blake2b_512.tests.ex2 Passed - 3. ◉ blake2b_512.tests.ex3 Passed - 4. ◉ blake2s_256.tests.ex1 Passed - 5. ◉ crypto.hash.numTests Passed - 6. ◉ md5.tests.ex1 Passed - 7. ◉ md5.tests.ex2 Passed - 8. ◉ md5.tests.ex3 Passed - 9. ◉ sha1.tests.ex1 Passed - 10. ◉ sha1.tests.ex2 Passed - 11. ◉ sha1.tests.ex3 Passed - 12. ◉ sha1.tests.ex4 Passed - 13. ◉ sha2_256.tests.ex1 Passed - 14. ◉ sha2_256.tests.ex2 Passed - 15. ◉ sha2_256.tests.ex3 Passed - 16. ◉ sha2_256.tests.ex4 Passed - 17. ◉ sha2_512.tests.ex1 Passed - 18. ◉ sha2_512.tests.ex2 Passed - 19. ◉ sha2_512.tests.ex3 Passed - 20. ◉ sha2_512.tests.ex4 Passed - 21. ◉ sha3_256.tests.ex1 Passed - 22. ◉ sha3_256.tests.ex2 Passed - 23. ◉ sha3_256.tests.ex3 Passed - 24. ◉ sha3_256.tests.ex4 Passed - 25. ◉ sha3_512.tests.ex1 Passed - 26. ◉ sha3_512.tests.ex2 Passed - 27. ◉ sha3_512.tests.ex3 Passed - 28. ◉ sha3_512.tests.ex4 Passed + 1. blake2b_512.tests.ex1 ◉ Passed + 2. blake2b_512.tests.ex2 ◉ Passed + 3. blake2b_512.tests.ex3 ◉ Passed + 4. blake2s_256.tests.ex1 ◉ Passed + 5. crypto.hash.numTests ◉ Passed + 6. md5.tests.ex1 ◉ Passed + 7. md5.tests.ex2 ◉ Passed + 8. md5.tests.ex3 ◉ Passed + 9. sha1.tests.ex1 ◉ Passed + 10. sha1.tests.ex2 ◉ Passed + 11. sha1.tests.ex3 ◉ Passed + 12. sha1.tests.ex4 ◉ Passed + 13. sha2_256.tests.ex1 ◉ Passed + 14. sha2_256.tests.ex2 ◉ Passed + 15. sha2_256.tests.ex3 ◉ Passed + 16. sha2_256.tests.ex4 ◉ Passed + 17. sha2_512.tests.ex1 ◉ Passed + 18. sha2_512.tests.ex2 ◉ Passed + 19. sha2_512.tests.ex3 ◉ Passed + 20. sha2_512.tests.ex4 ◉ Passed + 21. sha3_256.tests.ex1 ◉ Passed + 22. sha3_256.tests.ex2 ◉ Passed + 23. sha3_256.tests.ex3 ◉ Passed + 24. sha3_256.tests.ex4 ◉ Passed + 25. sha3_512.tests.ex1 ◉ Passed + 26. sha3_512.tests.ex2 ◉ Passed + 27. sha3_512.tests.ex3 ◉ Passed + 28. sha3_512.tests.ex4 ◉ Passed ✅ 28 test(s) passing diff --git a/unison-src/transcripts-using-base/mvar.output.md b/unison-src/transcripts-using-base/mvar.output.md index 244d700d87..d8940b562d 100644 --- a/unison-src/transcripts-using-base/mvar.output.md +++ b/unison-src/transcripts-using-base/mvar.output.md @@ -77,19 +77,19 @@ testMvars _ = New test results: - 1. ◉ testMvars ma should not be empty - 2. ◉ testMvars should read what you sow - 3. ◉ testMvars should reap what you sow - 4. ◉ testMvars ma should be empty - 5. ◉ testMvars swap returns old contents - 6. ◉ testMvars swap returns old contents - 7. ◉ testMvars tryRead should succeed when not empty - 8. ◉ testMvars tryPut should fail when not empty - 9. ◉ testMvars tryTake should succeed when not empty - 10. ◉ testMvars tryTake should not succeed when empty - 11. ◉ testMvars ma2 should be empty - 12. ◉ testMvars tryTake should fail when empty - 13. ◉ testMvars tryRead should fail when empty + 1. testMvars ◉ ma should not be empty + ◉ should read what you sow + ◉ should reap what you sow + ◉ ma should be empty + ◉ swap returns old contents + ◉ swap returns old contents + ◉ tryRead should succeed when not empty + ◉ tryPut should fail when not empty + ◉ tryTake should succeed when not empty + ◉ tryTake should not succeed when empty + ◉ ma2 should be empty + ◉ tryTake should fail when empty + ◉ tryRead should fail when empty ✅ 13 test(s) passing diff --git a/unison-src/transcripts-using-base/nat-coersion.output.md b/unison-src/transcripts-using-base/nat-coersion.output.md index 234ca77d13..462254508f 100644 --- a/unison-src/transcripts-using-base/nat-coersion.output.md +++ b/unison-src/transcripts-using-base/nat-coersion.output.md @@ -63,20 +63,20 @@ test = 'let New test results: - 1. ◉ test expected 0.0 got 0.0 - 2. ◉ test round trip though float, expected 0 got 0 - 3. ◉ test expected 0 got 0 - 4. ◉ test round trip though Int, expected 0 got 0 - 5. ◉ test skipped - 6. ◉ test expected 1 got 1 - 7. ◉ test round trip though Int, expected 1 got 1 - 8. ◉ test skipped - 9. ◉ test expected -1 got -1 - 10. ◉ test round trip though Int, expected 18446744073709551615 got 18446744073709551615 - 11. ◉ test expected 1.0000000000000002 got 1.0000000000000002 - 12. ◉ test round trip though float, expected 4607182418800017409 got 4607182418800017409 - 13. ◉ test expected 4607182418800017409 got 4607182418800017409 - 14. ◉ test round trip though Int, expected 4607182418800017409 got 4607182418800017409 + 1. test ◉ expected 0.0 got 0.0 + ◉ round trip though float, expected 0 got 0 + ◉ expected 0 got 0 + ◉ round trip though Int, expected 0 got 0 + ◉ skipped + ◉ expected 1 got 1 + ◉ round trip though Int, expected 1 got 1 + ◉ skipped + ◉ expected -1 got -1 + ◉ round trip though Int, expected 18446744073709551615 got 18446744073709551615 + ◉ expected 1.0000000000000002 got 1.0000000000000002 + ◉ round trip though float, expected 4607182418800017409 got 4607182418800017409 + ◉ expected 4607182418800017409 got 4607182418800017409 + ◉ round trip though Int, expected 4607182418800017409 got 4607182418800017409 ✅ 14 test(s) passing diff --git a/unison-src/transcripts-using-base/net.output.md b/unison-src/transcripts-using-base/net.output.md index fcd072ca0c..5a09511824 100644 --- a/unison-src/transcripts-using-base/net.output.md +++ b/unison-src/transcripts-using-base/net.output.md @@ -119,9 +119,9 @@ testDefaultPort _ = New test results: - 1. ◉ testDefaultPort successfully created socket - 2. ◉ testDefaultPort port should be > 1024 - 3. ◉ testDefaultPort port should be < 65536 + 1. testDefaultPort ◉ successfully created socket + ◉ port should be > 1024 + ◉ port should be < 65536 ✅ 3 test(s) passing @@ -206,7 +206,7 @@ testTcpConnect = 'let New test results: - 1. ◉ testTcpConnect should have reaped what we've sown + 1. testTcpConnect ◉ should have reaped what we've sown ✅ 1 test(s) passing diff --git a/unison-src/transcripts-using-base/random-deserial.output.md b/unison-src/transcripts-using-base/random-deserial.output.md index 305cf5848f..1e1c234aa0 100644 --- a/unison-src/transcripts-using-base/random-deserial.output.md +++ b/unison-src/transcripts-using-base/random-deserial.output.md @@ -89,11 +89,11 @@ serialTests = do New test results: - 1. ◉ serialTests case-00 - 2. ◉ serialTests case-01 - 3. ◉ serialTests case-02 - 4. ◉ serialTests case-03 - 5. ◉ serialTests case-04 + 1. serialTests ◉ case-00 + ◉ case-01 + ◉ case-02 + ◉ case-03 + ◉ case-04 ✅ 5 test(s) passing diff --git a/unison-src/transcripts-using-base/ref-promise.output.md b/unison-src/transcripts-using-base/ref-promise.output.md index 9def3379e1..e10b0a95dd 100644 --- a/unison-src/transcripts-using-base/ref-promise.output.md +++ b/unison-src/transcripts-using-base/ref-promise.output.md @@ -42,8 +42,8 @@ casTest = do New test results: - 1. ◉ casTest CAS is successful is there were no conflicting writes - 2. ◉ casTest CAS fails when there was an intervening write + 1. casTest ◉ CAS is successful is there were no conflicting writes + ◉ CAS fails when there was an intervening write ✅ 2 test(s) passing @@ -106,8 +106,8 @@ promiseConcurrentTest = do New test results: - 1. ◉ promiseSequentialTest Should read a value that's been written - 2. ◉ promiseSequentialTest Promise can only be written to once + 1. promiseSequentialTest ◉ Should read a value that's been written + ◉ Promise can only be written to once ✅ 2 test(s) passing @@ -117,7 +117,7 @@ promiseConcurrentTest = do New test results: - 1. ◉ promiseConcurrentTest Reads awaits for completion of the Promise + 1. promiseConcurrentTest ◉ Reads awaits for completion of the Promise ✅ 1 test(s) passing @@ -246,7 +246,7 @@ fullTest = do New test results: - 1. ◉ fullTest The state of the counter is consistent + 1. fullTest ◉ The state of the counter is consistent ✅ 1 test(s) passing diff --git a/unison-src/transcripts-using-base/stm.output.md b/unison-src/transcripts-using-base/stm.output.md index 8d129b66ac..ecc5a3105d 100644 --- a/unison-src/transcripts-using-base/stm.output.md +++ b/unison-src/transcripts-using-base/stm.output.md @@ -119,16 +119,16 @@ tests = '(map spawn nats) New test results: - 1. ◉ tests verified - 2. ◉ tests verified - 3. ◉ tests verified - 4. ◉ tests verified - 5. ◉ tests verified - 6. ◉ tests verified - 7. ◉ tests verified - 8. ◉ tests verified - 9. ◉ tests verified - 10. ◉ tests verified + 1. tests ◉ verified + ◉ verified + ◉ verified + ◉ verified + ◉ verified + ◉ verified + ◉ verified + ◉ verified + ◉ verified + ◉ verified ✅ 10 test(s) passing diff --git a/unison-src/transcripts-using-base/thread.output.md b/unison-src/transcripts-using-base/thread.output.md index d5160f22c6..2fa1218ae8 100644 --- a/unison-src/transcripts-using-base/thread.output.md +++ b/unison-src/transcripts-using-base/thread.output.md @@ -82,7 +82,7 @@ testBasicMultiThreadMVar = 'let New test results: - 1. ◉ testBasicMultiThreadMVar other thread should have incremented + 1. testBasicMultiThreadMVar ◉ other thread should have incremented ✅ 1 test(s) passing @@ -157,7 +157,7 @@ testTwoThreads = 'let New test results: - 1. ◉ testTwoThreads + 1. testTwoThreads ◉ ✅ 1 test(s) passing diff --git a/unison-src/transcripts-using-base/tls.output.md b/unison-src/transcripts-using-base/tls.output.md index f3b992baf7..7e5f06cb0d 100644 --- a/unison-src/transcripts-using-base/tls.output.md +++ b/unison-src/transcripts-using-base/tls.output.md @@ -55,8 +55,8 @@ what_should_work _ = this_should_work ++ this_should_not_work New test results: - 1. ◉ what_should_work succesfully decoded self_signed_pem - 2. ◉ what_should_work failed + 1. what_should_work ◉ succesfully decoded self_signed_pem + ◉ failed ✅ 2 test(s) passing @@ -255,7 +255,7 @@ testCNReject _ = New test results: - 1. ◉ testConnectSelfSigned should have reaped what we've sown + 1. testConnectSelfSigned ◉ should have reaped what we've sown ✅ 1 test(s) passing @@ -265,7 +265,7 @@ testCNReject _ = New test results: - 1. ◉ testCAReject correctly rejected self-signed cert + 1. testCAReject ◉ correctly rejected self-signed cert ✅ 1 test(s) passing @@ -275,7 +275,7 @@ testCNReject _ = New test results: - 1. ◉ testCNReject correctly rejected self-signed cert + 1. testCNReject ◉ correctly rejected self-signed cert ✅ 1 test(s) passing diff --git a/unison-src/transcripts/builtins.output.md b/unison-src/transcripts/builtins.output.md index 0de060002f..c654a69ddf 100644 --- a/unison-src/transcripts/builtins.output.md +++ b/unison-src/transcripts/builtins.output.md @@ -490,7 +490,7 @@ openFilesIO = do New test results: - 1. ◉ openFilesIO Passed + 1. openFilesIO ◉ Passed ✅ 1 test(s) passing @@ -539,33 +539,33 @@ Now that all the tests have been added to the codebase, let's view the test repo Cached test results (`help testcache` to learn more) - 1. ◉ Any.test1 Passed - 2. ◉ Any.test2 Passed - 3. ◉ Boolean.tests.andTable Passed - 4. ◉ Boolean.tests.notTable Passed - 5. ◉ Boolean.tests.orTable Passed - 6. ◉ Bytes.tests.at Passed - 7. ◉ Bytes.tests.compression Passed - 8. ◉ Bytes.tests.fromBase64UrlUnpadded Passed - 9. ◉ Bytes.tests.indexOf Passed - 10. ◉ Int.tests.arithmetic Passed - 11. ◉ Int.tests.bitTwiddling Passed - 12. ◉ Int.tests.conversions Passed - 13. ◉ Nat.tests.arithmetic Passed - 14. ◉ Nat.tests.bitTwiddling Passed - 15. ◉ Nat.tests.conversions Passed - 16. ◉ Sandbox.test1 Passed - 17. ◉ Sandbox.test2 Passed - 18. ◉ Sandbox.test3 Passed - 19. ◉ test.rtjqan7bcs Passed - 20. ◉ Text.tests.alignment Passed - 21. ◉ Text.tests.indexOf Passed - 22. ◉ Text.tests.indexOfEmoji Passed - 23. ◉ Text.tests.literalsEq Passed - 24. ◉ Text.tests.patterns Passed - 25. ◉ Text.tests.repeat Passed - 26. ◉ Text.tests.takeDropAppend Passed - 27. ◉ Universal.murmurHash.tests Passed + 1. Any.test1 ◉ Passed + 2. Any.test2 ◉ Passed + 3. Boolean.tests.andTable ◉ Passed + 4. Boolean.tests.notTable ◉ Passed + 5. Boolean.tests.orTable ◉ Passed + 6. Bytes.tests.at ◉ Passed + 7. Bytes.tests.compression ◉ Passed + 8. Bytes.tests.fromBase64UrlUnpadded ◉ Passed + 9. Bytes.tests.indexOf ◉ Passed + 10. Int.tests.arithmetic ◉ Passed + 11. Int.tests.bitTwiddling ◉ Passed + 12. Int.tests.conversions ◉ Passed + 13. Nat.tests.arithmetic ◉ Passed + 14. Nat.tests.bitTwiddling ◉ Passed + 15. Nat.tests.conversions ◉ Passed + 16. Sandbox.test1 ◉ Passed + 17. Sandbox.test2 ◉ Passed + 18. Sandbox.test3 ◉ Passed + 19. test.rtjqan7bcs ◉ Passed + 20. Text.tests.alignment ◉ Passed + 21. Text.tests.indexOf ◉ Passed + 22. Text.tests.indexOfEmoji ◉ Passed + 23. Text.tests.literalsEq ◉ Passed + 24. Text.tests.patterns ◉ Passed + 25. Text.tests.repeat ◉ Passed + 26. Text.tests.takeDropAppend ◉ Passed + 27. Universal.murmurHash.tests ◉ Passed ✅ 27 test(s) passing diff --git a/unison-src/transcripts/fix2049.output.md b/unison-src/transcripts/fix2049.output.md index c7c9932da5..d5b99e63d8 100644 --- a/unison-src/transcripts/fix2049.output.md +++ b/unison-src/transcripts/fix2049.output.md @@ -132,9 +132,9 @@ tests _ = New test results: - 1. ◉ tests caught - 2. ◉ tests caught - 3. ◉ tests got the right answer + 1. tests ◉ caught + ◉ caught + ◉ got the right answer ✅ 3 test(s) passing diff --git a/unison-src/transcripts/fix4172.output.md b/unison-src/transcripts/fix4172.output.md index a7125abe77..2216b286d7 100644 --- a/unison-src/transcripts/fix4172.output.md +++ b/unison-src/transcripts/fix4172.output.md @@ -49,7 +49,7 @@ allowDebug = debug [1,2,3] Cached test results (`help testcache` to learn more) - 1. ◉ t1 Yay + 1. t1 ◉ Yay ✅ 1 test(s) passing @@ -91,7 +91,7 @@ bool = false New test results: - 1. ✗ t1 [1, 2, 3] + 1. t1 ✗ [1, 2, 3] 🚫 1 test(s) failing diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md index c2384f98b3..cccf11a8f2 100644 --- a/unison-src/transcripts/fix5080.output.md +++ b/unison-src/transcripts/fix5080.output.md @@ -6,7 +6,7 @@ I'll now fetch the latest version of the base Unison library... - Downloaded 14053 entities. + Downloaded 14067 entities. 🎨 Type `ui` to explore this project's code in your browser. 🔭 Discover libraries at https://share.unison-lang.org @@ -63,9 +63,9 @@ test-5080/main> test Cached test results (`help testcache` to learn more) - 1. ◉ fix5080.tests.success Passed + 1. fix5080.tests.success ◉ Passed - 2. ✗ fix5080.tests.failure Failed + 2. fix5080.tests.failure ✗ Failed 🚫 1 test(s) failing, ✅ 1 test(s) passing @@ -81,7 +81,7 @@ test-5080/main> test Cached test results (`help testcache` to learn more) - 1. ◉ fix5080.tests.success Passed + 1. fix5080.tests.success ◉ Passed ✅ 1 test(s) passing diff --git a/unison-src/transcripts/fix942.output.md b/unison-src/transcripts/fix942.output.md index a4f3921316..694cf43425 100644 --- a/unison-src/transcripts/fix942.output.md +++ b/unison-src/transcripts/fix942.output.md @@ -116,7 +116,7 @@ test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] Cached test results (`help testcache` to learn more) - 1. ◉ t1 great + 1. t1 ◉ great ✅ 1 test(s) passing diff --git a/unison-src/transcripts/io-test-command.output.md b/unison-src/transcripts/io-test-command.output.md index 23ac26d5e6..5a792b1d95 100644 --- a/unison-src/transcripts/io-test-command.output.md +++ b/unison-src/transcripts/io-test-command.output.md @@ -22,7 +22,7 @@ Run a IO tests one by one New test results: - 1. ◉ ioAndExceptionTest Success + 1. ioAndExceptionTest ◉ Success ✅ 1 test(s) passing @@ -32,7 +32,7 @@ Run a IO tests one by one New test results: - 1. ◉ ioTest Success + 1. ioTest ◉ Success ✅ 1 test(s) passing @@ -46,7 +46,7 @@ Run a IO tests one by one New test results: - 1. ◉ ioAndExceptionTest Success + 1. ioAndExceptionTest ◉ Success ✅ 1 test(s) passing @@ -68,8 +68,8 @@ Run a IO tests one by one New test results: - 1. ◉ ioAndExceptionTest Success - 2. ◉ ioTest Success + 1. ioAndExceptionTest ◉ Success + 2. ioTest ◉ Success ✅ 2 test(s) passing diff --git a/unison-src/transcripts/io.output.md b/unison-src/transcripts/io.output.md index 15d91b0e47..a45df02d60 100644 --- a/unison-src/transcripts/io.output.md +++ b/unison-src/transcripts/io.output.md @@ -69,13 +69,13 @@ testCreateRename _ = New test results: - 1. ◉ testCreateRename create a foo directory - 2. ◉ testCreateRename directory should exist - 3. ◉ testCreateRename foo should no longer exist - 4. ◉ testCreateRename directory should no longer exist - 5. ◉ testCreateRename bar should now exist - 6. ◉ testCreateRename removeDirectory works recursively - 7. ◉ testCreateRename removeDirectory works recursively + 1. testCreateRename ◉ create a foo directory + ◉ directory should exist + ◉ foo should no longer exist + ◉ directory should no longer exist + ◉ bar should now exist + ◉ removeDirectory works recursively + ◉ removeDirectory works recursively ✅ 7 test(s) passing @@ -151,12 +151,12 @@ testOpenClose _ = New test results: - 1. ◉ testOpenClose file should be open - 2. ◉ testOpenClose file handle buffering should match what we just set. - 3. ◉ testOpenClose file should be closed - 4. ◉ testOpenClose bytes have been written - 5. ◉ testOpenClose bytes have been written - 6. ◉ testOpenClose file should be closed + 1. testOpenClose ◉ file should be open + ◉ file handle buffering should match what we just set. + ◉ file should be closed + ◉ bytes have been written + ◉ bytes have been written + ◉ file should be closed ✅ 6 test(s) passing @@ -241,14 +241,14 @@ testGetSomeBytes _ = New test results: - 1. ◉ testGetSomeBytes chunk size splits data into 2 uneven sides - 2. ◉ testGetSomeBytes file should be closed - 3. ◉ testGetSomeBytes first chunk matches first part of testData - 4. ◉ testGetSomeBytes second chunk matches rest of testData - 5. ◉ testGetSomeBytes should be at end of file - 6. ◉ testGetSomeBytes reading at end of file results in Bytes.empty - 7. ◉ testGetSomeBytes requesting many bytes results in what's available - 8. ◉ testGetSomeBytes file should be closed + 1. testGetSomeBytes ◉ chunk size splits data into 2 uneven sides + ◉ file should be closed + ◉ first chunk matches first part of testData + ◉ second chunk matches rest of testData + ◉ should be at end of file + ◉ reading at end of file results in Bytes.empty + ◉ requesting many bytes results in what's available + ◉ file should be closed ✅ 8 test(s) passing @@ -350,13 +350,13 @@ testAppend _ = New test results: - 1. ◉ testSeek seeked - 2. ◉ testSeek readable file should be seekable - 3. ◉ testSeek shouldn't be the EOF - 4. ◉ testSeek we should be at position 0 - 5. ◉ testSeek we should be at position 1 - 6. ◉ testSeek should be able to read our temporary file after seeking - 7. ◉ testSeek getLine should get a line + 1. testSeek ◉ seeked + ◉ readable file should be seekable + ◉ shouldn't be the EOF + ◉ we should be at position 0 + ◉ we should be at position 1 + ◉ should be able to read our temporary file after seeking + ◉ getLine should get a line ✅ 7 test(s) passing @@ -366,7 +366,7 @@ testAppend _ = New test results: - 1. ◉ testAppend should be able to read our temporary file + 1. testAppend ◉ should be able to read our temporary file ✅ 1 test(s) passing @@ -408,7 +408,7 @@ testSystemTime _ = New test results: - 1. ◉ testSystemTime systemTime should be sane + 1. testSystemTime ◉ systemTime should be sane ✅ 1 test(s) passing @@ -438,8 +438,8 @@ testGetTempDirectory _ = New test results: - 1. ◉ testGetTempDirectory Temp directory is directory - 2. ◉ testGetTempDirectory Temp directory should exist + 1. testGetTempDirectory ◉ Temp directory is directory + ◉ Temp directory should exist ✅ 2 test(s) passing @@ -469,8 +469,8 @@ testGetCurrentDirectory _ = New test results: - 1. ◉ testGetCurrentDirectory Current directory is directory - 2. ◉ testGetCurrentDirectory Current directory should exist + 1. testGetCurrentDirectory ◉ Current directory is directory + ◉ Current directory should exist ✅ 2 test(s) passing @@ -502,8 +502,8 @@ testDirContents _ = New test results: - 1. ◉ testDirContents directory size should be - 2. ◉ testDirContents directory contents should have current directory and parent + 1. testDirContents ◉ directory size should be + ◉ directory contents should have current directory and parent ✅ 2 test(s) passing @@ -535,8 +535,8 @@ testGetEnv _ = New test results: - 1. ◉ testGetEnv PATH environent variable should be set - 2. ◉ testGetEnv DOESNTEXIST didn't exist + 1. testGetEnv ◉ PATH environent variable should be set + ◉ DOESNTEXIST didn't exist ✅ 2 test(s) passing @@ -699,8 +699,8 @@ testRandom = do New test results: - 1. ◉ testGetEnv PATH environent variable should be set - 2. ◉ testGetEnv DOESNTEXIST didn't exist + 1. testGetEnv ◉ PATH environent variable should be set + ◉ DOESNTEXIST didn't exist ✅ 2 test(s) passing diff --git a/unison-src/transcripts/test-command.output.md b/unison-src/transcripts/test-command.output.md index f0255893fa..ccd73793eb 100644 --- a/unison-src/transcripts/test-command.output.md +++ b/unison-src/transcripts/test-command.output.md @@ -39,8 +39,8 @@ foo.test2 = [Ok "test2"] New test results: - 1. ◉ foo.test2 test2 - 2. ◉ test1 test1 + 1. foo.test2 ◉ test2 + 2. test1 ◉ test1 ✅ 2 test(s) passing @@ -54,8 +54,8 @@ Tests should be cached if unchanged. Cached test results (`help testcache` to learn more) - 1. ◉ foo.test2 test2 - 2. ◉ test1 test1 + 1. foo.test2 ◉ test2 + 2. test1 ◉ test1 ✅ 2 test(s) passing @@ -87,8 +87,8 @@ testInLib = [Ok "testInLib"] Cached test results (`help testcache` to learn more) - 1. ◉ foo.test2 test2 - 2. ◉ test1 test1 + 1. foo.test2 ◉ test2 + 2. test1 ◉ test1 ✅ 2 test(s) passing @@ -99,8 +99,8 @@ testInLib = [Ok "testInLib"] Cached test results (`help testcache` to learn more) - 1. ◉ foo.test2 test2 - 2. ◉ test1 test1 + 1. foo.test2 ◉ test2 + 2. test1 ◉ test1 ✅ 2 test(s) passing @@ -112,7 +112,7 @@ testInLib = [Ok "testInLib"] New test results: - 1. ◉ lib.testInLib testInLib + 1. lib.testInLib ◉ testInLib ✅ 1 test(s) passing @@ -126,7 +126,7 @@ testInLib = [Ok "testInLib"] Cached test results (`help testcache` to learn more) - 1. ◉ testInLib testInLib + 1. testInLib ◉ testInLib ✅ 1 test(s) passing @@ -140,7 +140,7 @@ testInLib = [Ok "testInLib"] Cached test results (`help testcache` to learn more) - 1. ◉ foo.test2 test2 + 1. foo.test2 ◉ test2 ✅ 1 test(s) passing diff --git a/unison-src/transcripts/top-level-exceptions.output.md b/unison-src/transcripts/top-level-exceptions.output.md index b220d0272f..7f225434d9 100644 --- a/unison-src/transcripts/top-level-exceptions.output.md +++ b/unison-src/transcripts/top-level-exceptions.output.md @@ -55,7 +55,7 @@ mytest _ = [Ok "Great"] New test results: - 1. ◉ mytest Great + 1. mytest ◉ Great ✅ 1 test(s) passing diff --git a/unison-src/transcripts/unsafe-coerce.output.md b/unison-src/transcripts/unsafe-coerce.output.md index 777eb9f344..f9b84c74c5 100644 --- a/unison-src/transcripts/unsafe-coerce.output.md +++ b/unison-src/transcripts/unsafe-coerce.output.md @@ -45,7 +45,7 @@ main _ = New test results: - 1. ◉ main + 1. main ◉ ✅ 1 test(s) passing diff --git a/unison-src/transcripts/watch-expressions.output.md b/unison-src/transcripts/watch-expressions.output.md index 2a5fa08f55..1d7097895e 100644 --- a/unison-src/transcripts/watch-expressions.output.md +++ b/unison-src/transcripts/watch-expressions.output.md @@ -64,7 +64,7 @@ test> pass = [Ok "Passed"] Cached test results (`help testcache` to learn more) - 1. ◉ pass Passed + 1. pass ◉ Passed ✅ 1 test(s) passing From df9e78138fdd82fb70da7466e5bcf54807f4425e Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 27 Jun 2024 11:12:21 -0400 Subject: [PATCH 305/631] in delete.md, replace uses of merge.old with debug.alias.{term,type}.force --- unison-src/transcripts/delete.md | 34 +------- unison-src/transcripts/delete.output.md | 100 +++--------------------- 2 files changed, 17 insertions(+), 117 deletions(-) diff --git a/unison-src/transcripts/delete.md b/unison-src/transcripts/delete.md index e3e27ede98..aadb7a602f 100644 --- a/unison-src/transcripts/delete.md +++ b/unison-src/transcripts/delete.md @@ -32,28 +32,18 @@ How about an ambiguous term? ```unison:hide foo = 1 +bar = 2 ``` ```ucm .a> add -``` - -```unison:hide -foo = 2 -``` - -```ucm -.b> add -.a> merge.old .b +.a> debug.alias.term.force bar foo ``` A delete should remove both versions of the term. ```ucm .> delete.verbose a.foo -``` - -```ucm:error .a> ls ``` @@ -61,26 +51,13 @@ Let's repeat all that on a type, for completeness. ```unison:hide structural type Foo = Foo () +structural type Bar = Bar ``` ```ucm .a> add -``` - -```unison:hide -structural type Foo = Foo -``` - -```ucm -.b> add -.a> merge.old .b -``` - -```ucm +.a> debug.alias.type.force Bar Foo .> delete.verbose a.Foo -``` - -```ucm .> delete.verbose a.Foo.Foo ``` @@ -93,9 +70,6 @@ structural type foo = Foo () ```ucm .> add -``` - -```ucm .> delete.verbose foo ``` diff --git a/unison-src/transcripts/delete.output.md b/unison-src/transcripts/delete.output.md index 02b757d4c4..14ca930fe1 100644 --- a/unison-src/transcripts/delete.output.md +++ b/unison-src/transcripts/delete.output.md @@ -59,6 +59,7 @@ How about an ambiguous term? ```unison foo = 1 +bar = 2 ``` ```ucm @@ -68,40 +69,12 @@ foo = 1 ⍟ I've added these definitions: + bar : ##Nat foo : ##Nat -``` -```unison -foo = 2 -``` +.a> debug.alias.term.force bar foo -```ucm - ☝️ The namespace .b is empty. - -.b> add - - ⍟ I've added these definitions: - - foo : ##Nat - -.a> merge.old .b - - Here's what's changed in the current namespace after the - merge: - - New name conflicts: - - 1. foo#gjmq673r1v : ##Nat - ↓ - 2. ┌ foo#dcgdua2lj6 : ##Nat - 3. └ foo#gjmq673r1v : ##Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... + Done. ``` A delete should remove both versions of the term. @@ -116,24 +89,21 @@ A delete should remove both versions of the term. Name changes: Original Changes - 2. b.foo ┐ 3. a.foo#dcgdua2lj6 (removed) + 2. a.bar ┐ 3. a.foo#dcgdua2lj6 (removed) 4. a.foo#dcgdua2lj6 ┘ Tip: You can use `undo` or `reflog` to undo this change. -``` -```ucm - ☝️ The namespace .a is empty. - .a> ls - nothing to show + 1. bar (##Nat) ``` Let's repeat all that on a type, for completeness. ```unison structural type Foo = Foo () +structural type Bar = Bar ``` ```ucm @@ -141,46 +111,13 @@ structural type Foo = Foo () ⍟ I've added these definitions: + structural type Bar structural type Foo -``` -```unison -structural type Foo = Foo -``` - -```ucm -.b> add - - ⍟ I've added these definitions: - - structural type Foo - -.a> merge.old .b +.a> debug.alias.type.force Bar Foo - Here's what's changed in the current namespace after the - merge: - - New name conflicts: - - 1. structural type Foo#089vmor9c5 - ↓ - 2. ┌ structural type Foo#00nv2kob8f - 3. └ structural type Foo#089vmor9c5 - - 4. Foo.Foo#089vmor9c5#0 : 'Foo#089vmor9c5 - ↓ - 5. ┌ Foo.Foo#00nv2kob8f#0 : () - 6. └ Foo.Foo#089vmor9c5#0 : 'Foo#089vmor9c5 - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. + Done. - Applying changes from patch... - -``` -```ucm .> delete.verbose a.Foo Removed definitions: @@ -190,26 +127,17 @@ structural type Foo = Foo Name changes: Original Changes - 2. b.Foo ┐ 3. a.Foo#00nv2kob8f (removed) + 2. a.Bar ┐ 3. a.Foo#00nv2kob8f (removed) 4. builtin.Unit │ 5. a.Foo#00nv2kob8f ┘ Tip: You can use `undo` or `reflog` to undo this change. -``` -```ucm .> delete.verbose a.Foo.Foo Removed definitions: - 1. a.Foo.Foo#089vmor9c5#0 : '#089vmor9c5 - - Name changes: - - Original Changes - 2. b.Foo.Foo ┐ 3. a.Foo.Foo#00nv2kob8f#0 (removed) - 4. builtin.Unit.Unit │ - 5. a.Foo.Foo#00nv2kob8f#0 ┘ + 1. a.Foo.Foo : '#089vmor9c5 Tip: You can use `undo` or `reflog` to undo this change. @@ -229,8 +157,6 @@ structural type foo = Foo () structural type foo foo : Nat -``` -```ucm .> delete.verbose foo Removed definitions: @@ -354,7 +280,7 @@ d = a + b + c a : Nat b : Nat - (also named b.foo) + (also named a.bar) c : Nat d : Nat From 831c2e0e06517260e94d933fb853ebd398c9c453 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 27 Jun 2024 11:30:17 -0400 Subject: [PATCH 306/631] in diff-namespace.md, replace uses of merge.old with debug.alias.term.force --- unison-src/transcripts/diff-namespace.md | 40 ++--- .../transcripts/diff-namespace.output.md | 138 ++++-------------- 2 files changed, 51 insertions(+), 127 deletions(-) diff --git a/unison-src/transcripts/diff-namespace.md b/unison-src/transcripts/diff-namespace.md index 7db0bc898a..4d04dda791 100644 --- a/unison-src/transcripts/diff-namespace.md +++ b/unison-src/transcripts/diff-namespace.md @@ -3,23 +3,19 @@ ``` ```unison:hide -x = 23 +b1.x = 23 +b1.fslkdjflskdjflksjdf = 663 +b2.x = 23 +b2.fslkdjflskdjflksjdf = 23 +b2.abc = 23 ``` ```ucm -.b1> add -.b1> alias.term x fslkdjflskdjflksjdf -.> fork b1 b2 -.b2> alias.term x abc -``` - -```unison:hide -fslkdjflskdjflksjdf = 663 +.> add +.> debug.alias.term.force b1.x b1.fslkdjflskdjflksjdf ``` ```ucm -.b0> add -.> merge.old b0 b1 .> diff.namespace b1 b2 .b2> diff.namespace .b1 ``` @@ -63,12 +59,13 @@ Here's what we've done so far: ``` ```unison:hide -fromJust = "asldkfjasldkfj" +junk = "asldkfjasldkfj" ``` ```ucm -.ns1b> add -.> merge.old ns1b ns1 +.ns1> add +.ns1> debug.alias.term.force junk fromJust +.ns1> delete.term junk ``` ```unison:hide @@ -104,33 +101,40 @@ bdependent = "banana" ## Two different auto-propagated changes creating a name conflict + Currently, the auto-propagated name-conflicted definitions are not explicitly shown, only their also-conflicted dependency is shown. + ```unison:hide a = 333 b = a + 1 ``` + ```ucm .nsx> add .> fork nsx nsy .> fork nsx nsz ``` + ```unison:hide a = 444 ``` + ```ucm .nsy> update.old ``` + ```unison:hide a = 555 ``` + ```ucm .nsz> update.old -.> merge.old nsy nsw -``` -```ucm:error -.> merge.old nsz nsw +.> fork nsy nsw +.> debug.alias.term.force nsz.a nsw.a +.> debug.alias.term.force nsz.b nsw.b ``` + ```ucm .> diff.namespace nsx nsw .nsw> view a b diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md index cacb9d1fc4..490fb3fa2c 100644 --- a/unison-src/transcripts/diff-namespace.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -1,60 +1,28 @@ ```unison -x = 23 +b1.x = 23 +b1.fslkdjflskdjflksjdf = 663 +b2.x = 23 +b2.fslkdjflskdjflksjdf = 23 +b2.abc = 23 ``` ```ucm - ☝️ The namespace .b1 is empty. - -.b1> add +.> add ⍟ I've added these definitions: - x : ##Nat - -.b1> alias.term x fslkdjflskdjflksjdf - - Done. - -.> fork b1 b2 - - Done. + b1.fslkdjflskdjflksjdf : Nat + b1.x : Nat + b2.abc : Nat + b2.fslkdjflskdjflksjdf : Nat + b2.x : Nat -.b2> alias.term x abc +.> debug.alias.term.force b1.x b1.fslkdjflskdjflksjdf Done. ``` -```unison -fslkdjflskdjflksjdf = 663 -``` - ```ucm - ☝️ The namespace .b0 is empty. - -.b0> add - - ⍟ I've added these definitions: - - fslkdjflskdjflksjdf : ##Nat - -.> merge.old b0 b1 - - Here's what's changed in b1 after the merge: - - New name conflicts: - - 1. fslkdjflskdjflksjdf#u520d1t9kc : Nat - ↓ - 2. ┌ fslkdjflskdjflksjdf#sekb3fdsvb : Nat - 3. └ fslkdjflskdjflksjdf#u520d1t9kc : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... - .> diff.namespace b1 b2 Resolved name conflicts: @@ -155,35 +123,23 @@ Here's what we've done so far: ``` ```unison -fromJust = "asldkfjasldkfj" +junk = "asldkfjasldkfj" ``` ```ucm - ☝️ The namespace .ns1b is empty. - -.ns1b> add +.ns1> add ⍟ I've added these definitions: - fromJust : ##Text + junk : ##Text -.> merge.old ns1b ns1 +.ns1> debug.alias.term.force junk fromJust - Here's what's changed in ns1 after the merge: - - New name conflicts: - - 1. fromJust#gjmq673r1v : Nat - ↓ - 2. ┌ fromJust#gjmq673r1v : Nat - 3. └ fromJust#rnbo52q2sh : Text - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. + Done. - Applying changes from patch... +.ns1> delete.term junk + + Done. ``` ```unison @@ -356,8 +312,10 @@ bdependent = "banana" ``` ## Two different auto-propagated changes creating a name conflict + Currently, the auto-propagated name-conflicted definitions are not explicitly shown, only their also-conflicted dependency is shown. + ```unison a = 333 b = a + 1 @@ -405,55 +363,17 @@ a = 555 a : ##Nat -.> merge.old nsy nsw - - Here's what's changed in nsw after the merge: - - Added definitions: - - 1. a : Nat - 2. b : Nat - - 3. patch patch (added 1 updates) - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. +.> fork nsy nsw - Applying changes from patch... + Done. -``` -```ucm -.> merge.old nsz nsw +.> debug.alias.term.force nsz.a nsw.a - Here's what's changed in nsw after the merge: - - New name conflicts: - - 1. a#mdl4vqtu00 : Nat - ↓ - 2. ┌ a#mdl4vqtu00 : Nat - 3. └ a#vrs8gtkl2t : Nat - - 4. b#unkqhuu66p : Nat - ↓ - 5. ┌ b#aapqletas7 : Nat - 6. └ b#unkqhuu66p : Nat - - Updates: - - 7. patch patch (added 1 updates) - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. + Done. - Applying changes from patch... +.> debug.alias.term.force nsz.b nsw.b - I tried to auto-apply the patch, but couldn't because it - contained contradictory entries. + Done. ``` ```ucm @@ -473,7 +393,7 @@ a = 555 Added definitions: - 7. patch patch (added 2 updates) + 7. patch patch (added 1 updates) .nsw> view a b From d9618f7ab306de148eeb8012c7ac03fe3c4bca75 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 27 Jun 2024 11:41:25 -0400 Subject: [PATCH 307/631] in name-selection.md, replace use of merge.old with debug.alias.term.force --- unison-src/transcripts/name-selection.md | 46 ++++---- .../transcripts/name-selection.output.md | 105 +++++++----------- 2 files changed, 63 insertions(+), 88 deletions(-) diff --git a/unison-src/transcripts/name-selection.md b/unison-src/transcripts/name-selection.md index 992ee79491..cff6c15d4f 100644 --- a/unison-src/transcripts/name-selection.md +++ b/unison-src/transcripts/name-selection.md @@ -12,46 +12,40 @@ This transcript shows how the pretty-printer picks names for a hash when multipl ``` ```unison:hide -a = b + 1 -b = 0 + 1 +a.a = a.b + 1 +a.b = 0 + 1 +a.aaa.but.more.segments = 0 + 1 ``` Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment length alias), and show that it isn't used when viewing `a`: ```ucm -.a> add -.a> alias.term b aaa.but.more.segments +.> add .a> view a ``` Next let's introduce a conflicting symbol and show that its hash qualified name isn't used when it has an unconflicted name: -``` -.> fork a a2 -.> fork a a3 -``` - -```unison:hide -c = 1 -d = c + 10 -``` - -```ucm:hide -.a2> builtins.merge -``` -```ucm -.a2> add -.a2> alias.term c long.name.but.shortest.suffixification -``` - ```unison:hide -c = 2 -d = c + 10 +a2.a = a2.b + 1 +a2.b = 0 + 1 +a2.aaa.but.more.segments = 0 + 1 +a2.c = 1 +a2.d = a2.c + 10 +a2.long.name.but.shortest.suffixification = 1 + +a3.a = a3.b + 1 +a3.b = 0 + 1 +a3.aaa.but.more.segments = 0 + 1 +a3.c = 2 +a3.d = a3.c + 10 +a3.long.name.but.shortest.suffixification = 1 ``` ```ucm -.a3> add -.a3> merge.old .a2 .a3 +.> add +.> debug.alias.term.force a2.c a3.c +.> debug.alias.term.force a2.d a3.d ``` At this point, `a3` is conflicted for symbols `c` and `d`, so those are deprioritized. diff --git a/unison-src/transcripts/name-selection.output.md b/unison-src/transcripts/name-selection.output.md index e124c18a20..a9b3d9679f 100644 --- a/unison-src/transcripts/name-selection.output.md +++ b/unison-src/transcripts/name-selection.output.md @@ -5,23 +5,21 @@ This transcript shows how the pretty-printer picks names for a hash when multipl 3. Otherwise if there are multiple names with a minimal number of segments, compare the names alphabetically. ```unison -a = b + 1 -b = 0 + 1 +a.a = a.b + 1 +a.b = 0 + 1 +a.aaa.but.more.segments = 0 + 1 ``` Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment length alias), and show that it isn't used when viewing `a`: ```ucm -.a> add +.> add ⍟ I've added these definitions: - a : Nat - b : Nat - -.a> alias.term b aaa.but.more.segments - - Done. + a.a : Nat + a.aaa.but.more.segments : Nat + a.b : Nat .a> view a @@ -33,70 +31,53 @@ Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment ``` Next let's introduce a conflicting symbol and show that its hash qualified name isn't used when it has an unconflicted name: -``` -.> fork a a2 -.> fork a a3 - -``` - ```unison -c = 1 -d = c + 10 +a2.a = a2.b + 1 +a2.b = 0 + 1 +a2.aaa.but.more.segments = 0 + 1 +a2.c = 1 +a2.d = a2.c + 10 +a2.long.name.but.shortest.suffixification = 1 + +a3.a = a3.b + 1 +a3.b = 0 + 1 +a3.aaa.but.more.segments = 0 + 1 +a3.c = 2 +a3.d = a3.c + 10 +a3.long.name.but.shortest.suffixification = 1 ``` ```ucm -.a2> add +.> add ⍟ I've added these definitions: - c : Nat - d : Nat - -.a2> alias.term c long.name.but.shortest.suffixification + a2.a : Nat + (also named a.a) + a2.aaa.but.more.segments : Nat + (also named a.b and a.aaa.but.more.segments) + a2.b : Nat + (also named a.b and a.aaa.but.more.segments) + a2.c : Nat + a2.d : Nat + a2.long.name.but.shortest.suffixification : Nat + a3.a : Nat + (also named a.a) + a3.aaa.but.more.segments : Nat + (also named a.b and a.aaa.but.more.segments) + a3.b : Nat + (also named a.b and a.aaa.but.more.segments) + a3.c : Nat + a3.d : Nat + a3.long.name.but.shortest.suffixification : Nat + +.> debug.alias.term.force a2.c a3.c Done. -``` -```unison -c = 2 -d = c + 10 -``` - -```ucm -.a3> add +.> debug.alias.term.force a2.d a3.d - ⍟ I've added these definitions: - - c : Nat - d : Nat - -.a3> merge.old .a2 .a3 - - Here's what's changed in .a3 after the merge: - - New name conflicts: - - 1. c#dcgdua2lj6 : Nat - ↓ - 2. ┌ c#dcgdua2lj6 : Nat - 3. └ c#gjmq673r1v : Nat - - 4. d#9ivhgvhthc : Nat - ↓ - 5. ┌ d#9ivhgvhthc : Nat - 6. └ d#ve16e6jmf6 : Nat - - Added definitions: - - 7. ┌ c#gjmq673r1v : Nat - 8. └ long.name.but.shortest.suffixification : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. - - Applying changes from patch... + Done. ``` At this point, `a3` is conflicted for symbols `c` and `d`, so those are deprioritized. From d1f2d7863836815c8546c737d434fa5ff5f529d2 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 27 Jun 2024 11:44:46 -0400 Subject: [PATCH 308/631] in update-on-conflict.md, replace use of merge.old with debug.alias.term.force --- unison-src/transcripts/update-on-conflict.md | 16 ++--- .../transcripts/update-on-conflict.output.md | 59 ++++++------------- 2 files changed, 26 insertions(+), 49 deletions(-) diff --git a/unison-src/transcripts/update-on-conflict.md b/unison-src/transcripts/update-on-conflict.md index 21b9a656cb..73a699cafb 100644 --- a/unison-src/transcripts/update-on-conflict.md +++ b/unison-src/transcripts/update-on-conflict.md @@ -1,28 +1,28 @@ # Update on conflict +Updating conflicted definitions works fine. + ```ucm:hide .> builtins.merge .merged> builtins.merge ``` ```unison -a.x = 1 -b.x = 2 +x = 1 +temp = 2 ``` -Cause a conflict: ```ucm .> add -.merged> merge.old .a -.merged> merge.old .b +.> debug.alias.term.force temp x +.> delete.term temp ``` -Updating conflicted definitions works fine. - ```unison x = 3 ``` ```ucm -.merged> update +.> update +.> view x ``` diff --git a/unison-src/transcripts/update-on-conflict.output.md b/unison-src/transcripts/update-on-conflict.output.md index 6a9afd2e93..f5e8e484f6 100644 --- a/unison-src/transcripts/update-on-conflict.output.md +++ b/unison-src/transcripts/update-on-conflict.output.md @@ -1,8 +1,10 @@ # Update on conflict +Updating conflicted definitions works fine. + ```unison -a.x = 1 -b.x = 2 +x = 1 +temp = 2 ``` ```ucm @@ -15,57 +17,27 @@ b.x = 2 ⍟ These new definitions are ok to `add`: - a.x : Nat - b.x : Nat + temp : Nat + x : Nat ``` -Cause a conflict: ```ucm .> add ⍟ I've added these definitions: - a.x : Nat - b.x : Nat - -.merged> merge.old .a - - Here's what's changed in the current namespace after the - merge: - - Added definitions: - - 1. x : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. + temp : Nat + x : Nat - Applying changes from patch... +.> debug.alias.term.force temp x -.merged> merge.old .b + Done. - Here's what's changed in the current namespace after the - merge: - - New name conflicts: - - 1. x#gjmq673r1v : Nat - ↓ - 2. ┌ x#dcgdua2lj6 : Nat - 3. └ x#gjmq673r1v : Nat - - Tip: You can use `todo` to see if this generated any work to - do in this namespace and `test` to run the tests. Or you - can use `undo` or `reflog` to undo the results of this - merge. +.> delete.term temp - Applying changes from patch... + Done. ``` -Updating conflicted definitions works fine. - ```unison x = 3 ``` @@ -85,11 +57,16 @@ x = 3 ``` ```ucm -.merged> update +.> update Okay, I'm searching the branch for code that needs to be updated... Done. +.> view x + + x : Nat + x = 3 + ``` From c97d93ee671b9710a80fa0df8c4be68d171632ee Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Thu, 27 Jun 2024 17:03:38 +0100 Subject: [PATCH 309/631] lsp 2.3.0.0 --- contrib/cabal.project | 1 + unison-cli/src/Unison/LSP.hs | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/contrib/cabal.project b/contrib/cabal.project index abab30e92e..513bdd17de 100644 --- a/contrib/cabal.project +++ b/contrib/cabal.project @@ -46,6 +46,7 @@ source-repository-package tag: 9275eea7982dabbf47be2ba078ced669ae7ef3d5 constraints: + lsp == 2.3.0.0, fsnotify < 0.4, crypton-x509-store <= 1.6.8, servant <= 0.19.1, diff --git a/unison-cli/src/Unison/LSP.hs b/unison-cli/src/Unison/LSP.hs index 867a08ed1e..071ab193cf 100644 --- a/unison-cli/src/Unison/LSP.hs +++ b/unison-cli/src/Unison/LSP.hs @@ -80,8 +80,8 @@ spawnLsp lspFormattingConfig codebase runtime latestRootHash latestPath = -- currently we have an independent VFS for each LSP client since each client might have -- different un-saved state for the same file. - initVFS $ \vfs -> do - vfsVar <- newMVar vfs + do + vfsVar <- newMVar emptyVFS void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestRootHash latestPath) where handleFailure :: String -> IOException -> IO () From a35d70646f4d7e64169d9716e2266b38f9c23358 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Thu, 27 Jun 2024 17:04:02 +0100 Subject: [PATCH 310/631] Use GHC.IsList --- parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs | 4 ++-- parser-typechecker/src/Unison/Runtime/Array.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs index b4e04d40cc..6bb4b315f2 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs @@ -20,10 +20,10 @@ import Data.Serialize.Put (runPutLazy) import Data.Text (Text) import Data.Word (Word16, Word32, Word64) import GHC.Stack +import GHC.IsList qualified (fromList) import Unison.ABT.Normalized (Term (..)) import Unison.Reference (Reference, Reference' (Builtin), pattern Derived) import Unison.Runtime.ANF as ANF hiding (Tag) -import Unison.Runtime.Array qualified as PA import Unison.Runtime.Exception import Unison.Runtime.Serialize import Unison.Util.EnumContainers qualified as EC @@ -682,7 +682,7 @@ getBLit v = NegT -> Neg <$> getPositive CharT -> Char <$> getChar FloatT -> Float <$> getFloat - ArrT -> Arr . PA.fromList <$> getList (getValue v) + ArrT -> Arr . GHC.IsList.fromList <$> getList (getValue v) putRefs :: (MonadPut m) => [Reference] -> m () putRefs rs = putFoldable putReference rs diff --git a/parser-typechecker/src/Unison/Runtime/Array.hs b/parser-typechecker/src/Unison/Runtime/Array.hs index 2faa68903a..a067d93383 100644 --- a/parser-typechecker/src/Unison/Runtime/Array.hs +++ b/parser-typechecker/src/Unison/Runtime/Array.hs @@ -56,7 +56,7 @@ import Data.Primitive.PrimArray as EPA hiding import Data.Primitive.PrimArray qualified as PA import Data.Primitive.Types import Data.Word (Word8) -import GHC.Exts (toList) +import GHC.IsList (toList ) #ifdef ARRAY_CHECK import GHC.Stack From 95a0eb95f90df2a87bf33f8505e9e263d710c478 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Thu, 27 Jun 2024 17:04:14 +0100 Subject: [PATCH 311/631] cleanup cabal --- contrib/cabal.project | 14 ++++++++++---- parser-typechecker/package.yaml | 2 +- parser-typechecker/unison-parser-typechecker.cabal | 4 ++-- unison-cli/unison-cli.cabal | 6 +++--- 4 files changed, 16 insertions(+), 10 deletions(-) diff --git a/contrib/cabal.project b/contrib/cabal.project index 513bdd17de..4fbbf28abb 100644 --- a/contrib/cabal.project +++ b/contrib/cabal.project @@ -29,7 +29,9 @@ packages: parser-typechecker unison-core unison-cli + unison-cli-main unison-hashing-v2 + unison-merge unison-share-api unison-share-projects-api unison-syntax @@ -47,10 +49,11 @@ source-repository-package constraints: lsp == 2.3.0.0, - fsnotify < 0.4, - crypton-x509-store <= 1.6.8, - servant <= 0.19.1, - optparse-applicative <= 0.17.1.0 + fsnotify == 0.4.1.0, + crypton-x509-store == 1.6.9, + servant == 0.20.1, + optparse-applicative == 0.18.1.0, + tls == 1.8.0 -- For now there is no way to apply ghc-options for all local packages -- See https://cabal.readthedocs.io/en/latest/cabal-project.html#package-configuration-options @@ -129,6 +132,9 @@ package unison-core package unison-hashing-v2 ghc-options: -Wall -Werror -Wno-name-shadowing -Wno-type-defaults -Wno-missing-pattern-synonym-signatures -fprint-expanded-synonyms -fwrite-ide-info +package unison-merge + ghc-options: -Wall -Werror -Wno-name-shadowing -Wno-type-defaults -Wno-missing-pattern-synonym-signatures -fprint-expanded-synonyms -fwrite-ide-info + package unison-share-api ghc-options: -Wall -Werror -Wno-name-shadowing -Wno-type-defaults -Wno-missing-pattern-synonym-signatures -fprint-expanded-synonyms -fwrite-ide-info diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml index 8aa23a2938..ea633fdc78 100644 --- a/parser-typechecker/package.yaml +++ b/parser-typechecker/package.yaml @@ -80,7 +80,7 @@ dependencies: - nonempty-containers - open-browser - openapi3 - - optparse-applicative >= 0.16.1.0 + - optparse-applicative - pem - pretty-simple - primitive diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 14c70b8fd8..6aa74d67ee 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -286,7 +286,7 @@ library , nonempty-containers , open-browser , openapi3 - , optparse-applicative >=0.16.1.0 + , optparse-applicative , pem , pretty-simple , primitive @@ -485,7 +485,7 @@ test-suite parser-typechecker-tests , nonempty-containers , open-browser , openapi3 - , optparse-applicative >=0.16.1.0 + , optparse-applicative , pem , pretty-simple , primitive diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index dd26e4321e..644a962f38 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -217,7 +217,7 @@ library , ki , lens , lock-file - , lsp >=2.2.0.0 + , lsp , lsp-types >=2.0.2.0 , megaparsec , memory @@ -359,7 +359,7 @@ executable transcripts , ki , lens , lock-file - , lsp >=2.2.0.0 + , lsp , lsp-types >=2.0.2.0 , megaparsec , memory @@ -508,7 +508,7 @@ test-suite cli-tests , ki , lens , lock-file - , lsp >=2.2.0.0 + , lsp , lsp-types >=2.0.2.0 , megaparsec , memory From c1bd940ce124e8afeb935e303dd8b656fb6884fb Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 27 Jun 2024 12:28:39 -0400 Subject: [PATCH 312/631] Bump share dependency --- .github/workflows/ci.md | 2 +- .github/workflows/ci.yaml | 2 +- .../transcripts-manual/gen-racket-libs.md | 2 +- .../gen-racket-libs.output.md | 25 +++---------------- unison-src/transcripts/fix5080.output.md | 2 +- 5 files changed, 8 insertions(+), 25 deletions(-) diff --git a/.github/workflows/ci.md b/.github/workflows/ci.md index 4f0de29bf9..e23874d7ac 100644 --- a/.github/workflows/ci.md +++ b/.github/workflows/ci.md @@ -9,7 +9,7 @@ At a high level, the CI process is: Some version numbers that are used during CI: - `ormolu_version: "0.5.0.1"` - `racket_version: "8.7"` -- `jit_version: "@unison/internal/releases/0.0.17"` +- `jit_version: "@unison/internal/releases/0.0.18"` Some cached directories: - `ucm_local_bin` a temp path for caching a built `ucm` diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 8a5e089ce4..51f1f720f3 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -14,7 +14,7 @@ on: env: ormolu_version: 0.5.2.0 ucm_local_bin: ucm-local-bin - jit_version: "@unison/internal/releases/0.0.17" + jit_version: "@unison/internal/releases/0.0.18" jit_src_scheme: unison-jit-src/scheme-libs/racket jit_dist: unison-jit-dist jit_generator_os: ubuntu-20.04 diff --git a/unison-src/transcripts-manual/gen-racket-libs.md b/unison-src/transcripts-manual/gen-racket-libs.md index 811ec14f50..178503c969 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.md +++ b/unison-src/transcripts-manual/gen-racket-libs.md @@ -4,7 +4,7 @@ When we start out, `./scheme-libs/racket` contains a bunch of library files that Next, we'll download the jit project and generate a few Racket files from it. ```ucm -jit-setup/main> lib.install @unison/internal/releases/0.0.17 +jit-setup/main> lib.install @unison/internal/releases/0.0.18 ``` ```unison diff --git a/unison-src/transcripts-manual/gen-racket-libs.output.md b/unison-src/transcripts-manual/gen-racket-libs.output.md index 241a9cdc59..1e003ab489 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.output.md +++ b/unison-src/transcripts-manual/gen-racket-libs.output.md @@ -4,29 +4,12 @@ When we start out, `./scheme-libs/racket` contains a bunch of library files that Next, we'll download the jit project and generate a few Racket files from it. ```ucm -.> project.create-empty jit-setup +jit-setup/main> lib.install @unison/internal/releases/0.0.18 - 🎉 I've created the project jit-setup. + Downloaded 14917 entities. - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - -jit-setup/main> pull @unison/internal/releases/0.0.17 lib.jit - - Downloaded 15091 entities. - - ✅ - - Successfully pulled into lib.jit, which was empty. + I installed @unison/internal/releases/0.0.18 as + unison_internal_0_0_18. ``` ```unison diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md index c2384f98b3..745b2e0478 100644 --- a/unison-src/transcripts/fix5080.output.md +++ b/unison-src/transcripts/fix5080.output.md @@ -6,7 +6,7 @@ I'll now fetch the latest version of the base Unison library... - Downloaded 14053 entities. + Downloaded 14067 entities. 🎨 Type `ui` to explore this project's code in your browser. 🔭 Discover libraries at https://share.unison-lang.org From 47a3a01fbe422faeabab9643814966150eb7cdc3 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 27 Jun 2024 10:17:27 -0700 Subject: [PATCH 313/631] Fix up api transcripts --- unison-src/transcripts/api-doc-rendering.md | 2 +- .../transcripts/api-doc-rendering.output.md | 795 +++++++++++++++++- .../transcripts/api-namespace-details.md | 2 +- .../api-namespace-details.output.md | 42 +- unison-src/transcripts/api-namespace-list.md | 4 +- .../transcripts/api-namespace-list.output.md | 98 ++- unison-src/transcripts/api-summaries.md | 26 +- .../transcripts/api-summaries.output.md | 26 +- 8 files changed, 951 insertions(+), 44 deletions(-) diff --git a/unison-src/transcripts/api-doc-rendering.md b/unison-src/transcripts/api-doc-rendering.md index 1ab59a53d7..eb0d956949 100644 --- a/unison-src/transcripts/api-doc-rendering.md +++ b/unison-src/transcripts/api-doc-rendering.md @@ -90,5 +90,5 @@ scratch/main> display term.doc ``` ```api -GET /api/non-project-code/getDefinition?names=term +GET /api/projects/scratch/branches/main/getDefinition?names=term ``` diff --git a/unison-src/transcripts/api-doc-rendering.output.md b/unison-src/transcripts/api-doc-rendering.output.md index 6c44614548..f767c14cf7 100644 --- a/unison-src/transcripts/api-doc-rendering.output.md +++ b/unison-src/transcripts/api-doc-rendering.output.md @@ -147,12 +147,797 @@ scratch/main> display term.doc ``` ```api -GET /api/non-project-code/getDefinition?names=term +GET /api/projects/scratch/branches/main/getDefinition?names=term { - "missingDefinitions": [ - "term" - ], - "termDefinitions": {}, + "missingDefinitions": [], + "termDefinitions": { + "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { + "bestTermName": "term", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "42" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "doc", + "#kjfaflbrgl89j2uq4ruubejakm6s02cp3m61ufu7rv7tkbd4nmkvcn1fciue53v0msir9t7ds111ab9er8qfa06gsa9ddfrdfgc99mo", + { + "contents": [ + { + "contents": [ + { + "contents": "Heading", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + [ + { + "contents": [ + { + "contents": [ + { + "contents": "Heading", + "tag": "Word" + }, + { + "contents": "2", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + [ + { + "contents": [ + { + "contents": "Term", + "tag": "Word" + }, + { + "contents": "Link:", + "tag": "Word" + }, + { + "contents": { + "contents": [ + { + "annotation": { + "contents": "#k5gpql9cbdfau6lf1aja24joc3sfctvjor8esu8bemn0in3l148otb0t3vebgqrt6qml302h62bbfeftg65gec1v8ouin5m6v2969d8", + "tag": "TermReference" + }, + "segment": "otherTerm" + } + ], + "tag": "Link" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Type", + "tag": "Word" + }, + { + "contents": "Link:", + "tag": "Word" + }, + { + "contents": { + "contents": [ + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Maybe" + } + ], + "tag": "Link" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Term", + "tag": "Word" + }, + { + "contents": "source:", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": [ + "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + { + "contents": [ + [ + { + "annotation": { + "contents": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "tag": "TermReference" + }, + "segment": "term" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": ": " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "42" + } + ] + ], + "tag": "UserObject" + } + ], + "tag": "Term" + } + ], + "tag": "Source" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Term", + "tag": "Word" + }, + { + "contents": "signature:", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + [ + { + "annotation": { + "contents": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "tag": "TermReference" + }, + "segment": "term" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": ": " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ] + ], + "tag": "Signature" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": [ + { + "contents": "List", + "tag": "Word" + }, + { + "contents": "item", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ], + "tag": "BulletedList" + }, + { + "contents": [ + 1, + [ + { + "contents": [ + { + "contents": "Numbered", + "tag": "Word" + }, + { + "contents": "list", + "tag": "Word" + }, + { + "contents": "item", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "tag": "NumberedList" + }, + { + "contents": [ + { + "contents": ">", + "tag": "Word" + }, + { + "contents": "Block", + "tag": "Word" + }, + { + "contents": "quote", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Code", + "tag": "Word" + }, + { + "contents": "block", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Inline", + "tag": "Word" + }, + { + "contents": "code:", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.+", + "tag": "TermReference" + }, + "segment": "Nat.+" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "2" + } + ], + "tag": "Example" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": "\"doesn't typecheck\" + 1", + "tag": "Word" + }, + "tag": "Code" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": [ + { + "contents": [ + { + "contents": "Link", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": { + "contents": "https://unison-lang.org", + "tag": "Word" + }, + "tag": "Group" + } + ], + "tag": "NamedLink" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png)", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": "Bold", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + "tag": "Bold" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": "Italic", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + "tag": "Bold" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": "Strikethrough", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + "tag": "Strikethrough" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Horizontal", + "tag": "Word" + }, + { + "contents": "rule", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "---", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Table", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Header", + "tag": "Word" + }, + { + "contents": "1", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Header", + "tag": "Word" + }, + { + "contents": "2", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "--------", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "--------", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Cell", + "tag": "Word" + }, + { + "contents": "1", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Cell", + "tag": "Word" + }, + { + "contents": "2", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Cell", + "tag": "Word" + }, + { + "contents": "3", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Cell", + "tag": "Word" + }, + { + "contents": "4", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Video", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + [ + { + "mediaSourceMimeType": null, + "mediaSourceUrl": "test.mp4" + } + ], + { + "poster": "test.png" + } + ], + "tag": "Video" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Transclusion/evaluation:", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": [ + { + "contents": [ + { + "contents": "This", + "tag": "Word" + }, + { + "contents": "doc", + "tag": "Word" + }, + { + "contents": "should", + "tag": "Word" + }, + { + "contents": "be", + "tag": "Word" + }, + { + "contents": "embedded.", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "message", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ], + "tag": "UntitledSection" + } + ], + "tag": "Paragraph" + } + ] + ], + "tag": "Section" + } + ] + ], + "tag": "Section" + } + ] + ], + "termNames": [ + "term" + ] + } + }, "typeDefinitions": {} } ``` \ No newline at end of file diff --git a/unison-src/transcripts/api-namespace-details.md b/unison-src/transcripts/api-namespace-details.md index 662d2e4db6..2d50bdae93 100644 --- a/unison-src/transcripts/api-namespace-details.md +++ b/unison-src/transcripts/api-namespace-details.md @@ -19,5 +19,5 @@ scratch/main> add ```api -- Should find names by suffix -GET /api/non-project-code/namespaces/nested.names +GET /api/projects/scratch/branches/main/namespaces/nested.names ``` diff --git a/unison-src/transcripts/api-namespace-details.output.md b/unison-src/transcripts/api-namespace-details.output.md index 34f8303185..0cdf2e88be 100644 --- a/unison-src/transcripts/api-namespace-details.output.md +++ b/unison-src/transcripts/api-namespace-details.output.md @@ -36,10 +36,46 @@ scratch/main> add ``` ```api -- Should find names by suffix -GET /api/non-project-code/namespaces/nested.names +GET /api/projects/scratch/branches/main/namespaces/nested.names { "fqn": "nested.names", - "hash": "#sg60bvjo91fsoo7pkh9gejbn0qgc95vra87ap6l5d35ri0lkaudl7bs12d71sf3fh6p23teemuor7mk1i9n567m50ibakcghjec5ajg", - "readme": null + "hash": "#6tnmlu9knsce0u2991u6fvcmf4v44fdf0aiqtmnq7mjj0gi5sephg3lf12iv3odr5rc7vlgq75ciborrd3625c701bdmdomia2gcm3o", + "readme": { + "contents": [ + { + "contents": "Here's", + "tag": "Word" + }, + { + "contents": "a", + "tag": "Word" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": "README", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + "tag": "Bold" + }, + { + "contents": "!", + "tag": "Word" + } + ], + "tag": "Join" + }, + "tag": "Group" + } + ], + "tag": "Paragraph" + } } ``` \ No newline at end of file diff --git a/unison-src/transcripts/api-namespace-list.md b/unison-src/transcripts/api-namespace-list.md index 1c07433e86..c3dbbeed13 100644 --- a/unison-src/transcripts/api-namespace-list.md +++ b/unison-src/transcripts/api-namespace-list.md @@ -16,7 +16,7 @@ scratch/main> add ``` ```api -GET /api/non-project-code/list?namespace=nested.names +GET /api/projects/scratch/branches/main/list?namespace=nested.names -GET /api/non-project-code/list?namespace=names&relativeTo=nested +GET /api/projects/scratch/branches/main/list?namespace=names&relativeTo=nested ``` diff --git a/unison-src/transcripts/api-namespace-list.output.md b/unison-src/transcripts/api-namespace-list.output.md index ddd7832ce2..4219aa1916 100644 --- a/unison-src/transcripts/api-namespace-list.output.md +++ b/unison-src/transcripts/api-namespace-list.output.md @@ -33,16 +33,102 @@ scratch/main> add ``` ```api -GET /api/non-project-code/list?namespace=nested.names +GET /api/projects/scratch/branches/main/list?namespace=nested.names { - "namespaceListingChildren": [], + "namespaceListingChildren": [ + { + "contents": { + "termHash": "#ddmmatmmiqsts2ku0i02kntd0s7rvcui4nn1cusio8thp9oqhbtilvcnhen52ibv43kr5q83f5er5q9h56s807k17tnelnrac7cch8o", + "termName": "readme", + "termTag": "Doc", + "termType": [ + { + "annotation": { + "contents": "#ej86si0ur1", + "tag": "HashQualifier" + }, + "segment": "#ej86si0ur1" + } + ] + }, + "tag": "TermObject" + }, + { + "contents": { + "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "termName": "x", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + }, + "tag": "TermObject" + }, + { + "contents": { + "namespaceHash": "#n1egracfeljprftoktbjcase2hs4f4p8idbhs5ujipl42agld1810hrq9t7p7ped16aagni2cm1fjcjhho770jh80ipthhmg0cnsur0", + "namespaceName": "x", + "namespaceSize": 1 + }, + "tag": "Subnamespace" + } + ], "namespaceListingFQN": "nested.names", - "namespaceListingHash": "#sg60bvjo91fsoo7pkh9gejbn0qgc95vra87ap6l5d35ri0lkaudl7bs12d71sf3fh6p23teemuor7mk1i9n567m50ibakcghjec5ajg" + "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" } -GET /api/non-project-code/list?namespace=names&relativeTo=nested +GET /api/projects/scratch/branches/main/list?namespace=names&relativeTo=nested { - "namespaceListingChildren": [], + "namespaceListingChildren": [ + { + "contents": { + "termHash": "#ddmmatmmiqsts2ku0i02kntd0s7rvcui4nn1cusio8thp9oqhbtilvcnhen52ibv43kr5q83f5er5q9h56s807k17tnelnrac7cch8o", + "termName": "readme", + "termTag": "Doc", + "termType": [ + { + "annotation": { + "contents": "#ej86si0ur1", + "tag": "HashQualifier" + }, + "segment": "#ej86si0ur1" + } + ] + }, + "tag": "TermObject" + }, + { + "contents": { + "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "termName": "x", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + }, + "tag": "TermObject" + }, + { + "contents": { + "namespaceHash": "#n1egracfeljprftoktbjcase2hs4f4p8idbhs5ujipl42agld1810hrq9t7p7ped16aagni2cm1fjcjhho770jh80ipthhmg0cnsur0", + "namespaceName": "x", + "namespaceSize": 1 + }, + "tag": "Subnamespace" + } + ], "namespaceListingFQN": "nested.names", - "namespaceListingHash": "#sg60bvjo91fsoo7pkh9gejbn0qgc95vra87ap6l5d35ri0lkaudl7bs12d71sf3fh6p23teemuor7mk1i9n567m50ibakcghjec5ajg" + "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" } ``` \ No newline at end of file diff --git a/unison-src/transcripts/api-summaries.md b/unison-src/transcripts/api-summaries.md index 8a7aa8b220..6bbc793a9f 100644 --- a/unison-src/transcripts/api-summaries.md +++ b/unison-src/transcripts/api-summaries.md @@ -34,47 +34,47 @@ scratch/main> alias.term ##IO.putBytes.impl.v3 putBytesImpl ```api -- term -GET /api/non-project-code/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat -- term without name uses hash -GET /api/non-project-code/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary -- doc -GET /api/non-project-code/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc -- test -GET /api/non-project-code/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest -- function -GET /api/non-project-code/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func -- constructor -GET /api/non-project-code/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This -- Long type signature -GET /api/non-project-code/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType -- Long type signature with render width -GET /api/non-project-code/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType -- Builtin Term -GET /api/non-project-code/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl ``` ## Type Summary APIs ```api -- data -GET /api/non-project-code/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing -- data with type args -GET /api/non-project-code/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe -- ability -GET /api/non-project-code/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream -- builtin type -GET /api/non-project-code/definitions/types/by-hash/@@Nat/summary?name=Nat +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@@Nat/summary?name=Nat ``` diff --git a/unison-src/transcripts/api-summaries.output.md b/unison-src/transcripts/api-summaries.output.md index cc5a9fcea3..e9f93e624e 100644 --- a/unison-src/transcripts/api-summaries.output.md +++ b/unison-src/transcripts/api-summaries.output.md @@ -23,7 +23,7 @@ structural ability Stream s where ```api -- term -GET /api/non-project-code/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat { "displayName": "nat", "hash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", @@ -42,7 +42,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sq "tag": "Plain" } -- term without name uses hash -GET /api/non-project-code/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary { "displayName": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", "hash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", @@ -61,7 +61,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sq "tag": "Plain" } -- doc -GET /api/non-project-code/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc { "displayName": "doc", "hash": "#icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo", @@ -80,7 +80,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bl "tag": "Doc" } -- test -GET /api/non-project-code/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest { "displayName": "mytest", "hash": "#u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8", @@ -111,7 +111,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccd "tag": "Test" } -- function -GET /api/non-project-code/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func { "displayName": "func", "hash": "#6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o", @@ -151,7 +151,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3o "tag": "Plain" } -- constructor -GET /api/non-project-code/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This { "displayName": "Thing.This", "hash": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0#0", @@ -191,7 +191,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5ad "tag": "DataConstructor" } -- Long type signature -GET /api/non-project-code/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType { "displayName": "funcWithLongType", "hash": "#ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8", @@ -378,7 +378,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59tton "tag": "Plain" } -- Long type signature with render width -GET /api/non-project-code/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType { "displayName": "funcWithLongType", "hash": "#ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8", @@ -565,7 +565,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59tton "tag": "Plain" } -- Builtin Term -GET /api/non-project-code/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl { "displayName": "putBytesImpl", "hash": "##IO.putBytes.impl.v3", @@ -671,7 +671,7 @@ GET /api/non-project-code/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summar ```api -- data -GET /api/non-project-code/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing { "displayName": "Thing", "hash": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0", @@ -710,7 +710,7 @@ GET /api/non-project-code/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5ad "tag": "Data" } -- data with type args -GET /api/non-project-code/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe { "displayName": "Maybe", "hash": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", @@ -759,7 +759,7 @@ GET /api/non-project-code/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6 "tag": "Data" } -- ability -GET /api/non-project-code/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream { "displayName": "Stream", "hash": "#rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8", @@ -808,7 +808,7 @@ GET /api/non-project-code/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aa "tag": "Ability" } -- builtin type -GET /api/non-project-code/definitions/types/by-hash/@@Nat/summary?name=Nat +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@@Nat/summary?name=Nat { "displayName": "Nat", "hash": "##Nat", From 384083e190a8e1896c113e81212d2e623413e5f8 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 27 Jun 2024 10:25:16 -0700 Subject: [PATCH 314/631] Revive strangely deleted bits of merge.md --- unison-src/transcripts/merge.md | 137 ++++++++++++++++++ unison-src/transcripts/merge.output.md | 188 +++++++++++++++++++++++++ 2 files changed, 325 insertions(+) diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index c2c632c034..66f2497e82 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -928,6 +928,143 @@ We will resolve this situation automatically in a future version. project/main> builtins.mergeio lib.builtins ``` +```ucm:hide +project/main> branch alice +``` + +Alice's additions: +```unison:hide +unique type Foo = Bar + +alice : Foo -> Nat +alice _ = 18 +``` + +```ucm:hide +project/alice> add +project/main> branch bob +``` + +Bob's additions: +```unison:hide +unique type Foo = Bar + +bob : Foo -> Nat +bob _ = 19 +``` + +```ucm:hide +project/bob> add +``` + +```ucm:error +project/alice> merge bob +``` + +```ucm:hide +.> project.delete project +``` + +## `merge.commit` example (success) + +After merge conflicts are resolved, you can use `merge.commit` rather than `switch` + `merge` + `branch.delete` to +"commit" your changes. + +```ucm:hide +.> project.create-empty project +project/main> builtins.mergeio lib.builtins +``` + +Original branch: +```unison:hide +foo : Text +foo = "old foo" +``` + +```ucm:hide +project/main> add +project/main> branch alice +``` + +Alice's changes: +```unison:hide +foo : Text +foo = "alices foo" +``` + +```ucm:hide +project/alice> update +project/main> branch bob +``` + +Bob's changes: + +```unison:hide +foo : Text +foo = "bobs foo" +``` + +Attempt to merge: + +```ucm:hide +project/bob> update +``` +```ucm:error +project/alice> merge /bob +``` + +Resolve conflicts and commit: + +```unison +foo : Text +foo = "alice and bobs foo" +``` + +```ucm +project/merge-bob-into-alice> update +project/merge-bob-into-alice> merge.commit +project/alice> view foo +project/alice> branches +``` + +```ucm:hide +.> project.delete project +``` + +## `merge.commit` example (failure) + +`merge.commit` can only be run on a "merge branch". + +```ucm:hide +.> project.create-empty project +project/main> builtins.mergeio lib.builtins +``` + +```ucm +project/main> branch topic +``` + +```ucm:error +project/topic> merge.commit +``` + +```ucm:hide +.> project.delete project +``` + + +## Precondition violations + +There are a number of conditions under which we can't perform a merge, and the user will have to fix up the namespace(s) manually before attempting to merge again. + +### Conflicted aliases + +If `foo` and `bar` are aliases in the nearest common ancestor, but not in Alice's branch, then we don't know whether to update Bob's dependents to Alice's `foo` or Alice's `bar` (and vice-versa). + +```ucm:hide +project/main> builtins.mergeio lib.builtins +``` + Original branch: ```unison:hide foo : Nat diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 1207a123cf..258413502d 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1030,6 +1030,194 @@ which is a parse error. We will resolve this situation automatically in a future version. +Alice's additions: +```unison +unique type Foo = Bar + +alice : Foo -> Nat +alice _ = 18 +``` + +Bob's additions: +```unison +unique type Foo = Bar + +bob : Foo -> Nat +bob _ = 19 +``` + +```ucm +project/alice> merge bob + + I couldn't automatically merge project/bob into project/alice. + However, I've added the definitions that need attention to the + top of scratch.u. + + When you're done, you can run + + merge.commit + + to merge your changes back into alice and delete the temporary + branch. Or, if you decide to cancel the merge instead, you can + run + + delete.branch /merge-bob-into-alice + + to delete the temporary branch and switch back to alice. + +``` +```unison:added-by-ucm scratch.u +-- project/alice +type Foo + = Bar + +-- project/bob +type Foo + = Bar + +-- The definitions below are not conflicted, but they each depend on one or more +-- conflicted definitions above. + +alice : Foo -> Nat +alice _ = 18 + +bob : Foo -> Nat +bob _ = 19 + + +``` + +## `merge.commit` example (success) + +After merge conflicts are resolved, you can use `merge.commit` rather than `switch` + `merge` + `branch.delete` to +"commit" your changes. + +Original branch: +```unison +foo : Text +foo = "old foo" +``` + +Alice's changes: +```unison +foo : Text +foo = "alices foo" +``` + +Bob's changes: + +```unison +foo : Text +foo = "bobs foo" +``` + +Attempt to merge: + +```ucm +project/alice> merge /bob + + I couldn't automatically merge project/bob into project/alice. + However, I've added the definitions that need attention to the + top of scratch.u. + + When you're done, you can run + + merge.commit + + to merge your changes back into alice and delete the temporary + branch. Or, if you decide to cancel the merge instead, you can + run + + delete.branch /merge-bob-into-alice + + to delete the temporary branch and switch back to alice. + +``` +```unison:added-by-ucm scratch.u +-- project/alice +foo : Text +foo = "alices foo" + +-- project/bob +foo : Text +foo = "bobs foo" + + +``` + +Resolve conflicts and commit: + +```unison +foo : Text +foo = "alice and bobs foo" +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + foo : Text + +``` +```ucm +project/merge-bob-into-alice> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +project/merge-bob-into-alice> merge.commit + + I fast-forward merged project/merge-bob-into-alice into + project/alice. + +project/alice> view foo + + foo : Text + foo = "alice and bobs foo" + +project/alice> branches + + Branch Remote branch + 1. alice + 2. bob + 3. main + +``` +## `merge.commit` example (failure) + +`merge.commit` can only be run on a "merge branch". + +```ucm +project/main> branch topic + + Done. I've created the topic branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic`. + +``` +```ucm +project/topic> merge.commit + + It doesn't look like there's a merge in progress. + +``` +## Precondition violations + +There are a number of conditions under which we can't perform a merge, and the user will have to fix up the namespace(s) manually before attempting to merge again. + +### Conflicted aliases + +If `foo` and `bar` are aliases in the nearest common ancestor, but not in Alice's branch, then we don't know whether to update Bob's dependents to Alice's `foo` or Alice's `bar` (and vice-versa). + Original branch: ```unison foo : Nat From 4b7cf99df6f30a82cd18e5924bfbfcabff71a8c3 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 27 Jun 2024 10:55:45 -0700 Subject: [PATCH 315/631] Fix fix5080 pulling over the network --- unison-src/transcripts/fix5080.md | 16 ++++---- unison-src/transcripts/fix5080.output.md | 49 +++++++----------------- 2 files changed, 21 insertions(+), 44 deletions(-) diff --git a/unison-src/transcripts/fix5080.md b/unison-src/transcripts/fix5080.md index 4c80c07602..5c343603de 100644 --- a/unison-src/transcripts/fix5080.md +++ b/unison-src/transcripts/fix5080.md @@ -1,18 +1,18 @@ -```ucm -.> project.create test-5080 +```ucm:hide +scratch/main> builtins.merge lib.builtins ``` ```unison -test> fix5080.tests.success = check (6 Nat.== 6) -test> fix5080.tests.failure = check (2 Nat.== 4) +test> fix5080.tests.success = [Ok "success"] +test> fix5080.tests.failure = [Fail "fail"] ``` ```ucm:error -test-5080/main> add -test-5080/main> test +scratch/main> add +scratch/main> test ``` ```ucm -test-5080/main> delete.term 2 -test-5080/main> test +scratch/main> delete.term 2 +scratch/main> test ``` diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md index cccf11a8f2..c9d0b7c0ce 100644 --- a/unison-src/transcripts/fix5080.output.md +++ b/unison-src/transcripts/fix5080.output.md @@ -1,29 +1,6 @@ -```ucm -.> project.create test-5080 - - 🎉 I've created the project test-5080. - - I'll now fetch the latest version of the base Unison - library... - - Downloaded 14067 entities. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - -``` ```unison -test> fix5080.tests.success = check (6 Nat.== 6) -test> fix5080.tests.failure = check (2 Nat.== 4) +test> fix5080.tests.success = [Ok "success"] +test> fix5080.tests.failure = [Fail "fail"] ``` ```ucm @@ -42,30 +19,30 @@ test> fix5080.tests.failure = check (2 Nat.== 4) Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. - 1 | test> fix5080.tests.success = check (6 Nat.== 6) + 1 | test> fix5080.tests.success = [Ok "success"] - ✅ Passed Passed + ✅ Passed success - 2 | test> fix5080.tests.failure = check (2 Nat.== 4) + 2 | test> fix5080.tests.failure = [Fail "fail"] - 🚫 FAILED Failed + 🚫 FAILED fail ``` ```ucm -test-5080/main> add +scratch/main> add ⍟ I've added these definitions: fix5080.tests.failure : [Result] fix5080.tests.success : [Result] -test-5080/main> test +scratch/main> test Cached test results (`help testcache` to learn more) - 1. fix5080.tests.success ◉ Passed + 1. fix5080.tests.success ◉ success - 2. fix5080.tests.failure ✗ Failed + 2. fix5080.tests.failure ✗ fail 🚫 1 test(s) failing, ✅ 1 test(s) passing @@ -73,15 +50,15 @@ test-5080/main> test ``` ```ucm -test-5080/main> delete.term 2 +scratch/main> delete.term 2 Done. -test-5080/main> test +scratch/main> test Cached test results (`help testcache` to learn more) - 1. fix5080.tests.success ◉ Passed + 1. fix5080.tests.success ◉ success ✅ 1 test(s) passing From 658d490b25e4ff57bdc79e7c4abc878178ec0e01 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 27 Jun 2024 14:18:09 -0400 Subject: [PATCH 316/631] Transcript update --- unison-src/transcripts/fix5080.output.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md index 745b2e0478..3fc487dae7 100644 --- a/unison-src/transcripts/fix5080.output.md +++ b/unison-src/transcripts/fix5080.output.md @@ -6,7 +6,7 @@ I'll now fetch the latest version of the base Unison library... - Downloaded 14067 entities. + Downloaded 14117 entities. 🎨 Type `ui` to explore this project's code in your browser. 🔭 Discover libraries at https://share.unison-lang.org From d45563e8e5b2deff545596119b4b0a362a8ae367 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 27 Jun 2024 14:21:36 -0400 Subject: [PATCH 317/631] Disable continuation annotation until it's actually useful --- scheme-libs/racket/unison/boot.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scheme-libs/racket/unison/boot.ss b/scheme-libs/racket/unison/boot.ss index b12f45cc45..ed8b0f7d35 100644 --- a/scheme-libs/racket/unison/boot.ss +++ b/scheme-libs/racket/unison/boot.ss @@ -352,7 +352,7 @@ (define-for-syntax (process-hints hs) (for/fold ([internal? #f] - [force-pure? #f] + [force-pure? #t] [gen-link? #f] [no-link-decl? #f]) ([h hs]) From 937ac50e0af4919903e78e3b610ccd82efe36e89 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 27 Jun 2024 11:08:05 -0700 Subject: [PATCH 318/631] Don't pull base in docs.to-html --- unison-src/transcripts-manual/docs.to-html.md | 3 +- .../transcripts-manual/docs.to-html.output.md | 39 ++++--------------- 2 files changed, 8 insertions(+), 34 deletions(-) diff --git a/unison-src/transcripts-manual/docs.to-html.md b/unison-src/transcripts-manual/docs.to-html.md index 528d038e49..282de4e5e5 100644 --- a/unison-src/transcripts-manual/docs.to-html.md +++ b/unison-src/transcripts-manual/docs.to-html.md @@ -1,6 +1,5 @@ ```ucm -.> project.create test-html-docs -test-html-docs/main> builtins.merge +test-html-docs/main> builtins.mergeio lib.builtins ``` ```unison diff --git a/unison-src/transcripts-manual/docs.to-html.output.md b/unison-src/transcripts-manual/docs.to-html.output.md index d0ff08ce86..7755e2e2de 100644 --- a/unison-src/transcripts-manual/docs.to-html.output.md +++ b/unison-src/transcripts-manual/docs.to-html.output.md @@ -1,26 +1,5 @@ ```ucm -.> project.create test-html-docs - - 🎉 I've created the project test-html-docs. - - I'll now fetch the latest version of the base Unison - library... - - Downloaded 14067 entities. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - -test-html-docs/main> builtins.merge +test-html-docs/main> builtins.mergeio lib.builtins Done. @@ -47,13 +26,11 @@ some.outside = 3 ⍟ These new definitions are ok to `add`: some.ns.direct : Nat - some.ns.direct.doc : Doc + some.ns.direct.doc : Doc2 some.ns.pretty.deeply.nested : Nat - (also named lib.base.data.Map.internal.ratio) - some.ns.pretty.deeply.nested.doc : Doc + some.ns.pretty.deeply.nested.doc : Doc2 some.outside : Nat - (also named lib.base.data.Map.internal.delta) - some.outside.doc : Doc + some.outside.doc : Doc2 ``` ```ucm @@ -62,13 +39,11 @@ test-html-docs/main> add ⍟ I've added these definitions: some.ns.direct : Nat - some.ns.direct.doc : Doc + some.ns.direct.doc : Doc2 some.ns.pretty.deeply.nested : Nat - (also named lib.base.data.Map.internal.ratio) - some.ns.pretty.deeply.nested.doc : Doc + some.ns.pretty.deeply.nested.doc : Doc2 some.outside : Nat - (also named lib.base.data.Map.internal.delta) - some.outside.doc : Doc + some.outside.doc : Doc2 test-html-docs/main> docs.to-html some.ns unison-src/transcripts-manual/docs.to-html From 5dcc0961606b13b64561ac51db323b723eb93493 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 27 Jun 2024 11:37:22 -0700 Subject: [PATCH 319/631] update transcripts --- .../failure-tests.output.md | 2 +- .../transcripts-using-base/utf8.output.md | 2 +- .../transcripts/generic-parse-errors.output.md | 18 ++++++++++++++++++ 3 files changed, 20 insertions(+), 2 deletions(-) diff --git a/unison-src/transcripts-using-base/failure-tests.output.md b/unison-src/transcripts-using-base/failure-tests.output.md index d59d3d7bc8..d470814bac 100644 --- a/unison-src/transcripts-using-base/failure-tests.output.md +++ b/unison-src/transcripts-using-base/failure-tests.output.md @@ -50,7 +50,7 @@ test2 = do Failure (typeLink IOFailure) - "Cannot decode byte '\\xee': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream" + "Cannot decode byte '\\xee': Data.Text.Encoding: Invalid UTF-8 stream" (Any ()) Stack trace: diff --git a/unison-src/transcripts-using-base/utf8.output.md b/unison-src/transcripts-using-base/utf8.output.md index 6bba05281a..c7fa9a3b3a 100644 --- a/unison-src/transcripts-using-base/utf8.output.md +++ b/unison-src/transcripts-using-base/utf8.output.md @@ -138,6 +138,6 @@ greek_bytes = Bytes.fromList [206, 145, 206, 146, 206, 147, 206, 148, 206] 5 | > match fromUtf8.impl (drop 1 greek_bytes) with ⧩ - "Cannot decode byte '\\x91': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream" + "Cannot decode byte '\\x91': Data.Text.Encoding: Invalid UTF-8 stream" ``` diff --git a/unison-src/transcripts/generic-parse-errors.output.md b/unison-src/transcripts/generic-parse-errors.output.md index 7800cbab47..83c542f840 100644 --- a/unison-src/transcripts/generic-parse-errors.output.md +++ b/unison-src/transcripts/generic-parse-errors.output.md @@ -66,6 +66,24 @@ x = a.#abc I was surprised to find a '.' here. + I was expecting one of these instead: + + * and + * bang + * do + * false + * force + * handle + * if + * infixApp + * let + * newline or semicolon + * or + * quote + * termLink + * true + * tuple + * typeLink ``` ```unison From ce3c2dcb949f5e3df9403b4b13c0fc8556bc7e01 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 27 Jun 2024 12:05:18 -0400 Subject: [PATCH 320/631] don't output nothing when there's nothing to do --- .../src/Unison/Codebase/Editor/Output.hs | 11 +- .../src/Unison/CommandLine/OutputMessages.hs | 123 +++++++++--------- unison-src/transcripts/todo.md | 8 ++ unison-src/transcripts/todo.output.md | 10 ++ 4 files changed, 91 insertions(+), 61 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index b423079928..1534f42d0f 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -9,6 +9,7 @@ module Unison.Codebase.Editor.Output HistoryTail (..), TestReportStats (..), TodoOutput (..), + todoOutputIsEmpty, UndoFailureReason (..), ShareError (..), UpdateOrUpgrade (..), @@ -18,6 +19,7 @@ module Unison.Codebase.Editor.Output where import Data.List.NonEmpty (NonEmpty) +import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) import Data.Time (UTCTime) import Network.URI (URI) @@ -76,10 +78,11 @@ import Unison.Term (Term) import Unison.Type (Type) import Unison.Typechecker.Context qualified as Context import Unison.UnisonFile qualified as UF -import Unison.Util.Defns (DefnsF) +import Unison.Util.Defns (DefnsF, defnsAreEmpty) import Unison.Util.Pretty qualified as P import Unison.Util.Relation (Relation) import Unison.WatchKind qualified as WK +import qualified Unison.Names as Names type ListDetailed = Bool @@ -157,6 +160,12 @@ data TodoOutput = TodoOutput ppe :: !PrettyPrintEnvDecl } +todoOutputIsEmpty :: TodoOutput -> Bool +todoOutputIsEmpty todo = + Set.null todo.dependentsOfTodo + && defnsAreEmpty todo.directDependenciesWithoutNames + && Names.isEmpty todo.nameConflicts + data AmbiguousReset'Argument = AmbiguousReset'Hash | AmbiguousReset'Target diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index ff4f298728..f17f483adf 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -55,6 +55,7 @@ import Unison.Codebase.Editor.Output TestReportStats (CachedTests, NewlyComputed), TodoOutput, UndoFailureReason (CantUndoPastMerge, CantUndoPastStart), + todoOutputIsEmpty, ) import Unison.Codebase.Editor.Output qualified as E import Unison.Codebase.Editor.Output.BranchDiff qualified as OBD @@ -2661,66 +2662,68 @@ runNumbered m = in (a, Foldable.toList args) handleTodoOutput :: TodoOutput -> Numbered Pretty -handleTodoOutput todo = do - prettyConflicts <- - if todo.nameConflicts == mempty - then pure mempty - else renderNameConflicts todo.ppe.unsuffixifiedPPE todo.nameConflicts - - prettyDependentsOfTodo <- do - if Set.null todo.dependentsOfTodo - then pure mempty - else do - terms <- - for (Set.toList todo.dependentsOfTodo) \term -> do - n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.idToShortHash term))) - let name = - term - & Referent.fromTermReferenceId - & PPE.termName todo.ppe.suffixifiedPPE - & prettyHashQualified - & P.syntaxToColor - pure (formatNum n <> name) - pure $ - P.wrap "These terms call `todo`:" - <> P.newline - <> P.newline - <> P.indentN 2 (P.lines terms) - - prettyDirectTermDependenciesWithoutNames <- do - if Set.null todo.directDependenciesWithoutNames.terms - then pure mempty - else do - terms <- - for (Set.toList todo.directDependenciesWithoutNames.terms) \term -> do - n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term))) - pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen term)) - pure $ - P.wrap "These terms do not have any names in the current namespace:" - <> P.newline - <> P.newline - <> P.indentN 2 (P.lines terms) - - prettyDirectTypeDependenciesWithoutNames <- do - if Set.null todo.directDependenciesWithoutNames.types - then pure mempty - else do - types <- - for (Set.toList todo.directDependenciesWithoutNames.types) \typ -> do - n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ))) - pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen typ)) - pure $ - P.wrap "These types do not have any names in the current namespace:" - <> P.newline - <> P.newline - <> P.indentN 2 (P.lines types) - - (pure . P.sep "\n\n" . P.nonEmpty) - [ prettyDependentsOfTodo, - prettyDirectTermDependenciesWithoutNames, - prettyDirectTypeDependenciesWithoutNames, - prettyConflicts - ] +handleTodoOutput todo + | todoOutputIsEmpty todo = pure "You have no pending todo items. Good work! ✅" + | otherwise = do + prettyConflicts <- + if todo.nameConflicts == mempty + then pure mempty + else renderNameConflicts todo.ppe.unsuffixifiedPPE todo.nameConflicts + + prettyDependentsOfTodo <- do + if Set.null todo.dependentsOfTodo + then pure mempty + else do + terms <- + for (Set.toList todo.dependentsOfTodo) \term -> do + n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.idToShortHash term))) + let name = + term + & Referent.fromTermReferenceId + & PPE.termName todo.ppe.suffixifiedPPE + & prettyHashQualified + & P.syntaxToColor + pure (formatNum n <> name) + pure $ + P.wrap "These terms call `todo`:" + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines terms) + + prettyDirectTermDependenciesWithoutNames <- do + if Set.null todo.directDependenciesWithoutNames.terms + then pure mempty + else do + terms <- + for (Set.toList todo.directDependenciesWithoutNames.terms) \term -> do + n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term))) + pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen term)) + pure $ + P.wrap "These terms do not have any names in the current namespace:" + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines terms) + + prettyDirectTypeDependenciesWithoutNames <- do + if Set.null todo.directDependenciesWithoutNames.types + then pure mempty + else do + types <- + for (Set.toList todo.directDependenciesWithoutNames.types) \typ -> do + n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ))) + pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen typ)) + pure $ + P.wrap "These types do not have any names in the current namespace:" + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines types) + + (pure . P.sep "\n\n" . P.nonEmpty) + [ prettyDependentsOfTodo, + prettyDirectTermDependenciesWithoutNames, + prettyDirectTypeDependenciesWithoutNames, + prettyConflicts + ] listOfDefinitions :: (Var v) => Input.FindScope -> PPE.PrettyPrintEnv -> E.ListDetailed -> [SR'.SearchResult' v a] -> IO Pretty diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md index 097854dcce..b86a36e209 100644 --- a/unison-src/transcripts/todo.md +++ b/unison-src/transcripts/todo.md @@ -1,3 +1,11 @@ +# Nothing to do + +When there's nothing to do, `todo` says this: + +```ucm +project/main> todo +``` + # Conflicted names The todo command shows conflicted names (not demonstrated here yet because it is not easy to create them for tests, yet). diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index a491922c7a..cfad74ec15 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -1,3 +1,13 @@ +# Nothing to do + +When there's nothing to do, `todo` says this: + +```ucm +project/main> todo + + You have no pending todo items. Good work! ✅ + +``` # Conflicted names The todo command shows conflicted names (not demonstrated here yet because it is not easy to create them for tests, yet). From e94f8706fc42c7b0f6f850834e839671774ec8ab Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 27 Jun 2024 11:53:30 -0700 Subject: [PATCH 321/631] Remove Primes from module names --- lib/unison-pretty-printer/src/Unison/Util/SyntaxText.hs | 2 +- parser-typechecker/src/Unison/Codebase/BranchUtil.hs | 2 +- parser-typechecker/src/Unison/Codebase/Path.hs | 2 +- parser-typechecker/src/Unison/Codebase/Path/Parse.hs | 2 +- .../Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs | 2 +- parser-typechecker/src/Unison/PrettyPrintEnv.hs | 2 +- parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs | 2 +- parser-typechecker/src/Unison/PrintError.hs | 2 +- parser-typechecker/src/Unison/Syntax/NamePrinter.hs | 2 +- parser-typechecker/src/Unison/Syntax/TermParser.hs | 2 +- parser-typechecker/src/Unison/Syntax/TermPrinter.hs | 2 +- parser-typechecker/tests/Unison/Test/Codebase/Path.hs | 2 +- unison-cli/src/Unison/Cli/MonadUtils.hs | 2 +- unison-cli/src/Unison/Cli/Pretty.hs | 4 ++-- unison-cli/src/Unison/Codebase/Editor/HandleInput.hs | 4 ++-- .../Unison/Codebase/Editor/HandleInput/FindAndReplace.hs | 2 +- unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs | 4 ++-- .../src/Unison/Codebase/Editor/HandleInput/MoveAll.hs | 2 +- .../src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs | 2 +- .../src/Unison/Codebase/Editor/HandleInput/MoveType.hs | 2 +- .../src/Unison/Codebase/Editor/HandleInput/Upgrade.hs | 2 +- unison-cli/src/Unison/Codebase/Editor/Output.hs | 4 ++-- unison-cli/src/Unison/Codebase/Editor/Output/BranchDiff.hs | 2 +- unison-cli/src/Unison/Codebase/Editor/Slurp.hs | 2 +- unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs | 2 +- unison-cli/src/Unison/CommandLine/Completion.hs | 2 +- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 2 +- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 6 +++--- unison-cli/src/Unison/LSP/Completion.hs | 4 ++-- unison-cli/src/Unison/LSP/FileAnalysis.hs | 2 +- unison-core/src/Unison/DataDeclaration.hs | 2 +- .../src/Unison/{HashQualified'.hs => HashQualifiedPrime.hs} | 2 +- unison-core/src/Unison/Names.hs | 2 +- unison-core/src/Unison/NamesWithHistory.hs | 2 +- unison-core/src/Unison/Referent.hs | 2 +- unison-core/src/Unison/{Referent'.hs => ReferentPrime.hs} | 4 ++-- unison-core/unison-core1.cabal | 4 ++-- unison-merge/src/Unison/Merge/Diff.hs | 2 +- unison-share-api/src/Unison/Server/Backend.hs | 6 +++--- unison-share-api/src/Unison/Server/Local/Definitions.hs | 2 +- unison-share-api/src/Unison/Server/NameSearch.hs | 2 +- unison-share-api/src/Unison/Server/NameSearch/FromNames.hs | 2 +- unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs | 2 +- unison-share-api/src/Unison/Server/Orphans.hs | 4 ++-- unison-share-api/src/Unison/Server/SearchResult.hs | 2 +- .../Server/{SearchResult'.hs => SearchResultPrime.hs} | 4 ++-- unison-share-api/src/Unison/Server/Types.hs | 2 +- unison-share-api/src/Unison/Util/Find.hs | 2 +- unison-share-api/unison-share-api.cabal | 2 +- unison-syntax/src/Unison/Syntax/HashQualified.hs | 4 ++-- .../Syntax/{HashQualified'.hs => HashQualifiedPrime.hs} | 4 ++-- unison-syntax/src/Unison/Syntax/Lexer.hs | 4 ++-- unison-syntax/src/Unison/Syntax/Parser.hs | 2 +- unison-syntax/test/Main.hs | 2 +- unison-syntax/unison-syntax.cabal | 2 +- 55 files changed, 71 insertions(+), 71 deletions(-) rename unison-core/src/Unison/{HashQualified'.hs => HashQualifiedPrime.hs} (99%) rename unison-core/src/Unison/{Referent'.hs => ReferentPrime.hs} (96%) rename unison-share-api/src/Unison/Server/{SearchResult'.hs => SearchResultPrime.hs} (96%) rename unison-syntax/src/Unison/Syntax/{HashQualified'.hs => HashQualifiedPrime.hs} (95%) diff --git a/lib/unison-pretty-printer/src/Unison/Util/SyntaxText.hs b/lib/unison-pretty-printer/src/Unison/Util/SyntaxText.hs index 294a27b5bb..ffcac47acf 100644 --- a/lib/unison-pretty-printer/src/Unison/Util/SyntaxText.hs +++ b/lib/unison-pretty-printer/src/Unison/Util/SyntaxText.hs @@ -4,7 +4,7 @@ import Unison.HashQualified (HashQualified) import Unison.Name (Name) import Unison.Pattern (SeqOp) import Unison.Prelude -import Unison.Referent' (Referent') +import Unison.ReferentPrime (Referent') import Unison.Util.AnnotatedText (AnnotatedText (..), annotate, segment) type SyntaxText' r = AnnotatedText (Element r) diff --git a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs index d0025cd87e..a79d0ab340 100644 --- a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs +++ b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs @@ -25,7 +25,7 @@ import Unison.Codebase.Branch (Branch, Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path -import Unison.HashQualified' (HashQualified (HashQualified, NameOnly)) +import Unison.HashQualifiedPrime (HashQualified (HashQualified, NameOnly)) import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Prelude diff --git a/parser-typechecker/src/Unison/Codebase/Path.hs b/parser-typechecker/src/Unison/Codebase/Path.hs index 3c20dcd852..17f288e501 100644 --- a/parser-typechecker/src/Unison/Codebase/Path.hs +++ b/parser-typechecker/src/Unison/Codebase/Path.hs @@ -90,7 +90,7 @@ import Data.Sequence (Seq ((:<|), (:|>))) import Data.Sequence qualified as Seq import Data.Text qualified as Text import GHC.Exts qualified as GHC -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) diff --git a/parser-typechecker/src/Unison/Codebase/Path/Parse.hs b/parser-typechecker/src/Unison/Codebase/Path/Parse.hs index e5411d4ad3..79bb738e6d 100644 --- a/parser-typechecker/src/Unison/Codebase/Path/Parse.hs +++ b/parser-typechecker/src/Unison/Codebase/Path/Parse.hs @@ -22,7 +22,7 @@ import Text.Megaparsec qualified as P import Text.Megaparsec.Char qualified as P (char) import Text.Megaparsec.Internal qualified as P (withParsecT) import Unison.Codebase.Path -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Prelude hiding (empty, toList) import Unison.ShortHash (ShortHash) import Unison.Syntax.Lexer qualified as Lexer diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs index 475e19d338..70e6d0538b 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs @@ -72,7 +72,7 @@ import Unison.Pattern qualified as Pattern import Unison.Prelude import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent -import Unison.Referent' qualified as Referent' +import Unison.ReferentPrime qualified as Referent' import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Term qualified as Term diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv.hs b/parser-typechecker/src/Unison/PrettyPrintEnv.hs index 07fa935074..005bce8472 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnv.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnv.hs @@ -28,7 +28,7 @@ import Unison.ConstructorReference (ConstructorReference) import Unison.ConstructorType qualified as CT import Unison.HashQualified (HashQualified) import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs index 4d511091eb..5d8264202c 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs @@ -18,7 +18,7 @@ module Unison.PrettyPrintEnv.Names where import Data.Set qualified as Set -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 16ea2dc881..5647ccde63 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -33,7 +33,7 @@ import Unison.ABT qualified as ABT import Unison.Builtin.Decls (unitRef, pattern TupleType') import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) import Unison.HashQualified (HashQualified) -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Kind (Kind) import Unison.Kind qualified as Kind import Unison.KindInference.Error.Pretty (prettyKindError) diff --git a/parser-typechecker/src/Unison/Syntax/NamePrinter.hs b/parser-typechecker/src/Unison/Syntax/NamePrinter.hs index ab51847469..8c3a70708d 100644 --- a/parser-typechecker/src/Unison/Syntax/NamePrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/NamePrinter.hs @@ -2,7 +2,7 @@ module Unison.Syntax.NamePrinter where import Data.Text qualified as Text import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 044a29ead5..be1c98ce52 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -31,7 +31,7 @@ import Unison.Builtin.Decls qualified as DD import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) import Unison.ConstructorType qualified as CT import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index 08b805c4dd..f6e20c06b0 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -35,7 +35,7 @@ import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorReference qualified as ConstructorReference import Unison.ConstructorType qualified as CT import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) diff --git a/parser-typechecker/tests/Unison/Test/Codebase/Path.hs b/parser-typechecker/tests/Unison/Test/Codebase/Path.hs index 96fb0aca65..77cb80718e 100644 --- a/parser-typechecker/tests/Unison/Test/Codebase/Path.hs +++ b/parser-typechecker/tests/Unison/Test/Codebase/Path.hs @@ -6,7 +6,7 @@ import Data.Maybe (fromJust) import EasyTest import Unison.Codebase.Path (Path (..), Path' (..), Relative (..)) import Unison.Codebase.Path.Parse (parseHQSplit', parseShortHashOrHQSplit') -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Prelude import Unison.ShortHash qualified as SH diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index a397a3b093..757365100c 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -106,7 +106,7 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index a336d860d2..a18fc94eb1 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -94,7 +94,7 @@ import Unison.Hash qualified as Hash import Unison.Hash32 (Hash32) import Unison.Hash32 qualified as Hash32 import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency as LD import Unison.Name (Name) import Unison.Name qualified as Name @@ -111,7 +111,7 @@ import Unison.Reference (Reference, TermReferenceId) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Unison.Server.SearchResult' qualified as SR' +import Unison.Server.SearchResultPrime qualified as SR' import Unison.ShortHash (ShortHash) import Unison.Symbol (Symbol) import Unison.Sync.Types qualified as Share diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 45efd7b338..dc95f95b5a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -118,8 +118,8 @@ import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration qualified as DD import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' -import Unison.HashQualified' qualified as HashQualified +import Unison.HashQualifiedPrime qualified as HQ' +import Unison.HashQualifiedPrime qualified as HashQualified import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.LabeledDependency qualified as LabeledDependency diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs index 45fb100a44..6a46205240 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs @@ -20,7 +20,7 @@ import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index ceee0aa836..206b8bf04a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -74,7 +74,7 @@ import Unison.Debug qualified as Debug import Unison.Hash (Hash) import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Merge.CombineDiffs (CombinedDiffOp (..), combineDiffs) import Unison.Merge.Database (MergeDatabase (..), makeMergeDatabase, referent2to1) import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason (..), checkDeclCoherency, lenientCheckDeclCoherency) @@ -113,7 +113,7 @@ import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectBranchNa import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Unison.Referent' qualified as Referent' +import Unison.ReferentPrime qualified as Referent' import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite import Unison.Syntax.DeclPrinter (AccessorName) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs index 77b4bc8514..0e4bd963fb 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs @@ -8,7 +8,7 @@ import Unison.Codebase.Editor.HandleInput.MoveTerm (moveTermSteps) import Unison.Codebase.Editor.HandleInput.MoveType (moveTypeSteps) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Prelude handleMoveAll :: Bool -> Path.Path' -> Path.Path' -> Text -> Cli () diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs index c329060303..fed8ca0f15 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs @@ -11,7 +11,7 @@ import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path (Path, Path') import Unison.Codebase.Path qualified as Path -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.NameSegment (NameSegment) import Unison.Prelude diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs index bdf9fe88cd..8a825c71bf 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs @@ -11,7 +11,7 @@ import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path (Path, Path') import Unison.Codebase.Path qualified as Path -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.NameSegment (NameSegment) import Unison.Prelude diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index 7785e386d4..c6755deacf 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -34,7 +34,7 @@ import Unison.Codebase.Editor.HandleInput.Update2 ) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 105683c2b2..21018e80f6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -49,7 +49,7 @@ import Unison.CommandLine.InputPattern qualified as Input import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency (LabeledDependency) import Unison.Name (Name) import Unison.NameSegment (NameSegment) @@ -66,7 +66,7 @@ import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReferenc import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Server.Backend (ShallowListEntry (..)) -import Unison.Server.SearchResult' (SearchResult') +import Unison.Server.SearchResultPrime (SearchResult') import Unison.Share.Sync.Types qualified as Sync import Unison.ShortHash (ShortHash) import Unison.Symbol (Symbol) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output/BranchDiff.hs b/unison-cli/src/Unison/Codebase/Editor/Output/BranchDiff.hs index 27fff49aea..47f5952d37 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output/BranchDiff.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output/BranchDiff.hs @@ -10,7 +10,7 @@ import Unison.Codebase.BranchDiff (BranchDiff (BranchDiff)) import Unison.Codebase.BranchDiff qualified as BranchDiff import Unison.Codebase.Patch qualified as P import Unison.DataDeclaration (DeclOrBuiltin) -import Unison.HashQualified' (HashQualified) +import Unison.HashQualifiedPrime (HashQualified) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names) diff --git a/unison-cli/src/Unison/Codebase/Editor/Slurp.hs b/unison-cli/src/Unison/Codebase/Editor/Slurp.hs index 3c7e9e5239..df5f4beb60 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Slurp.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Slurp.hs @@ -21,7 +21,7 @@ import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Unison.Referent' qualified as Referent +import Unison.ReferentPrime qualified as Referent import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar) import Unison.UnisonFile qualified as UF diff --git a/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs index 33dbddf9b8..21ee27c637 100644 --- a/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs +++ b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs @@ -6,7 +6,7 @@ import Unison.Codebase.Editor.Input import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Parser.Ann (Ann) import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName) diff --git a/unison-cli/src/Unison/CommandLine/Completion.hs b/unison-cli/src/Unison/CommandLine/Completion.hs index 39e1fd00a3..c2bb80a73f 100644 --- a/unison-cli/src/Unison/CommandLine/Completion.hs +++ b/unison-cli/src/Unison/CommandLine/Completion.hs @@ -50,7 +50,7 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.Path.Parse qualified as Path import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.CommandLine.InputPattern qualified as IP -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name qualified as Name import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Prelude diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 7b395659a0..8b7a31b2ea 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -197,7 +197,7 @@ import Unison.CommandLine.InputPattern (ArgumentType (..), InputPattern (InputPa import Unison.CommandLine.InputPattern qualified as I import Unison.Core.Project (ProjectBranchName (..)) import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 291fcf6e2e..5f1484b423 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -84,7 +84,7 @@ import Unison.DataDeclaration qualified as DD import Unison.Hash qualified as Hash import Unison.Hash32 (Hash32) import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency as LD import Unison.Name (Name) import Unison.Name qualified as Name @@ -114,11 +114,11 @@ import Unison.Reference (Reference, TermReferenceId) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Unison.Referent' qualified as Referent +import Unison.ReferentPrime qualified as Referent import Unison.Result qualified as Result import Unison.Server.Backend (ShallowListEntry (..), TypeEntry (..)) import Unison.Server.Backend qualified as Backend -import Unison.Server.SearchResult' qualified as SR' +import Unison.Server.SearchResultPrime qualified as SR' import Unison.Share.Sync qualified as Share import Unison.Share.Sync.Types (CodeserverTransportError (..)) import Unison.Sync.Types qualified as Share diff --git a/unison-cli/src/Unison/LSP/Completion.hs b/unison-cli/src/Unison/LSP/Completion.hs index 129ba8bc54..585e313bac 100644 --- a/unison-cli/src/Unison/LSP/Completion.hs +++ b/unison-cli/src/Unison/LSP/Completion.hs @@ -23,7 +23,7 @@ import Text.Megaparsec qualified as Megaparsec import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LSP.FileAnalysis import Unison.LSP.Queries qualified as LSPQ import Unison.LSP.Types @@ -43,7 +43,7 @@ import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.Runtime.IOSource qualified as IOSource import Unison.Syntax.DeclPrinter qualified as DeclPrinter -import Unison.Syntax.HashQualified' qualified as HQ' (toText) +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) import Unison.Syntax.Name qualified as Name (nameP, parseText, toText) import Unison.Syntax.TypePrinter qualified as TypePrinter import Unison.Util.Monoid qualified as Monoid diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index f5f29b5e27..6db66d89ff 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -55,7 +55,7 @@ import Unison.Referent qualified as Referent import Unison.Result (Note) import Unison.Result qualified as Result import Unison.Symbol (Symbol) -import Unison.Syntax.HashQualified' qualified as HQ' (toText) +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) import Unison.Syntax.Lexer qualified as L import Unison.Syntax.Name qualified as Name import Unison.Syntax.Parser qualified as Parser diff --git a/unison-core/src/Unison/DataDeclaration.hs b/unison-core/src/Unison/DataDeclaration.hs index b6c9776dc7..513759ac07 100644 --- a/unison-core/src/Unison/DataDeclaration.hs +++ b/unison-core/src/Unison/DataDeclaration.hs @@ -52,7 +52,7 @@ import Unison.Prelude import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent -import Unison.Referent' qualified as Referent' +import Unison.ReferentPrime qualified as Referent' import Unison.Type (Type) import Unison.Type qualified as Type import Unison.Var (Var) diff --git a/unison-core/src/Unison/HashQualified'.hs b/unison-core/src/Unison/HashQualifiedPrime.hs similarity index 99% rename from unison-core/src/Unison/HashQualified'.hs rename to unison-core/src/Unison/HashQualifiedPrime.hs index b1ea8c1deb..19c341f4d6 100644 --- a/unison-core/src/Unison/HashQualified'.hs +++ b/unison-core/src/Unison/HashQualifiedPrime.hs @@ -1,4 +1,4 @@ -module Unison.HashQualified' where +module Unison.HashQualifiedPrime where import Data.Text qualified as Text import Unison.HashQualified qualified as HQ diff --git a/unison-core/src/Unison/Names.hs b/unison-core/src/Unison/Names.hs index b21b761927..44789fbc8d 100644 --- a/unison-core/src/Unison/Names.hs +++ b/unison-core/src/Unison/Names.hs @@ -59,7 +59,7 @@ import Text.FuzzyFind qualified as FZF import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType qualified as CT import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) diff --git a/unison-core/src/Unison/NamesWithHistory.hs b/unison-core/src/Unison/NamesWithHistory.hs index 7e2d126ec4..561fa557f8 100644 --- a/unison-core/src/Unison/NamesWithHistory.hs +++ b/unison-core/src/Unison/NamesWithHistory.hs @@ -34,7 +34,7 @@ import Unison.ConstructorReference (ConstructorReference) import Unison.ConstructorType qualified as CT import Unison.HashQualified (HashQualified) import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names (..)) diff --git a/unison-core/src/Unison/Referent.hs b/unison-core/src/Unison/Referent.hs index d04454ea17..104a88e6f0 100644 --- a/unison-core/src/Unison/Referent.hs +++ b/unison-core/src/Unison/Referent.hs @@ -41,7 +41,7 @@ import Unison.Prelude hiding (fold) import Unison.Reference (Reference, TermReference, TermReferenceId) import Unison.Reference qualified as R import Unison.Reference qualified as Reference -import Unison.Referent' (Referent' (..), reference_, toReference') +import Unison.ReferentPrime (Referent' (..), reference_, toReference') import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH diff --git a/unison-core/src/Unison/Referent'.hs b/unison-core/src/Unison/ReferentPrime.hs similarity index 96% rename from unison-core/src/Unison/Referent'.hs rename to unison-core/src/Unison/ReferentPrime.hs index b65b75e09d..a51aff374f 100644 --- a/unison-core/src/Unison/Referent'.hs +++ b/unison-core/src/Unison/ReferentPrime.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} -module Unison.Referent' +module Unison.ReferentPrime ( Referent' (..), -- * Basic queries isConstructor, - Unison.Referent'.fold, + Unison.ReferentPrime.fold, -- * Lenses reference_, diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal index f5ea030c43..9cbeaca8cf 100644 --- a/unison-core/unison-core1.cabal +++ b/unison-core/unison-core1.cabal @@ -34,7 +34,7 @@ library Unison.DataDeclaration.Records Unison.Hashable Unison.HashQualified - Unison.HashQualified' + Unison.HashQualifiedPrime Unison.Kind Unison.LabeledDependency Unison.Name @@ -48,7 +48,7 @@ library Unison.Project Unison.Reference Unison.Referent - Unison.Referent' + Unison.ReferentPrime Unison.Settings Unison.Symbol Unison.Term diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index 1ad67238a4..492687e29a 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -13,7 +13,7 @@ import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration import Unison.Hash (Hash (Hash)) -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Merge.Database (MergeDatabase (..)) import Unison.Merge.DeclNameLookup (DeclNameLookup) import Unison.Merge.DeclNameLookup qualified as DeclNameLookup diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs index fe54c93d15..53b2c2eb75 100644 --- a/unison-share-api/src/Unison/Server/Backend.hs +++ b/unison-share-api/src/Unison/Server/Backend.hs @@ -130,7 +130,7 @@ import Unison.ConstructorType qualified as CT import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.Dependencies qualified as DD import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Hashing.V2.Convert qualified as Hashing import Unison.LabeledDependency qualified as LD import Unison.Name (Name) @@ -161,7 +161,7 @@ import Unison.Server.NameSearch (NameSearch (..), Search (..), applySearch) import Unison.Server.NameSearch.Sqlite (termReferentsByShortHash, typeReferencesByShortHash) import Unison.Server.QueryResult import Unison.Server.SearchResult qualified as SR -import Unison.Server.SearchResult' qualified as SR' +import Unison.Server.SearchResultPrime qualified as SR' import Unison.Server.Syntax qualified as Syntax import Unison.Server.Types import Unison.Server.Types qualified as ServerTypes @@ -170,7 +170,7 @@ import Unison.ShortHash qualified as SH import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.DeclPrinter qualified as DeclPrinter -import Unison.Syntax.HashQualified' qualified as HQ' (toText) +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) import Unison.Syntax.Name as Name (toText, unsafeParseText) import Unison.Syntax.NamePrinter qualified as NP import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText) diff --git a/unison-share-api/src/Unison/Server/Local/Definitions.hs b/unison-share-api/src/Unison/Server/Local/Definitions.hs index b1f5b03d52..f66c8ddce7 100644 --- a/unison-share-api/src/Unison/Server/Local/Definitions.hs +++ b/unison-share-api/src/Unison/Server/Local/Definitions.hs @@ -20,7 +20,7 @@ import Unison.Codebase.Path (Path) import Unison.Codebase.Runtime qualified as Rt import Unison.DataDeclaration qualified as DD import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.NamesWithHistory qualified as NS import Unison.NamesWithHistory qualified as Names diff --git a/unison-share-api/src/Unison/Server/NameSearch.hs b/unison-share-api/src/Unison/Server/NameSearch.hs index 2336d3241b..5e61cd8c30 100644 --- a/unison-share-api/src/Unison/Server/NameSearch.hs +++ b/unison-share-api/src/Unison/Server/NameSearch.hs @@ -12,7 +12,7 @@ import Control.Lens import Data.List qualified as List import Data.Set qualified as Set import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.NamesWithHistory (SearchType (..)) import Unison.Prelude diff --git a/unison-share-api/src/Unison/Server/NameSearch/FromNames.hs b/unison-share-api/src/Unison/Server/NameSearch/FromNames.hs index a78fc6f6f8..40a4ad4d29 100644 --- a/unison-share-api/src/Unison/Server/NameSearch/FromNames.hs +++ b/unison-share-api/src/Unison/Server/NameSearch/FromNames.hs @@ -1,6 +1,6 @@ module Unison.Server.NameSearch.FromNames where -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Names (Names) import Unison.NamesWithHistory qualified as Names import Unison.Reference (Reference) diff --git a/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs b/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs index 527c8bd634..8095d5bdce 100644 --- a/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs +++ b/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs @@ -17,7 +17,7 @@ import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Path qualified as Path import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.Name qualified as Name diff --git a/unison-share-api/src/Unison/Server/Orphans.hs b/unison-share-api/src/Unison/Server/Orphans.hs index 7451d2f183..bfe22d6716 100644 --- a/unison-share-api/src/Unison/Server/Orphans.hs +++ b/unison-share-api/src/Unison/Server/Orphans.hs @@ -26,7 +26,7 @@ import Unison.Core.Project (ProjectBranchName (..), ProjectName (..)) import Unison.Hash (Hash (..)) import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment.Internal (NameSegment (NameSegment)) @@ -37,7 +37,7 @@ import Unison.Referent qualified as Referent import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH import Unison.Syntax.HashQualified qualified as HQ (parseText) -import Unison.Syntax.HashQualified' qualified as HQ' (parseText) +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (parseText) import Unison.Syntax.Name qualified as Name (parseTextEither, toText) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Util.Pretty (Width (..)) diff --git a/unison-share-api/src/Unison/Server/SearchResult.hs b/unison-share-api/src/Unison/Server/SearchResult.hs index c30c16634a..9dd8d09046 100644 --- a/unison-share-api/src/Unison/Server/SearchResult.hs +++ b/unison-share-api/src/Unison/Server/SearchResult.hs @@ -2,7 +2,7 @@ module Unison.Server.SearchResult where import Data.Set qualified as Set import Unison.HashQualified (HashQualified) -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names (..)) diff --git a/unison-share-api/src/Unison/Server/SearchResult'.hs b/unison-share-api/src/Unison/Server/SearchResultPrime.hs similarity index 96% rename from unison-share-api/src/Unison/Server/SearchResult'.hs rename to unison-share-api/src/Unison/Server/SearchResultPrime.hs index d928811ed5..b24c9f2c8a 100644 --- a/unison-share-api/src/Unison/Server/SearchResult'.hs +++ b/unison-share-api/src/Unison/Server/SearchResultPrime.hs @@ -1,6 +1,6 @@ {-# LANGUAGE PatternSynonyms #-} -module Unison.Server.SearchResult' where +module Unison.Server.SearchResultPrime where import Data.Set qualified as Set import Unison.Codebase.Editor.DisplayObject (DisplayObject) @@ -8,7 +8,7 @@ import Unison.Codebase.Editor.DisplayObject qualified as DT import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DD import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) diff --git a/unison-share-api/src/Unison/Server/Types.hs b/unison-share-api/src/Unison/Server/Types.hs index 6a3421709d..a16432672d 100644 --- a/unison-share-api/src/Unison/Server/Types.hs +++ b/unison-share-api/src/Unison/Server/Types.hs @@ -41,7 +41,7 @@ import Unison.Codebase.Path qualified as Path import Unison.Core.Project (ProjectBranchName) import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Prelude import Unison.Project (ProjectAndBranch, ProjectName) diff --git a/unison-share-api/src/Unison/Util/Find.hs b/unison-share-api/src/Unison/Util/Find.hs index 22923d7b03..792d439b24 100644 --- a/unison-share-api/src/Unison/Util/Find.hs +++ b/unison-share-api/src/Unison/Util/Find.hs @@ -15,7 +15,7 @@ import Data.Text qualified as Text -- https://www.stackage.org/haddock/lts-13.9/regex-tdfa-1.2.3.1/Text-Regex-TDFA.html import Text.Regex.TDFA qualified as RE import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names) diff --git a/unison-share-api/unison-share-api.cabal b/unison-share-api/unison-share-api.cabal index 776ad6e47f..e3878a9e7f 100644 --- a/unison-share-api/unison-share-api.cabal +++ b/unison-share-api/unison-share-api.cabal @@ -41,7 +41,7 @@ library Unison.Server.Orphans Unison.Server.QueryResult Unison.Server.SearchResult - Unison.Server.SearchResult' + Unison.Server.SearchResultPrime Unison.Server.Syntax Unison.Server.Types Unison.Sync.API diff --git a/unison-syntax/src/Unison/Syntax/HashQualified.hs b/unison-syntax/src/Unison/Syntax/HashQualified.hs index e90d8c6cb7..927f548805 100644 --- a/unison-syntax/src/Unison/Syntax/HashQualified.hs +++ b/unison-syntax/src/Unison/Syntax/HashQualified.hs @@ -21,10 +21,10 @@ import Text.Megaparsec qualified as P import Text.Megaparsec.Internal qualified as P (withParsecT) import Unison.HashQualified (HashQualified (..)) import Unison.HashQualified qualified as HashQualified -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Prelude hiding (fromString) -import Unison.Syntax.HashQualified' qualified as HQ' +import Unison.Syntax.HashQualifiedPrime qualified as HQ' import Unison.Syntax.Lexer.Token (Token) import Unison.Syntax.Name qualified as Name (nameP, toText) import Unison.Syntax.NameSegment qualified as NameSegment diff --git a/unison-syntax/src/Unison/Syntax/HashQualified'.hs b/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs similarity index 95% rename from unison-syntax/src/Unison/Syntax/HashQualified'.hs rename to unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs index de5c4bfeab..6326006c7a 100644 --- a/unison-syntax/src/Unison/Syntax/HashQualified'.hs +++ b/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Syntax-related combinators for HashQualified' (to/from string types). -module Unison.Syntax.HashQualified' +module Unison.Syntax.HashQualifiedPrime ( -- * String conversions parseText, unsafeParseText, @@ -16,7 +16,7 @@ import Data.Text qualified as Text import Text.Megaparsec (ParsecT) import Text.Megaparsec qualified as P import Text.Megaparsec.Internal qualified as P (withParsecT) -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Prelude hiding (fromString) import Unison.Syntax.Lexer.Token (Token) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 6ff55150f7..0e47af244e 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -46,7 +46,7 @@ import Text.Megaparsec.Char qualified as CP import Text.Megaparsec.Char.Lexer qualified as LP import Text.Megaparsec.Error qualified as EP import Text.Megaparsec.Internal qualified as PI -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Lexer.Pos (Column, Line, Pos (Pos), column, line) import Unison.Name (Name) import Unison.Name qualified as Name @@ -56,7 +56,7 @@ import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH -import Unison.Syntax.HashQualified' qualified as HQ' (toText) +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) import Unison.Syntax.Lexer.Token (Token (..), posP, tokenP) import Unison.Syntax.Name qualified as Name (isSymboly, nameP, toText, unsafeParseText) import Unison.Syntax.NameSegment (symbolyIdChar, wordyIdChar, wordyIdStartChar) diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 9dee6337e9..015537c467 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -72,7 +72,7 @@ import Unison.ABT qualified as ABT import Unison.ConstructorReference (ConstructorReference) import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ -import Unison.HashQualified' qualified as HQ' +import Unison.HashQualifiedPrime qualified as HQ' import Unison.Hashable qualified as Hashable import Unison.Name as Name import Unison.Names (Names) diff --git a/unison-syntax/test/Main.hs b/unison-syntax/test/Main.hs index 3b3319567d..bd40c7ded8 100644 --- a/unison-syntax/test/Main.hs +++ b/unison-syntax/test/Main.hs @@ -9,7 +9,7 @@ import System.IO.CodePage (withCP65001) import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as ShortHash -import Unison.Syntax.HashQualified' qualified as HQ' (unsafeParseText) +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (unsafeParseText) import Unison.Syntax.Lexer main :: IO () diff --git a/unison-syntax/unison-syntax.cabal b/unison-syntax/unison-syntax.cabal index 9c3241e394..888982134f 100644 --- a/unison-syntax/unison-syntax.cabal +++ b/unison-syntax/unison-syntax.cabal @@ -20,7 +20,7 @@ library Unison.Lexer.Pos Unison.Parser.Ann Unison.Syntax.HashQualified - Unison.Syntax.HashQualified' + Unison.Syntax.HashQualifiedPrime Unison.Syntax.Lexer Unison.Syntax.Lexer.Token Unison.Syntax.Name From a76bca1326b3214908c5d2d9e189bb22c9ee9dc2 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 27 Jun 2024 15:43:07 -0400 Subject: [PATCH 322/631] re-run fix2254.md --- unison-src/transcripts/fix2254.output.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-src/transcripts/fix2254.output.md b/unison-src/transcripts/fix2254.output.md index 16e4285c17..eed5075c10 100644 --- a/unison-src/transcripts/fix2254.output.md +++ b/unison-src/transcripts/fix2254.output.md @@ -109,7 +109,7 @@ scratch/a2> view A NeedsA f f2 f3 g scratch/a2> todo - + You have no pending todo items. Good work! ✅ ``` ## Record updates @@ -217,6 +217,6 @@ scratch/r2> update.old scratch/r2> todo - + You have no pending todo items. Good work! ✅ ``` From 8f694f182dda1294327f23c38c1d40f1d8ffe975 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 27 Jun 2024 12:35:14 -0700 Subject: [PATCH 323/631] Add note about deprecations --- unison-share-projects-api/src/Unison/Share/API/Hash.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/unison-share-projects-api/src/Unison/Share/API/Hash.hs b/unison-share-projects-api/src/Unison/Share/API/Hash.hs index 066716a517..744b3dfdc0 100644 --- a/unison-share-projects-api/src/Unison/Share/API/Hash.hs +++ b/unison-share-projects-api/src/Unison/Share/API/Hash.hs @@ -1,4 +1,7 @@ {-# LANGUAGE RecordWildCards #-} +-- Manipulating JWT claims with addClaim etc. directly is deprecated, so we'll need to fix that eventually. +-- The new way appears to be to define custom types with JSON instances and use those to encode/decode the JWT; +-- see https://github.com/frasertweedale/hs-jose/issues/116 {-# OPTIONS_GHC -Wno-deprecations #-} -- | Hash-related types in the Share API. From 15f236a94f355a98e4774f524d42f8b97a4c0b23 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 27 Jun 2024 12:50:48 -0700 Subject: [PATCH 324/631] Add issue number --- unison-share-projects-api/src/Unison/Share/API/Hash.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/unison-share-projects-api/src/Unison/Share/API/Hash.hs b/unison-share-projects-api/src/Unison/Share/API/Hash.hs index 744b3dfdc0..dfa1d1f44c 100644 --- a/unison-share-projects-api/src/Unison/Share/API/Hash.hs +++ b/unison-share-projects-api/src/Unison/Share/API/Hash.hs @@ -2,6 +2,7 @@ -- Manipulating JWT claims with addClaim etc. directly is deprecated, so we'll need to fix that eventually. -- The new way appears to be to define custom types with JSON instances and use those to encode/decode the JWT; -- see https://github.com/frasertweedale/hs-jose/issues/116 +-- https://github.com/unisonweb/unison/issues/5153 {-# OPTIONS_GHC -Wno-deprecations #-} -- | Hash-related types in the Share API. From 907aba9550026dfa5f264d47a1f4fe8d47076679 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 27 Jun 2024 17:21:42 -0400 Subject: [PATCH 325/631] Rerun jit tests with regenerated file --- unison-src/builtin-tests/jit-tests.output.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-src/builtin-tests/jit-tests.output.md b/unison-src/builtin-tests/jit-tests.output.md index 55c9234d59..36da409296 100644 --- a/unison-src/builtin-tests/jit-tests.output.md +++ b/unison-src/builtin-tests/jit-tests.output.md @@ -40,11 +40,11 @@ foo = do ``` ```ucm -.> run.native foo +scratch/main> run.native foo () -.> run.native foo +scratch/main> run.native foo () From 121d51ca9110fa14959cdb1c0fae08943279acff Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 27 Jun 2024 12:37:44 -0600 Subject: [PATCH 326/631] =?UTF-8?q?Don=E2=80=99t=20export=20packages=20for?= =?UTF-8?q?=20individual=20build=20tools?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- flake.nix | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/flake.nix b/flake.nix index ebe95c1694..a951d47487 100644 --- a/flake.nix +++ b/flake.nix @@ -98,8 +98,7 @@ assert nixpkgs-packages.unwrapped-stack.version == versions.stack; assert nixpkgs-packages.hpack.version == versions.hpack; { packages = - nixpkgs-packages - // renameAttrs (name: "component-${name}") haskell-nix-flake.packages + renameAttrs (name: "component-${name}") haskell-nix-flake.packages // renameAttrs (name: "docker-${name}") (import ./nix/docker.nix { inherit pkgs; haskell-nix = haskell-nix-flake.packages; From d0f4c70d4dfc709858a8bdb643855cc3fefef2ac Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 27 Jun 2024 14:44:00 -0600 Subject: [PATCH 327/631] Remove the non-haskell.nix devShell MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This `only-tools-nixpkgs` devShell generally paralleled the `cabal-only-tools` devShell, but avoiding haskell.nix. While I’m not a huge fan of haskell.nix, this just created duplication and gave us a shell with a somewhat different environment than the one used by `nix build`, etc. It also didn’t work for everyone. In removing that shell, it also sets the default devShell to be `cabal-only-tools`, which some people were already using to work around issues with the previous default. --- flake.nix | 39 +++++++-------------------------------- 1 file changed, 7 insertions(+), 32 deletions(-) diff --git a/flake.nix b/flake.nix index a951d47487..fad934b577 100644 --- a/flake.nix +++ b/flake.nix @@ -64,29 +64,6 @@ unwrapped-stack = unstable.stack; hpack = unstable.hpack; }; - nixpkgs-devShells = { - only-tools-nixpkgs = unstable.mkShell { - name = "only-tools-nixpkgs"; - buildInputs = let - build-tools = with nixpkgs-packages; [ - ghc - ormolu - hls - stack - hpack - ]; - native-packages = - pkgs.lib.optionals pkgs.stdenv.isDarwin - (with unstable.darwin.apple_sdk.frameworks; [Cocoa]); - c-deps = with unstable; [pkg-config zlib glibcLocales]; - in - build-tools ++ c-deps ++ native-packages; - shellHook = '' - export LD_LIBRARY_PATH=${pkgs.zlib}/lib:$LD_LIBRARY_PATH - ''; - }; - }; - renameAttrs = fn: nixpkgs.lib.mapAttrs' (name: value: { inherit value; @@ -113,12 +90,11 @@ name = "all"; paths = let all-other-packages = builtins.attrValues (builtins.removeAttrs self.packages."${system}" ["all" "build-tools"]); - devshell-inputs = - builtins.concatMap - (devShell: devShell.buildInputs ++ devShell.nativeBuildInputs) - [ - self.devShells."${system}".only-tools-nixpkgs - ]; + ## FIXME: Including these inputs currently results in massing GHC builds. + devshell-inputs = []; + # builtins.concatMap + # (devShell: devShell.buildInputs ++ devShell.nativeBuildInputs) + # (builtins.attrValues self.devShells."${system}"); in all-other-packages ++ devshell-inputs; }; @@ -129,9 +105,8 @@ // {default = self.apps."${system}"."component-unison-cli-main:exe:unison";}; devShells = - nixpkgs-devShells - // renameAttrs (name: "cabal-${name}") haskell-nix-flake.devShells - // {default = self.devShells."${system}".only-tools-nixpkgs;}; + renameAttrs (name: "cabal-${name}") haskell-nix-flake.devShells + // {default = self.devShells."${system}".cabal-only-tools;}; checks = renameAttrs (name: "component-${name}") haskell-nix-flake.checks; From 01e03512f087f0f3176dd4ae52a1df90c20ad944 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 27 Jun 2024 13:56:38 -0600 Subject: [PATCH 328/631] Switch `nixos-unstable` to `release-23.11` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit There are various benefits to using a Nixpkgs release - more likely that things are cached - easier to update the input without breaking everything This also renames a lot of things in the flake: - `nixpkgs-unstable` to `nixpkgs-release` – partially because it’s not unstable any more, but also because both it and the nixpkgs from haskell.nix unstable, so it didn’t really clarify anything - `nixpkgs` to `nixpkgs-haskellNix` – to make it clear where it comes from - `unstable` to `release-pkgs` – the convention is to use `pkgs` for derivation attrsets, and the source switched from unstable to release - `nixpkgs-packages` to `tool-pkgs` – this holds our build tools, so that seemed clearer than “nixpkgs” --- flake.lock | 24 ++++++++++++------------ flake.nix | 44 ++++++++++++++++++++++---------------------- 2 files changed, 34 insertions(+), 34 deletions(-) diff --git a/flake.lock b/flake.lock index d4ece12a51..e0c344904a 100644 --- a/flake.lock +++ b/flake.lock @@ -542,34 +542,34 @@ "type": "github" } }, - "nixpkgs-unstable": { + "nixpkgs-release": { "locked": { - "lastModified": 1695318763, - "narHash": "sha256-FHVPDRP2AfvsxAdc+AsgFJevMz5VBmnZglFUMlxBkcY=", + "lastModified": 1719511581, + "narHash": "sha256-AJrEKLwOT/4oAgiqwRknLXRk9kbokyddHIl/o3sKdB0=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "e12483116b3b51a185a33a272bf351e357ba9a99", + "rev": "b27c5600975cbca6bae52048b8fd0e5ea2cc51eb", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixpkgs-unstable", + "ref": "release-23.11", "repo": "nixpkgs", "type": "github" } }, - "nixpkgs-unstable_2": { + "nixpkgs-unstable": { "locked": { - "lastModified": 1699781429, - "narHash": "sha256-UYefjidASiLORAjIvVsUHG6WBtRhM67kTjEY4XfZOFs=", + "lastModified": 1695318763, + "narHash": "sha256-FHVPDRP2AfvsxAdc+AsgFJevMz5VBmnZglFUMlxBkcY=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "e44462d6021bfe23dfb24b775cc7c390844f773d", + "rev": "e12483116b3b51a185a33a272bf351e357ba9a99", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixos-unstable", + "ref": "nixpkgs-unstable", "repo": "nixpkgs", "type": "github" } @@ -595,11 +595,11 @@ "inputs": { "flake-utils": "flake-utils", "haskellNix": "haskellNix", - "nixpkgs": [ + "nixpkgs-haskellNix": [ "haskellNix", "nixpkgs-unstable" ], - "nixpkgs-unstable": "nixpkgs-unstable_2" + "nixpkgs-release": "nixpkgs-release" } }, "stackage": { diff --git a/flake.nix b/flake.nix index fad934b577..f92955f62f 100644 --- a/flake.nix +++ b/flake.nix @@ -8,17 +8,17 @@ inputs = { haskellNix.url = "github:input-output-hk/haskell.nix"; - nixpkgs.follows = "haskellNix/nixpkgs-unstable"; - nixpkgs-unstable.url = "github:NixOS/nixpkgs/nixos-unstable"; + nixpkgs-haskellNix.follows = "haskellNix/nixpkgs-unstable"; + nixpkgs-release.url = "github:NixOS/nixpkgs/release-23.11"; flake-utils.url = "github:numtide/flake-utils"; }; outputs = { self, - nixpkgs, - flake-utils, haskellNix, - nixpkgs-unstable, + nixpkgs-haskellNix, + nixpkgs-release, + flake-utils, }: flake-utils.lib.eachSystem [ "x86_64-linux" @@ -38,42 +38,42 @@ (import ./nix/haskell-nix-overlay.nix) (import ./nix/unison-overlay.nix) ]; - pkgs = import nixpkgs { + pkgs = import nixpkgs-haskellNix { inherit system overlays; inherit (haskellNix) config; }; haskell-nix-flake = import ./nix/haskell-nix-flake.nix { inherit pkgs versions; - inherit (nixpkgs-packages) stack hpack; + inherit (tool-pkgs) stack hpack; }; - unstable = import nixpkgs-unstable { + release-pkgs = import nixpkgs-release { inherit system; overlays = [ (import ./nix/unison-overlay.nix) (import ./nix/nixpkgs-overlay.nix {inherit versions;}) ]; }; - nixpkgs-packages = let - hpkgs = unstable.haskell.packages.ghcunison; - exe = unstable.haskell.lib.justStaticExecutables; + tool-pkgs = let + hpkgs = release-pkgs.haskell.packages.ghcunison; + exe = release-pkgs.haskell.lib.justStaticExecutables; in { - ghc = unstable.haskell.compiler."ghc${versions.ghc}"; + ghc = release-pkgs.haskell.compiler."ghc${versions.ghc}"; ormolu = exe hpkgs.ormolu; - hls = unstable.unison-hls; - stack = unstable.unison-stack; - unwrapped-stack = unstable.stack; - hpack = unstable.hpack; + hls = release-pkgs.unison-hls; + stack = release-pkgs.unison-stack; + unwrapped-stack = release-pkgs.stack; + hpack = release-pkgs.hpack; }; renameAttrs = fn: - nixpkgs.lib.mapAttrs' (name: value: { + nixpkgs-haskellNix.lib.mapAttrs' (name: value: { inherit value; name = fn name; }); in - assert nixpkgs-packages.ormolu.version == versions.ormolu; - assert nixpkgs-packages.hls.version == versions.hls; - assert nixpkgs-packages.unwrapped-stack.version == versions.stack; - assert nixpkgs-packages.hpack.version == versions.hpack; { + assert tool-pkgs.ormolu.version == versions.ormolu; + assert tool-pkgs.hls.version == versions.hls; + assert tool-pkgs.unwrapped-stack.version == versions.stack; + assert tool-pkgs.hpack.version == versions.hpack; { packages = renameAttrs (name: "component-${name}") haskell-nix-flake.packages // renameAttrs (name: "docker-${name}") (import ./nix/docker.nix { @@ -84,7 +84,7 @@ default = haskell-nix-flake.defaultPackage; build-tools = pkgs.symlinkJoin { name = "build-tools"; - paths = self.devShells."${system}".only-tools-nixpkgs.buildInputs; + paths = self.devShells."${system}".only-tools.buildInputs; }; all = pkgs.symlinkJoin { name = "all"; From a5b986467e88db093f79f0ae42def412243784af Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 27 Jun 2024 14:23:10 -0600 Subject: [PATCH 329/631] =?UTF-8?q?Don=E2=80=99t=20hide=20`unison-project`?= =?UTF-8?q?=20in=20an=20overlay?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Overlays are for derivations, and this isn’t one. Putting it in an overlay also just gives us more levels of indirection to dig through to figure out where things are coming from. --- flake.nix | 7 +++++-- nix/haskell-nix-flake.nix | 10 ++++----- nix/haskell-nix-overlay.nix | 41 ------------------------------------- nix/unison-project.nix | 39 +++++++++++++++++++++++++++++++++++ 4 files changed, 49 insertions(+), 48 deletions(-) delete mode 100644 nix/haskell-nix-overlay.nix create mode 100644 nix/unison-project.nix diff --git a/flake.nix b/flake.nix index f92955f62f..bbab42cfa2 100644 --- a/flake.nix +++ b/flake.nix @@ -35,15 +35,18 @@ }; overlays = [ haskellNix.overlay - (import ./nix/haskell-nix-overlay.nix) (import ./nix/unison-overlay.nix) ]; pkgs = import nixpkgs-haskellNix { inherit system overlays; inherit (haskellNix) config; }; + unison-project = import ./nix/unison-project.nix { + inherit (nixpkgs-haskellNix) lib; + inherit (pkgs) haskell-nix; + }; haskell-nix-flake = import ./nix/haskell-nix-flake.nix { - inherit pkgs versions; + inherit pkgs unison-project versions; inherit (tool-pkgs) stack hpack; }; release-pkgs = import nixpkgs-release { diff --git a/nix/haskell-nix-flake.nix b/nix/haskell-nix-flake.nix index c0c992ae01..1beb923c60 100644 --- a/nix/haskell-nix-flake.nix +++ b/nix/haskell-nix-flake.nix @@ -2,9 +2,10 @@ stack, hpack, pkgs, + unison-project, versions, }: let - haskell-nix-flake = pkgs.unison-project.flake {}; + haskell-nix-flake = unison-project.flake {}; commonShellArgs = args: args // { @@ -49,9 +50,9 @@ }; }; - shellFor = args: pkgs.unison-project.shellFor (commonShellArgs args); + shellFor = args: unison-project.shellFor (commonShellArgs args); - localPackages = with pkgs.lib; filterAttrs (k: v: v.isLocal or false) pkgs.unison-project.hsPkgs; + localPackages = with pkgs.lib; filterAttrs (k: v: v.isLocal or false) unison-project.hsPkgs; localPackageNames = builtins.attrNames localPackages; devShells = let mkDevShell = pkgName: @@ -92,6 +93,5 @@ in haskell-nix-flake // { defaultPackage = haskell-nix-flake.packages."unison-cli-main:exe:unison"; - inherit (pkgs) unison-project; - inherit checks devShells localPackageNames; + inherit checks devShells; } diff --git a/nix/haskell-nix-overlay.nix b/nix/haskell-nix-overlay.nix deleted file mode 100644 index b98ee874f2..0000000000 --- a/nix/haskell-nix-overlay.nix +++ /dev/null @@ -1,41 +0,0 @@ -final: prev: { - unison-project = with prev.lib.strings; let - cleanSource = pth: let - src' = prev.lib.cleanSourceWith { - filter = filt; - src = pth; - }; - filt = path: type: let - bn = baseNameOf path; - isHiddenFile = hasPrefix "." bn; - isFlakeLock = bn == "flake.lock"; - isNix = hasSuffix ".nix" bn; - in - !isHiddenFile && !isFlakeLock && !isNix; - in - src'; - in - final.haskell-nix.project' { - src = cleanSource ./..; - projectFileName = "stack.yaml"; - modules = [ - # enable profiling - { - enableLibraryProfiling = true; - profilingDetail = "none"; - } - # remove buggy build tool dependencies - ({lib, ...}: { - # this component has the build tool - # `unison-cli:unison` and somehow haskell.nix - # decides to add some file sharing package - # `unison` as a build-tool dependency. - packages.unison-cli.components.exes.cli-integration-tests.build-tools = lib.mkForce []; - }) - ]; - branchMap = { - "https://github.com/unisonweb/configurator.git"."e47e9e9fe1f576f8c835183b9def52d73c01327a" = "unison"; - "https://github.com/unisonweb/shellmet.git"."2fd348592c8f51bb4c0ca6ba4bc8e38668913746" = "topic/avoid-callCommand"; - }; - }; -} diff --git a/nix/unison-project.nix b/nix/unison-project.nix new file mode 100644 index 0000000000..b895379a3b --- /dev/null +++ b/nix/unison-project.nix @@ -0,0 +1,39 @@ +{ + haskell-nix, + lib, +}: let + cleanSource = src: + lib.cleanSourceWith { + inherit src; + filter = path: type: let + bn = baseNameOf path; + isHiddenFile = lib.hasPrefix "." bn; + isFlakeLock = bn == "flake.lock"; + isNix = lib.hasSuffix ".nix" bn; + in + !isHiddenFile && !isFlakeLock && !isNix; + }; +in + haskell-nix.project' { + src = cleanSource ./..; + projectFileName = "stack.yaml"; + modules = [ + # enable profiling + { + enableLibraryProfiling = true; + profilingDetail = "none"; + } + # remove buggy build tool dependencies + ({lib, ...}: { + # this component has the build tool + # `unison-cli:unison` and somehow haskell.nix + # decides to add some file sharing package + # `unison` as a build-tool dependency. + packages.unison-cli.components.exes.cli-integration-tests.build-tools = lib.mkForce []; + }) + ]; + branchMap = { + "https://github.com/unisonweb/configurator.git"."e47e9e9fe1f576f8c835183b9def52d73c01327a" = "unison"; + "https://github.com/unisonweb/shellmet.git"."2fd348592c8f51bb4c0ca6ba4bc8e38668913746" = "topic/avoid-callCommand"; + }; + } From ba13de41a0ca6385da57ddb946b862cf52601ad0 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 27 Jun 2024 15:22:39 -0600 Subject: [PATCH 330/631] Remove dead code --- flake.nix | 16 ++------------ nix/nixpkgs-overlay.nix | 49 ----------------------------------------- 2 files changed, 2 insertions(+), 63 deletions(-) delete mode 100644 nix/nixpkgs-overlay.nix diff --git a/flake.nix b/flake.nix index bbab42cfa2..91dd3fd658 100644 --- a/flake.nix +++ b/flake.nix @@ -27,7 +27,6 @@ ] (system: let versions = { - ghc = "965"; ormolu = "0.5.2.0"; hls = "2.9.0.0"; stack = "2.15.5"; @@ -51,18 +50,9 @@ }; release-pkgs = import nixpkgs-release { inherit system; - overlays = [ - (import ./nix/unison-overlay.nix) - (import ./nix/nixpkgs-overlay.nix {inherit versions;}) - ]; + overlays = [(import ./nix/unison-overlay.nix)]; }; - tool-pkgs = let - hpkgs = release-pkgs.haskell.packages.ghcunison; - exe = release-pkgs.haskell.lib.justStaticExecutables; - in { - ghc = release-pkgs.haskell.compiler."ghc${versions.ghc}"; - ormolu = exe hpkgs.ormolu; - hls = release-pkgs.unison-hls; + tool-pkgs = { stack = release-pkgs.unison-stack; unwrapped-stack = release-pkgs.stack; hpack = release-pkgs.hpack; @@ -73,8 +63,6 @@ name = fn name; }); in - assert tool-pkgs.ormolu.version == versions.ormolu; - assert tool-pkgs.hls.version == versions.hls; assert tool-pkgs.unwrapped-stack.version == versions.stack; assert tool-pkgs.hpack.version == versions.hpack; { packages = diff --git a/nix/nixpkgs-overlay.nix b/nix/nixpkgs-overlay.nix deleted file mode 100644 index 033ee5e881..0000000000 --- a/nix/nixpkgs-overlay.nix +++ /dev/null @@ -1,49 +0,0 @@ -{versions}: final: prev: { - unison-hls = final.haskell-language-server.override { - # build with our overridden haskellPackages that have our pinned - # version of ormolu and hls - haskellPackages = final.haskell.packages."ghc${versions.ghc}"; - dynamic = true; - supportedGhcVersions = [versions.ghc]; - }; - haskell = - prev.haskell - // { - packages = - prev.haskell.packages - // { - ghcunison = prev.haskell.packages."ghc${versions.ghc}".extend (hfinal: hprev: let - inherit (prev.haskell.lib) overrideCabal; - in { - # dependency overrides for ormolu 0.5.2.0 - haskell-language-server = let - p = - hfinal.callHackageDirect - { - pkg = "haskell-language-server"; - ver = versions.hls; - sha256 = "0kp586yc162raljyd5arsxm5ndcx5zfw9v94v27bkjg7x0hp1s8b"; - } - { - hls-fourmolu-plugin = null; - hls-stylish-haskell-plugin = null; - hls-hlint-plugin = null; - hls-floskell-plugin = null; - }; - override = drv: { - doCheck = false; - configureFlags = - (drv.configureFlags or []) - ++ [ - "-f-fourmolu" - "-f-stylishhaskell" - "-f-hlint" - "-f-floskell" - ]; - }; - in - overrideCabal p override; - }); - }; - }; -} From 86819b89cd97df329de9422ef046785834f19bb6 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 27 Jun 2024 15:22:51 -0600 Subject: [PATCH 331/631] Remove reference to non-existent Cabal component --- nix/unison-project.nix | 8 -------- 1 file changed, 8 deletions(-) diff --git a/nix/unison-project.nix b/nix/unison-project.nix index b895379a3b..aa191a5a44 100644 --- a/nix/unison-project.nix +++ b/nix/unison-project.nix @@ -23,14 +23,6 @@ in enableLibraryProfiling = true; profilingDetail = "none"; } - # remove buggy build tool dependencies - ({lib, ...}: { - # this component has the build tool - # `unison-cli:unison` and somehow haskell.nix - # decides to add some file sharing package - # `unison` as a build-tool dependency. - packages.unison-cli.components.exes.cli-integration-tests.build-tools = lib.mkForce []; - }) ]; branchMap = { "https://github.com/unisonweb/configurator.git"."e47e9e9fe1f576f8c835183b9def52d73c01327a" = "unison"; From 110b5ca8b0b6893af42e9c9bd55d61300376180b Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 27 Jun 2024 15:31:43 -0600 Subject: [PATCH 332/631] Actually cache UCM in CI --- .github/workflows/nix-dev-cache.yaml | 2 +- flake.nix | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.github/workflows/nix-dev-cache.yaml b/.github/workflows/nix-dev-cache.yaml index e4e7aa4987..9ee02af326 100644 --- a/.github/workflows/nix-dev-cache.yaml +++ b/.github/workflows/nix-dev-cache.yaml @@ -37,4 +37,4 @@ jobs: name: unison authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' - name: build all packages and development shells - run: nix -L build --accept-flake-config --no-link --keep-going '.#build-tools' + run: nix -L build --accept-flake-config --no-link --keep-going '.#all' diff --git a/flake.nix b/flake.nix index 91dd3fd658..e70be77b56 100644 --- a/flake.nix +++ b/flake.nix @@ -73,14 +73,14 @@ }) // { default = haskell-nix-flake.defaultPackage; - build-tools = pkgs.symlinkJoin { - name = "build-tools"; - paths = self.devShells."${system}".only-tools.buildInputs; - }; all = pkgs.symlinkJoin { name = "all"; paths = let - all-other-packages = builtins.attrValues (builtins.removeAttrs self.packages."${system}" ["all" "build-tools"]); + all-other-packages = + builtins.attrValues (builtins.removeAttrs self.packages."${system}" [ + "all" + "docker-ucm" # this package doesn’t produce a directory + ]); ## FIXME: Including these inputs currently results in massing GHC builds. devshell-inputs = []; # builtins.concatMap From f25af6946eb3b11e140ce8c983f9f7ec3e9bb480 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 27 Jun 2024 16:07:09 -0600 Subject: [PATCH 333/631] Override tool versions directly in the package set --- flake.nix | 24 +++++++----------------- nix/dependencies.nix | 21 +++++++++++++++++++++ nix/haskell-nix-flake.nix | 6 +++--- nix/unison-overlay.nix | 15 --------------- 4 files changed, 31 insertions(+), 35 deletions(-) create mode 100644 nix/dependencies.nix delete mode 100644 nix/unison-overlay.nix diff --git a/flake.nix b/flake.nix index e70be77b56..63ed585cc5 100644 --- a/flake.nix +++ b/flake.nix @@ -32,13 +32,13 @@ stack = "2.15.5"; hpack = "0.35.2"; }; - overlays = [ - haskellNix.overlay - (import ./nix/unison-overlay.nix) - ]; pkgs = import nixpkgs-haskellNix { - inherit system overlays; + inherit system; inherit (haskellNix) config; + overlays = [ + haskellNix.overlay + (import ./nix/dependencies.nix {inherit nixpkgs-release;}) + ]; }; unison-project = import ./nix/unison-project.nix { inherit (nixpkgs-haskellNix) lib; @@ -46,16 +46,6 @@ }; haskell-nix-flake = import ./nix/haskell-nix-flake.nix { inherit pkgs unison-project versions; - inherit (tool-pkgs) stack hpack; - }; - release-pkgs = import nixpkgs-release { - inherit system; - overlays = [(import ./nix/unison-overlay.nix)]; - }; - tool-pkgs = { - stack = release-pkgs.unison-stack; - unwrapped-stack = release-pkgs.stack; - hpack = release-pkgs.hpack; }; renameAttrs = fn: nixpkgs-haskellNix.lib.mapAttrs' (name: value: { @@ -63,8 +53,8 @@ name = fn name; }); in - assert tool-pkgs.unwrapped-stack.version == versions.stack; - assert tool-pkgs.hpack.version == versions.hpack; { + assert pkgs.stack.version == versions.stack; + assert pkgs.hpack.version == versions.hpack; { packages = renameAttrs (name: "component-${name}") haskell-nix-flake.packages // renameAttrs (name: "docker-${name}") (import ./nix/docker.nix { diff --git a/nix/dependencies.nix b/nix/dependencies.nix new file mode 100644 index 0000000000..7df873660f --- /dev/null +++ b/nix/dependencies.nix @@ -0,0 +1,21 @@ +{nixpkgs-release}: final: prev: let + pinned-pkgs = import nixpkgs-release {inherit (final) system;}; +in { + stack = pinned-pkgs.stack; + + ## See https://docs.haskellstack.org/en/stable/nix_integration/#supporting-both-nix-and-non-nix-developers for an + ## explanation of this package. + stack-wrapped = final.symlinkJoin { + name = "stack"; # will be available as the usual `stack` in terminal + paths = [final.stack]; + buildInputs = [final.makeWrapper]; + postBuild = '' + wrapProgram $out/bin/stack \ + --add-flags "\ + --no-nix \ + --system-ghc \ + --no-install-ghc \ + " + ''; + }; +} diff --git a/nix/haskell-nix-flake.nix b/nix/haskell-nix-flake.nix index 1beb923c60..03772f64e1 100644 --- a/nix/haskell-nix-flake.nix +++ b/nix/haskell-nix-flake.nix @@ -1,6 +1,4 @@ { - stack, - hpack, pkgs, unison-project, versions, @@ -19,7 +17,9 @@ pkgs.lib.optionals pkgs.stdenv.isDarwin (with pkgs.darwin.apple_sdk.frameworks; [Cocoa]); in - (args.buildInputs or []) ++ [stack hpack pkgs.pkg-config pkgs.zlib pkgs.glibcLocales] ++ native-packages; + (args.buildInputs or []) + ++ [pkgs.stack-wrapped pkgs.hpack pkgs.pkg-config pkgs.zlib pkgs.glibcLocales] + ++ native-packages; # workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/11042 shellHook = '' export LD_LIBRARY_PATH=${pkgs.zlib}/lib:$LD_LIBRARY_PATH diff --git a/nix/unison-overlay.nix b/nix/unison-overlay.nix deleted file mode 100644 index 5f7f1a336d..0000000000 --- a/nix/unison-overlay.nix +++ /dev/null @@ -1,15 +0,0 @@ -final: prev: { - # a wrapped version of stack that passes the necessary flags to use - # the nix provided ghc. - unison-stack = prev.symlinkJoin { - name = "stack"; - paths = [final.stack]; - buildInputs = [final.makeWrapper]; - postBuild = let - flags = ["--no-nix" "--system-ghc" "--no-install-ghc"]; - add-flags = "--add-flags '${prev.lib.concatStringsSep " " flags}'"; - in '' - wrapProgram "$out/bin/stack" ${add-flags} - ''; - }; -} From dad9d6d6338c86d191a5c5cf42deccb8a4bf5a4c Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 27 Jun 2024 16:14:57 -0600 Subject: [PATCH 334/631] Minor simplification of haskell-nix-flake --- flake.nix | 1 + nix/haskell-nix-flake.nix | 75 +++++++++++++++++++-------------------- 2 files changed, 38 insertions(+), 38 deletions(-) diff --git a/flake.nix b/flake.nix index 63ed585cc5..6afbddb1e4 100644 --- a/flake.nix +++ b/flake.nix @@ -46,6 +46,7 @@ }; haskell-nix-flake = import ./nix/haskell-nix-flake.nix { inherit pkgs unison-project versions; + inherit (nixpkgs-haskellNix) lib; }; renameAttrs = fn: nixpkgs-haskellNix.lib.mapAttrs' (name: value: { diff --git a/nix/haskell-nix-flake.nix b/nix/haskell-nix-flake.nix index 03772f64e1..b823bc2c9b 100644 --- a/nix/haskell-nix-flake.nix +++ b/nix/haskell-nix-flake.nix @@ -1,4 +1,5 @@ { + lib, pkgs, unison-project, versions, @@ -14,7 +15,7 @@ additional = hpkgs: with hpkgs; [Cabal stm exceptions ghc ghc-heap]; buildInputs = let native-packages = - pkgs.lib.optionals pkgs.stdenv.isDarwin + lib.optionals pkgs.stdenv.isDarwin (with pkgs.darwin.apple_sdk.frameworks; [Cocoa]); in (args.buildInputs or []) @@ -52,46 +53,44 @@ shellFor = args: unison-project.shellFor (commonShellArgs args); - localPackages = with pkgs.lib; filterAttrs (k: v: v.isLocal or false) unison-project.hsPkgs; + localPackages = lib.filterAttrs (k: v: v.isLocal or false) unison-project.hsPkgs; localPackageNames = builtins.attrNames localPackages; - devShells = let - mkDevShell = pkgName: - shellFor { - packages = hpkgs: [hpkgs."${pkgName}"]; - withHoogle = true; - }; - localPackageDevShells = - pkgs.lib.genAttrs localPackageNames mkDevShell; - in - { - only-tools = shellFor { - packages = _: []; - withHoogle = false; - }; - local = shellFor { - packages = hpkgs: (map (p: hpkgs."${p}") localPackageNames); - withHoogle = false; - }; - } - // localPackageDevShells; - - checks = - haskell-nix-flake.checks - // { - ## This check has a test that tries to write to $HOME, so we give it a fake one. - "unison-cli:test:cli-tests" = haskell-nix-flake.checks."unison-cli:test:cli-tests".overrideAttrs (old: { - ## The builder here doesn’t `runHook preBuild`, so we just prepend onto `buildPhase`. - buildPhase = - '' - export HOME="$TMP/fake-home" - mkdir -p "$HOME" - '' - + old.buildPhase or ""; - }); - }; in haskell-nix-flake // { + checks = + haskell-nix-flake.checks + // { + ## This check has a test that tries to write to $HOME, so we give it a fake one. + "unison-cli:test:cli-tests" = haskell-nix-flake.checks."unison-cli:test:cli-tests".overrideAttrs (old: { + ## The builder here doesn’t `runHook preBuild`, so we just prepend onto `buildPhase`. + buildPhase = + '' + export HOME="$TMP/fake-home" + mkdir -p "$HOME" + '' + + old.buildPhase or ""; + }); + }; + defaultPackage = haskell-nix-flake.packages."unison-cli-main:exe:unison"; - inherit checks devShells; + + devShells = let + mkDevShell = pkgName: + shellFor { + packages = hpkgs: [hpkgs."${pkgName}"]; + withHoogle = true; + }; + in + { + only-tools = shellFor { + packages = _: []; + withHoogle = false; + }; + local = shellFor { + packages = hpkgs: (map (p: hpkgs."${p}") localPackageNames); + withHoogle = false; + }; + } + // lib.genAttrs localPackageNames mkDevShell; } From 7b373d73ff04f4648e54e8b1ee555257fc03c1eb Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 27 Jun 2024 17:00:05 -0600 Subject: [PATCH 335/631] Eliminate `only-tools` devShell `cabal-local` no longer triggers rebuilds of GHC, so now we can use the devShell that provides the same environment as our build. --- flake.nix | 2 +- nix/haskell-nix-flake.nix | 16 ++++++---------- 2 files changed, 7 insertions(+), 11 deletions(-) diff --git a/flake.nix b/flake.nix index 6afbddb1e4..5f3e558bc7 100644 --- a/flake.nix +++ b/flake.nix @@ -88,7 +88,7 @@ devShells = renameAttrs (name: "cabal-${name}") haskell-nix-flake.devShells - // {default = self.devShells."${system}".cabal-only-tools;}; + // {default = self.devShells."${system}".cabal-local;}; checks = renameAttrs (name: "component-${name}") haskell-nix-flake.checks; diff --git a/nix/haskell-nix-flake.nix b/nix/haskell-nix-flake.nix index b823bc2c9b..25930790c1 100644 --- a/nix/haskell-nix-flake.nix +++ b/nix/haskell-nix-flake.nix @@ -54,7 +54,6 @@ shellFor = args: unison-project.shellFor (commonShellArgs args); localPackages = lib.filterAttrs (k: v: v.isLocal or false) unison-project.hsPkgs; - localPackageNames = builtins.attrNames localPackages; in haskell-nix-flake // { @@ -76,21 +75,18 @@ in defaultPackage = haskell-nix-flake.packages."unison-cli-main:exe:unison"; devShells = let - mkDevShell = pkgName: + mkDevShell = pkg: shellFor { - packages = hpkgs: [hpkgs."${pkgName}"]; - withHoogle = true; + packages = _hpkgs: [pkg]; + ## Enabling Hoogle causes us to rebuild GHC. + withHoogle = false; }; in { - only-tools = shellFor { - packages = _: []; - withHoogle = false; - }; local = shellFor { - packages = hpkgs: (map (p: hpkgs."${p}") localPackageNames); + packages = _hpkgs: builtins.attrValues localPackages; withHoogle = false; }; } - // lib.genAttrs localPackageNames mkDevShell; + // pkgs.lib.mapAttrs (_name: mkDevShell) localPackages; } From f2c8020f5eadbedb98ea108bc2fd6dcf161d9af5 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 27 Jun 2024 17:21:48 -0600 Subject: [PATCH 336/631] Can now include the devShells in `all` package This means those environments will also be cached in CI. --- flake.nix | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/flake.nix b/flake.nix index 5f3e558bc7..72fb356eee 100644 --- a/flake.nix +++ b/flake.nix @@ -72,11 +72,10 @@ "all" "docker-ucm" # this package doesn’t produce a directory ]); - ## FIXME: Including these inputs currently results in massing GHC builds. - devshell-inputs = []; - # builtins.concatMap - # (devShell: devShell.buildInputs ++ devShell.nativeBuildInputs) - # (builtins.attrValues self.devShells."${system}"); + devshell-inputs = + builtins.concatMap + (devShell: devShell.buildInputs ++ devShell.nativeBuildInputs) + (builtins.attrValues self.devShells."${system}"); in all-other-packages ++ devshell-inputs; }; From c47bdcfdc5a810041c5ff0c95a7ebe97045903d6 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 27 Jun 2024 17:27:58 -0600 Subject: [PATCH 337/631] Get Nix build working with GHC 9.6.5 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bumped some versions around, but they’re negotiable. - ormolu 0.5.2.0 → 0.7.2.0 - hls 2.9.0.0 → 2.8.0.0 - stack 2.15.5 → 2.15.7 --- flake.lock | 196 +++++++++++++++++++++++++++++++++-------------------- flake.nix | 8 +-- 2 files changed, 127 insertions(+), 77 deletions(-) diff --git a/flake.lock b/flake.lock index e0c344904a..4c07d21e1a 100644 --- a/flake.lock +++ b/flake.lock @@ -135,51 +135,14 @@ "type": "github" } }, - "ghc98X": { - "flake": false, - "locked": { - "lastModified": 1696643148, - "narHash": "sha256-E02DfgISH7EvvNAu0BHiPvl1E5FGMDi0pWdNZtIBC9I=", - "ref": "ghc-9.8", - "rev": "443e870d977b1ab6fc05f47a9a17bc49296adbd6", - "revCount": 61642, - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" - }, - "original": { - "ref": "ghc-9.8", - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" - } - }, - "ghc99": { - "flake": false, - "locked": { - "lastModified": 1697054644, - "narHash": "sha256-kKarOuXUaAH3QWv7ASx+gGFMHaHKe0pK5Zu37ky2AL4=", - "ref": "refs/heads/master", - "rev": "f383a242c76f90bcca8a4d7ee001dcb49c172a9a", - "revCount": 62040, - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" - }, - "original": { - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" - } - }, "hackage": { "flake": false, "locked": { - "lastModified": 1699402991, - "narHash": "sha256-2nQBlA3ygBiIqVPh2J1JwP51rEO0xMjyoOaoJk5PboY=", + "lastModified": 1719535035, + "narHash": "sha256-kCCfZytGgkRYlsiNe/dwLAnpNOvfywpjVl61hO/8l2M=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "9e963602a5b3259dac9cf5e994f0a338fb352b7e", + "rev": "66f23365685f71610460f3c2c0dfa91f96c532ac", "type": "github" }, "original": { @@ -197,14 +160,16 @@ "cardano-shell": "cardano-shell", "flake-compat": "flake-compat", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", - "ghc98X": "ghc98X", - "ghc99": "ghc99", "hackage": "hackage", "hls-1.10": "hls-1.10", "hls-2.0": "hls-2.0", "hls-2.2": "hls-2.2", "hls-2.3": "hls-2.3", "hls-2.4": "hls-2.4", + "hls-2.5": "hls-2.5", + "hls-2.6": "hls-2.6", + "hls-2.7": "hls-2.7", + "hls-2.8": "hls-2.8", "hpc-coveralls": "hpc-coveralls", "hydra": "hydra", "iserv-proxy": "iserv-proxy", @@ -218,16 +183,17 @@ "nixpkgs-2205": "nixpkgs-2205", "nixpkgs-2211": "nixpkgs-2211", "nixpkgs-2305": "nixpkgs-2305", + "nixpkgs-2311": "nixpkgs-2311", "nixpkgs-unstable": "nixpkgs-unstable", "old-ghc-nix": "old-ghc-nix", "stackage": "stackage" }, "locked": { - "lastModified": 1699404571, - "narHash": "sha256-EwI7vKBxCHvIKPWbvGlOF9IZlSFqPODgT/BQy8Z2s/w=", + "lastModified": 1719535822, + "narHash": "sha256-IteIKK4+GEZI2nHqCz0zRVgQ3aqs/WXKTOt2sbHJmGk=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "cec253ca482301509e9e90cb5c15299dd3550cce", + "rev": "72bc84d0a4e8d0536505628040d96fd0a9e16c70", "type": "github" }, "original": { @@ -307,16 +273,84 @@ "hls-2.4": { "flake": false, "locked": { - "lastModified": 1696939266, - "narHash": "sha256-VOMf5+kyOeOmfXTHlv4LNFJuDGa7G3pDnOxtzYR40IU=", + "lastModified": 1699862708, + "narHash": "sha256-YHXSkdz53zd0fYGIYOgLt6HrA0eaRJi9mXVqDgmvrjk=", "owner": "haskell", "repo": "haskell-language-server", - "rev": "362fdd1293efb4b82410b676ab1273479f6d17ee", + "rev": "54507ef7e85fa8e9d0eb9a669832a3287ffccd57", "type": "github" }, "original": { "owner": "haskell", - "ref": "2.4.0.0", + "ref": "2.4.0.1", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.5": { + "flake": false, + "locked": { + "lastModified": 1701080174, + "narHash": "sha256-fyiR9TaHGJIIR0UmcCb73Xv9TJq3ht2ioxQ2mT7kVdc=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "27f8c3d3892e38edaef5bea3870161815c4d014c", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.5.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.6": { + "flake": false, + "locked": { + "lastModified": 1705325287, + "narHash": "sha256-+P87oLdlPyMw8Mgoul7HMWdEvWP/fNlo8jyNtwME8E8=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "6e0b342fa0327e628610f2711f8c3e4eaaa08b1e", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.6.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.7": { + "flake": false, + "locked": { + "lastModified": 1708965829, + "narHash": "sha256-LfJ+TBcBFq/XKoiNI7pc4VoHg4WmuzsFxYJ3Fu+Jf+M=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "50322b0a4aefb27adc5ec42f5055aaa8f8e38001", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.7.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.8": { + "flake": false, + "locked": { + "lastModified": 1715153580, + "narHash": "sha256-Vi/iUt2pWyUJlo9VrYgTcbRviWE0cFO6rmGi9rmALw0=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "dd1be1beb16700de59e0d6801957290bcf956a0a", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.8.0.0", "repo": "haskell-language-server", "type": "github" } @@ -363,18 +397,18 @@ "iserv-proxy": { "flake": false, "locked": { - "lastModified": 1691634696, - "narHash": "sha256-MZH2NznKC/gbgBu8NgIibtSUZeJ00HTLJ0PlWKCBHb0=", - "ref": "hkm/remote-iserv", - "rev": "43a979272d9addc29fbffc2e8542c5d96e993d73", - "revCount": 14, - "type": "git", - "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git" + "lastModified": 1717479972, + "narHash": "sha256-7vE3RQycHI1YT9LHJ1/fUaeln2vIpYm6Mmn8FTpYeVo=", + "owner": "stable-haskell", + "repo": "iserv-proxy", + "rev": "2ed34002247213fc435d0062350b91bab920626e", + "type": "github" }, "original": { - "ref": "hkm/remote-iserv", - "type": "git", - "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git" + "owner": "stable-haskell", + "ref": "iserv-syms", + "repo": "iserv-proxy", + "type": "github" } }, "lowdown-src": { @@ -512,11 +546,11 @@ }, "nixpkgs-2305": { "locked": { - "lastModified": 1695416179, - "narHash": "sha256-610o1+pwbSu+QuF3GE0NU5xQdTHM3t9wyYhB9l94Cd8=", + "lastModified": 1701362232, + "narHash": "sha256-GVdzxL0lhEadqs3hfRLuj+L1OJFGiL/L7gCcelgBlsw=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "715d72e967ec1dd5ecc71290ee072bcaf5181ed6", + "rev": "d2332963662edffacfddfad59ff4f709dde80ffe", "type": "github" }, "original": { @@ -526,6 +560,22 @@ "type": "github" } }, + "nixpkgs-2311": { + "locked": { + "lastModified": 1701386440, + "narHash": "sha256-xI0uQ9E7JbmEy/v8kR9ZQan6389rHug+zOtZeZFiDJk=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "293822e55ec1872f715a66d0eda9e592dc14419f", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-23.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs-regression": { "locked": { "lastModified": 1643052045, @@ -544,33 +594,33 @@ }, "nixpkgs-release": { "locked": { - "lastModified": 1719511581, - "narHash": "sha256-AJrEKLwOT/4oAgiqwRknLXRk9kbokyddHIl/o3sKdB0=", + "lastModified": 1719520878, + "narHash": "sha256-5BXzNOl2RVHcfS/oxaZDKOi7gVuTyWPibQG0DHd5sSc=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "b27c5600975cbca6bae52048b8fd0e5ea2cc51eb", + "rev": "a44bedbb48c367f0476e6a3a27bf28f6330faf23", "type": "github" }, "original": { "owner": "NixOS", - "ref": "release-23.11", + "ref": "release-24.05", "repo": "nixpkgs", "type": "github" } }, "nixpkgs-unstable": { "locked": { - "lastModified": 1695318763, - "narHash": "sha256-FHVPDRP2AfvsxAdc+AsgFJevMz5VBmnZglFUMlxBkcY=", + "lastModified": 1694822471, + "narHash": "sha256-6fSDCj++lZVMZlyqOe9SIOL8tYSBz1bI8acwovRwoX8=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "e12483116b3b51a185a33a272bf351e357ba9a99", + "rev": "47585496bcb13fb72e4a90daeea2f434e2501998", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixpkgs-unstable", "repo": "nixpkgs", + "rev": "47585496bcb13fb72e4a90daeea2f434e2501998", "type": "github" } }, @@ -605,11 +655,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1699402155, - "narHash": "sha256-fOywUFLuAuZAkIrv1JdjGzfY53uEiMRlu8UpdJtCjh0=", + "lastModified": 1719102283, + "narHash": "sha256-pon+cXgMWPlCiBx9GlRcjsjTHbCc8fDVgOGb3Z7qhRM=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "7c7bfe8cca23c96b850e16f3c0b159aca1850314", + "rev": "7df45e0bd9852810d8070f9c5257f8e7a4677b91", "type": "github" }, "original": { diff --git a/flake.nix b/flake.nix index 72fb356eee..0be2f8da81 100644 --- a/flake.nix +++ b/flake.nix @@ -9,7 +9,7 @@ inputs = { haskellNix.url = "github:input-output-hk/haskell.nix"; nixpkgs-haskellNix.follows = "haskellNix/nixpkgs-unstable"; - nixpkgs-release.url = "github:NixOS/nixpkgs/release-23.11"; + nixpkgs-release.url = "github:NixOS/nixpkgs/release-24.05"; flake-utils.url = "github:numtide/flake-utils"; }; @@ -27,9 +27,9 @@ ] (system: let versions = { - ormolu = "0.5.2.0"; - hls = "2.9.0.0"; - stack = "2.15.5"; + ormolu = "0.7.2.0"; + hls = "2.8.0.0"; + stack = "2.15.7"; hpack = "0.35.2"; }; pkgs = import nixpkgs-haskellNix { From d98b4aebc1a85552610d39b81aaf7c211de4494b Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 1 Jul 2024 10:28:52 -0700 Subject: [PATCH 338/631] Port more transcripts to projects --- .../ability-term-conflicts-on-update.md | 20 +++++++------- ...ability-term-conflicts-on-update.output.md | 16 ++++++------ unison-src/transcripts/higher-rank.md | 24 ++++++++--------- unison-src/transcripts/higher-rank.output.md | 26 +++++++++---------- unison-src/transcripts/merge.md | 4 +-- unison-src/transcripts/merge.output.md | 4 +-- unison-src/transcripts/resolution-failures.md | 2 +- .../transcripts/resolution-failures.output.md | 4 +-- unison-src/transcripts/update-on-conflict.md | 13 +++++----- .../transcripts/update-on-conflict.output.md | 10 +++---- 10 files changed, 59 insertions(+), 64 deletions(-) diff --git a/unison-src/transcripts/ability-term-conflicts-on-update.md b/unison-src/transcripts/ability-term-conflicts-on-update.md index 04810a4939..6a1a316a50 100644 --- a/unison-src/transcripts/ability-term-conflicts-on-update.md +++ b/unison-src/transcripts/ability-term-conflicts-on-update.md @@ -3,7 +3,7 @@ https://github.com/unisonweb/unison/issues/2786 ```ucm:hide -.ns> builtins.merge +scratch/main> builtins.merge lib.builtins ``` First we add an ability to the codebase. @@ -15,7 +15,7 @@ unique ability Channels where ``` ```ucm -.ns> add +scratch/main> add ``` Now we update the ability, changing the name of the constructor, _but_, we simultaneously @@ -36,8 +36,8 @@ thing _ = send 1 These should fail with a term/ctor conflict since we exclude the ability from the update. ```ucm:error -.ns> update.old patch Channels.send -.ns> update.old patch thing +scratch/main> update.old patch Channels.send +scratch/main> update.old patch thing ``` If however, `Channels.send` and `thing` _depend_ on `Channels`, updating them should succeed since it pulls in the ability as a dependency. @@ -56,20 +56,20 @@ thing _ = send 1 These updates should succeed since `Channels` is a dependency. ```ucm -.ns> update.old.preview patch Channels.send -.ns> update.old.preview patch thing +scratch/main> update.old.preview patch Channels.send +scratch/main> update.old.preview patch thing ``` We should also be able to successfully update the whole thing. ```ucm -.ns> update.old +scratch/main> update.old ``` # Constructor-term conflict ```ucm:hide -.ns2> builtins.merge +scratch/main2> builtins.merge lib.builtins ``` @@ -78,7 +78,7 @@ X.x = 1 ``` ```ucm -.ns2> add +scratch/main2> add ``` ```unison @@ -89,5 +89,5 @@ structural ability X where This should fail with a ctor/term conflict. ```ucm:error -.ns2> add +scratch/main2> add ``` diff --git a/unison-src/transcripts/ability-term-conflicts-on-update.output.md b/unison-src/transcripts/ability-term-conflicts-on-update.output.md index 901446e8d4..7ea11e01c0 100644 --- a/unison-src/transcripts/ability-term-conflicts-on-update.output.md +++ b/unison-src/transcripts/ability-term-conflicts-on-update.output.md @@ -24,7 +24,7 @@ unique ability Channels where ``` ```ucm -.ns> add +scratch/main> add ⍟ I've added these definitions: @@ -68,7 +68,7 @@ thing _ = send 1 These should fail with a term/ctor conflict since we exclude the ability from the update. ```ucm -.ns> update.old patch Channels.send +scratch/main> update.old patch Channels.send x These definitions failed: @@ -77,7 +77,7 @@ These should fail with a term/ctor conflict since we exclude the ability from th Tip: Use `help filestatus` to learn more. -.ns> update.old patch thing +scratch/main> update.old patch thing ⍟ I've added these definitions: @@ -122,7 +122,7 @@ thing _ = send 1 These updates should succeed since `Channels` is a dependency. ```ucm -.ns> update.old.preview patch Channels.send +scratch/main> update.old.preview patch Channels.send I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would @@ -135,7 +135,7 @@ These updates should succeed since `Channels` is a dependency. Channels.send : a ->{Channels} () -.ns> update.old.preview patch thing +scratch/main> update.old.preview patch thing I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would @@ -153,7 +153,7 @@ These updates should succeed since `Channels` is a dependency. We should also be able to successfully update the whole thing. ```ucm -.ns> update.old +scratch/main> update.old ⊡ Ignored previously added definitions: Channels @@ -183,7 +183,7 @@ X.x = 1 ``` ```ucm -.ns2> add +scratch/main2> add ⍟ I've added these definitions: @@ -215,7 +215,7 @@ structural ability X where This should fail with a ctor/term conflict. ```ucm -.ns2> add +scratch/main2> add x These definitions failed: diff --git a/unison-src/transcripts/higher-rank.md b/unison-src/transcripts/higher-rank.md index 6645e456aa..bf9efcf678 100644 --- a/unison-src/transcripts/higher-rank.md +++ b/unison-src/transcripts/higher-rank.md @@ -19,8 +19,8 @@ f id = (id 1, id "hi") Another example, involving abilities. Here the ability-polymorphic function is instantiated with two different ability lists, `{}` and `{IO}`: ```unison -f : (forall a g . '{g} a -> '{g} a) -> () -> () -f id _ = +f : (forall a g . '{g} a -> '{g} a) -> () -> () +f id _ = _ = (id ('1 : '{} Nat), id ('("hi") : '{IO} Text)) () ``` @@ -34,17 +34,17 @@ Functor.map : Functor f -> (forall a b . (a -> b) -> f a -> f b) Functor.map = cases Functor f -> f Functor.blah : Functor f -> () -Functor.blah = cases Functor f -> +Functor.blah = cases Functor f -> g : forall a b . (a -> b) -> f a -> f b g = f () ``` -This example is similar, but involves abilities: +This example is similar, but involves abilities: ```unison unique ability Remote t where doRemoteStuff : t () -unique type Loc = Loc (forall t a . '{Remote t} a ->{Remote t} t a) +unique type Loc = Loc (forall t a . '{Remote t} a ->{Remote t} t a) Loc.blah : Loc -> () Loc.blah = cases Loc f -> @@ -52,20 +52,20 @@ Loc.blah = cases Loc f -> f0 = f () --- In this case, no annotation is needed since the lambda +-- In this case, no annotation is needed since the lambda -- is checked against a polymorphic type -Loc.transform : (forall t a . '{Remote t} a -> '{Remote t} a) +Loc.transform : (forall t a . '{Remote t} a -> '{Remote t} a) -> Loc -> Loc Loc.transform nt = cases Loc f -> Loc (a -> f (nt a)) -- In this case, the annotation is needed since f' is inferred -- on its own it won't infer the higher-rank type -Loc.transform2 : (forall t a . '{Remote t} a -> '{Remote t} a) +Loc.transform2 : (forall t a . '{Remote t} a -> '{Remote t} a) -> Loc -> Loc -Loc.transform2 nt = cases Loc f -> +Loc.transform2 nt = cases Loc f -> f' : forall t a . '{Remote t} a ->{Remote t} t a f' a = f (nt a) - Loc f' + Loc f' ``` ## Types with polymorphic fields @@ -77,6 +77,6 @@ structural type HigherRanked = HigherRanked (forall a. a -> a) We should be able to add and view records with higher-rank fields. ```ucm -.higher_ranked> add -.higher_ranked> view HigherRanked +scratch/main> add +scratch/main> view HigherRanked ``` diff --git a/unison-src/transcripts/higher-rank.output.md b/unison-src/transcripts/higher-rank.output.md index a64a48ae39..2054583f63 100644 --- a/unison-src/transcripts/higher-rank.output.md +++ b/unison-src/transcripts/higher-rank.output.md @@ -33,8 +33,8 @@ f id = (id 1, id "hi") Another example, involving abilities. Here the ability-polymorphic function is instantiated with two different ability lists, `{}` and `{IO}`: ```unison -f : (forall a g . '{g} a -> '{g} a) -> () -> () -f id _ = +f : (forall a g . '{g} a -> '{g} a) -> () -> () +f id _ = _ = (id ('1 : '{} Nat), id ('("hi") : '{IO} Text)) () ``` @@ -61,7 +61,7 @@ Functor.map : Functor f -> (forall a b . (a -> b) -> f a -> f b) Functor.map = cases Functor f -> f Functor.blah : Functor f -> () -Functor.blah = cases Functor f -> +Functor.blah = cases Functor f -> g : forall a b . (a -> b) -> f a -> f b g = f () @@ -83,11 +83,11 @@ Functor.blah = cases Functor f -> -> (∀ a b. (a -> b) -> f a -> f b) ``` -This example is similar, but involves abilities: +This example is similar, but involves abilities: ```unison unique ability Remote t where doRemoteStuff : t () -unique type Loc = Loc (forall t a . '{Remote t} a ->{Remote t} t a) +unique type Loc = Loc (forall t a . '{Remote t} a ->{Remote t} t a) Loc.blah : Loc -> () Loc.blah = cases Loc f -> @@ -95,20 +95,20 @@ Loc.blah = cases Loc f -> f0 = f () --- In this case, no annotation is needed since the lambda +-- In this case, no annotation is needed since the lambda -- is checked against a polymorphic type -Loc.transform : (forall t a . '{Remote t} a -> '{Remote t} a) +Loc.transform : (forall t a . '{Remote t} a -> '{Remote t} a) -> Loc -> Loc Loc.transform nt = cases Loc f -> Loc (a -> f (nt a)) -- In this case, the annotation is needed since f' is inferred -- on its own it won't infer the higher-rank type -Loc.transform2 : (forall t a . '{Remote t} a -> '{Remote t} a) +Loc.transform2 : (forall t a . '{Remote t} a -> '{Remote t} a) -> Loc -> Loc -Loc.transform2 nt = cases Loc f -> +Loc.transform2 nt = cases Loc f -> f' : forall t a . '{Remote t} a ->{Remote t} t a f' a = f (nt a) - Loc f' + Loc f' ``` ```ucm @@ -141,15 +141,13 @@ structural type HigherRanked = HigherRanked (forall a. a -> a) We should be able to add and view records with higher-rank fields. ```ucm - ☝️ The namespace .higher_ranked is empty. - -.higher_ranked> add +scratch/main> add ⍟ I've added these definitions: structural type HigherRanked -.higher_ranked> view HigherRanked +scratch/main> view HigherRanked structural type HigherRanked = HigherRanked (∀ a. a -> a) diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 66f2497e82..6dfb48d04e 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -4,8 +4,8 @@ The `merge` command merges together two branches in the same project: the curren branch. For example, to merge `topic` into `main`, switch to `main` and run `merge topic`: ```ucm:error -.> help merge -.> help merge.commit +scratch/main> help merge +scratch/main> help merge.commit ``` Let's see a simple unconflicted merge in action: Alice (us) and Bob (them) add different terms. The merged result diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 258413502d..625441f613 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -4,12 +4,12 @@ The `merge` command merges together two branches in the same project: the curren branch. For example, to merge `topic` into `main`, switch to `main` and run `merge topic`: ```ucm -.> help merge +scratch/main> help merge merge `merge /branch` merges `branch` into the current branch -.> help merge.commit +scratch/main> help merge.commit merge.commit (or commit.merge) `merge.commit` merges a temporary branch created by the `merge` diff --git a/unison-src/transcripts/resolution-failures.md b/unison-src/transcripts/resolution-failures.md index f6f0b0a4ad..eff751b4a4 100644 --- a/unison-src/transcripts/resolution-failures.md +++ b/unison-src/transcripts/resolution-failures.md @@ -15,7 +15,7 @@ two.ambiguousTerm = "term two" ``` ```ucm -.example.resolution_failures> add +scratch/main> add ``` ## Tests diff --git a/unison-src/transcripts/resolution-failures.output.md b/unison-src/transcripts/resolution-failures.output.md index 352e2f1c20..bca703a4e5 100644 --- a/unison-src/transcripts/resolution-failures.output.md +++ b/unison-src/transcripts/resolution-failures.output.md @@ -31,9 +31,7 @@ two.ambiguousTerm = "term two" ``` ```ucm - ☝️ The namespace .example.resolution_failures is empty. - -.example.resolution_failures> add +scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/update-on-conflict.md b/unison-src/transcripts/update-on-conflict.md index 73a699cafb..e36c20fdff 100644 --- a/unison-src/transcripts/update-on-conflict.md +++ b/unison-src/transcripts/update-on-conflict.md @@ -3,8 +3,7 @@ Updating conflicted definitions works fine. ```ucm:hide -.> builtins.merge -.merged> builtins.merge +scratch/main> builtins.merge lib.builtins ``` ```unison @@ -13,9 +12,9 @@ temp = 2 ``` ```ucm -.> add -.> debug.alias.term.force temp x -.> delete.term temp +scratch/main> add +scratch/main> debug.alias.term.force temp x +scratch/main> delete.term temp ``` ```unison @@ -23,6 +22,6 @@ x = 3 ``` ```ucm -.> update -.> view x +scratch/main> update +scratch/main> view x ``` diff --git a/unison-src/transcripts/update-on-conflict.output.md b/unison-src/transcripts/update-on-conflict.output.md index f5e8e484f6..ce48e5f6c8 100644 --- a/unison-src/transcripts/update-on-conflict.output.md +++ b/unison-src/transcripts/update-on-conflict.output.md @@ -22,18 +22,18 @@ temp = 2 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: temp : Nat x : Nat -.> debug.alias.term.force temp x +scratch/main> debug.alias.term.force temp x Done. -.> delete.term temp +scratch/main> delete.term temp Done. @@ -57,14 +57,14 @@ x = 3 ``` ```ucm -.> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. -.> view x +scratch/main> view x x : Nat x = 3 From 0b8548f36c6e892ec13ec3524a16aa4c35082e19 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 27 Jun 2024 15:01:58 -0700 Subject: [PATCH 339/631] Delete some out of date bits of transcripts --- unison-src/transcripts/cycle-update-5.md | 34 --- .../transcripts/cycle-update-5.output.md | 82 ------ unison-src/transcripts/fix2254.output.md | 248 +++++++++--------- unison-src/transcripts/propagate.md | 44 ---- unison-src/transcripts/propagate.output.md | 239 ++++++----------- 5 files changed, 205 insertions(+), 442 deletions(-) delete mode 100644 unison-src/transcripts/cycle-update-5.md delete mode 100644 unison-src/transcripts/cycle-update-5.output.md diff --git a/unison-src/transcripts/cycle-update-5.md b/unison-src/transcripts/cycle-update-5.md deleted file mode 100644 index 60d283d55a..0000000000 --- a/unison-src/transcripts/cycle-update-5.md +++ /dev/null @@ -1,34 +0,0 @@ -Not yet working: properly updating nameless implicit terms. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -inner.ping : 'Nat -inner.ping _ = !pong + 1 - -pong : 'Nat -pong _ = !inner.ping + 2 -``` - -```ucm -scratch/main> add -``` - -Here we queue up an update by saving in a namespace where `inner.ping` and `pong` both have names, but then apply the -update in a namespace where only `ping` has a name. - -```unison -inner.ping : 'Nat -inner.ping _ = !pong + 3 -``` - -```ucm -.inner> update.old -scratch/main> view inner.ping -``` - -The bug here is that `inner.ping` still refers to `pong` by name. But if we properly identified the nameless (in the -context that the update was applied) `pong` as an implicit term to include in the new `ping`'s cycle, then `ping` would -be left referring to a nameless thing (namely, `pong`, but updated to refer to the new `ping`). diff --git a/unison-src/transcripts/cycle-update-5.output.md b/unison-src/transcripts/cycle-update-5.output.md deleted file mode 100644 index a42ccbde5f..0000000000 --- a/unison-src/transcripts/cycle-update-5.output.md +++ /dev/null @@ -1,82 +0,0 @@ -Not yet working: properly updating nameless implicit terms. - -```unison -inner.ping : 'Nat -inner.ping _ = !pong + 1 - -pong : 'Nat -pong _ = !inner.ping + 2 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - inner.ping : 'Nat - pong : 'Nat - -``` -```ucm -scratch/main> add - - ⍟ I've added these definitions: - - inner.ping : 'Nat - pong : 'Nat - -``` -Here we queue up an update by saving in a namespace where `inner.ping` and `pong` both have names, but then apply the -update in a namespace where only `ping` has a name. - -```unison -inner.ping : 'Nat -inner.ping _ = !pong + 3 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These names already exist. You can `update` them to your - new definition: - - inner.ping : 'Nat - -``` -```ucm - ☝️ The namespace .inner is empty. - -.inner> update.old - - ⍟ I've added these definitions: - - inner.ping : '##Nat - -scratch/main> view inner.ping - -<<<<<<< Conflict 1 of 1 -%%%%%%% Changes from base to side #1 - inner.ping : 'Nat - inner.ping _ = - use Nat + -- !pong + 1 -+ pong() + 1 -+++++++ Contents of side #2 - inner.inner.ping : '##Nat - inner.inner.ping _ = ##Nat.+ !#4t465jk908 3 ->>>>>>> Conflict 1 of 1 ends - -``` -The bug here is that `inner.ping` still refers to `pong` by name. But if we properly identified the nameless (in the -context that the update was applied) `pong` as an implicit term to include in the new `ping`'s cycle, then `ping` would -be left referring to a nameless thing (namely, `pong`, but updated to refer to the new `ping). diff --git a/unison-src/transcripts/fix2254.output.md b/unison-src/transcripts/fix2254.output.md index fa593731ba..62c83c2fa9 100644 --- a/unison-src/transcripts/fix2254.output.md +++ b/unison-src/transcripts/fix2254.output.md @@ -37,7 +37,7 @@ We'll make our edits in a new branch. scratch/a> add ⍟ I've added these definitions: - + type A a b c d structural type NeedsA a b f : A Nat Nat Nat Nat -> Nat @@ -70,84 +70,95 @@ Let's do the update now, and verify that the definitions all look good and there scratch/a2> update.old ⍟ I've updated these names to your new definition: - + type A a b c d scratch/a2> view A NeedsA f f2 f3 g -<<<<<<< Conflict 1 of 5 -%%%%%%% Changes from base to side #1 - type A a b c d -- = B b -+ = A a - | D d - | E a d -+ | B b - | C c -- | A a - - structural type NeedsA a b -- = Zoink Text -- | NeedsA (A a b Nat Nat) -+ = NeedsA (A a b Nat Nat) -+ | Zoink Text - - f : A Nat Nat Nat Nat -> Nat - f = cases - A n -> n - _ -> 42 - - f2 : A Nat Nat Nat Nat -> Nat - f2 a = - use Nat + - n = f a - n + 1 - - f3 : NeedsA Nat Nat -> Nat - f3 = cases - NeedsA a -> f a Nat.+ 20 - _ -> 0 - - g : A Nat Nat Nat Nat -> Nat - g = cases - D n -> n - _ -> 43 -+++++++ Contents of side #2 - type A a b c d = B b | D d | E a d | C c | A a ->>>>>>> Conflict 1 of 5 ends - -<<<<<<< Conflict 2 of 5 -+++++++ Contents of side #1 + type A a b c d + = A a + | D d + | E a d + | B b + | C c + + structural type NeedsA a b + = NeedsA (A a b Nat Nat) + | Zoink Text + + f : #re3rf9cedk Nat Nat Nat Nat -> Nat + f = cases + #re3rf9cedk#1 n -> n + _ -> 42 + + f2 : #re3rf9cedk Nat Nat Nat Nat -> Nat + f2 a = + use Nat + + n = f a + n + 1 + + f3 : #oftm6ao9vp Nat Nat -> Nat + f3 = cases + #oftm6ao9vp#0 a -> f a Nat.+ 20 + _ -> 0 + + g : #re3rf9cedk Nat Nat Nat Nat -> Nat + g = cases + #re3rf9cedk#0 n -> n + _ -> 43 + scratch/a2> todo -%%%%%%% Changes from base to side #2 --.a2> todo -+ ⚠️ ->>>>>>> Conflict 2 of 5 ends - - The following names were not found in the codebase. Check your spelling. - NeedsA - f - f2 - f3 - g + These types do not have any names in the current namespace: + + 1. #oftm6ao9vp + 2. #re3rf9cedk + +``` +## Record updates + +Here's a test of updating a record: + +```unison +structural type Rec = { uno : Nat, dos : Nat } + +combine r = uno r + dos r ``` ```ucm -.a2> update.old.a2> view A NeedsA f f2 f3 g.a2> todo + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + structural type Rec + Rec.dos : Rec -> Nat + Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.dos.set : Nat -> Rec -> Rec + Rec.uno : Rec -> Nat + Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.uno.set : Nat -> Rec -> Rec + combine : Rec -> Nat + ``` -<<<<<<< Conflict 3 of 5 -+++++++ Contents of side #1 ```ucm scratch/r1> add -%%%%%%% Changes from base to side #2 --```ucm --.a3> add ->>>>>>> Conflict 3 of 5 ends + ⍟ I've added these definitions: + + structural type Rec + Rec.dos : Rec -> Nat + Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.dos.set : Nat -> Rec -> Rec + Rec.uno : Rec -> Nat + Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.uno.set : Nat -> Rec -> Rec + combine : Rec -> Nat -<<<<<<< Conflict 4 of 5 -+++++++ Contents of side #1 scratch/r1> branch r2 Done. I've created the r2 branch based off of r1. @@ -159,57 +170,56 @@ scratch/r1> branch r2 ```unison structural type Rec = { uno : Nat, dos : Nat, tres : Text } ``` -%%%%%%% Changes from base to side #2 --``` --```unison --structural type Rec = { uno : Nat, dos : Nat, tres : Text } --``` -+🛑 ->>>>>>> Conflict 4 of 5 ends - -The transcript failed due to an error in the stanza above. The error is: - - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - NeedsA - f - f2 - f3 - g - -<<<<<<< Conflict 5 of 5 -%%%%%%% Changes from base to side #1 - ```ucm --.> fork a3 a4 -+scratch/r2> update.old - -- Done. -- --.a4> update.old -- - ⍟ I've added these definitions: - - Rec.tres : Rec -> Text - Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec - Rec.tres.set : Text -> Rec -> Rec - - ⍟ I've updated these names to your new definition: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec - --.a4> todo -+scratch/r2> todo - - - - ``` -+++++++ Contents of side #2 ->>>>>>> Conflict 5 of 5 ends + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + Rec.tres : Rec -> Text + Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec + Rec.tres.set : Text -> Rec -> Rec + + ⍟ These names already exist. You can `update` them to your + new definition: + + structural type Rec + Rec.dos : Rec -> Nat + Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.dos.set : Nat -> Rec -> Rec + Rec.uno : Rec -> Nat + Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.uno.set : Nat -> Rec -> Rec + +``` +And checking that after updating this record, there's nothing `todo`: + +```ucm +scratch/r2> update.old + + ⍟ I've added these definitions: + + Rec.tres : Rec -> Text + Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec + Rec.tres.set : Text -> Rec -> Rec + + ⍟ I've updated these names to your new definition: + + structural type Rec + Rec.dos : Rec -> Nat + Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.dos.set : Nat -> Rec -> Rec + Rec.uno : Rec -> Nat + Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.uno.set : Nat -> Rec -> Rec + +scratch/r2> todo + + + +``` diff --git a/unison-src/transcripts/propagate.md b/unison-src/transcripts/propagate.md index b5eaf3ede2..19576d8bb8 100644 --- a/unison-src/transcripts/propagate.md +++ b/unison-src/transcripts/propagate.md @@ -78,47 +78,3 @@ type of `otherTerm` should remain the same. scratch/main> view preserve.someTerm scratch/main> view preserve.otherTerm ``` - -### Propagation only applies to the local branch - -Cleaning up a bit... - -```ucm -.subpath.lib> builtins.merge -``` - -Now, we make two terms, where one depends on the other. - -```unison -one.someTerm : Optional foo -> Optional foo -one.someTerm x = x - -one.otherTerm : Optional baz -> Optional baz -one.otherTerm y = someTerm y -``` - -We'll make two copies of this namespace. - -```ucm -.subpath> add -.subpath> fork one two -``` - -Now let's edit one of the terms... - -```unison -someTerm : Optional x -> Optional x -someTerm _ = None -``` - -... in one of the namespaces... - -```ucm -.subpath.one> update.old -``` - -The other namespace should be left alone. - -```ucm -.subpath> view two.someTerm -``` diff --git a/unison-src/transcripts/propagate.output.md b/unison-src/transcripts/propagate.output.md index 10f159d2a9..694b99cd03 100644 --- a/unison-src/transcripts/propagate.output.md +++ b/unison-src/transcripts/propagate.output.md @@ -87,178 +87,91 @@ scratch/main> update.old ```ucm scratch/main> view fooToInt - ⚠️ + fooToInt : Foo -> Int + fooToInt _ = +42 + +``` +### Preserving user type variables + +We make a term that has a dependency on another term and also a non-redundant +user-provided type signature. + +```unison +preserve.someTerm : Optional foo -> Optional foo +preserve.someTerm x = x + +preserve.otherTerm : Optional baz -> Optional baz +preserve.otherTerm y = someTerm y +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: - The following names were not found in the codebase. Check your spelling. - fooToInt + ⍟ These new definitions are ok to `add`: + + preserve.otherTerm : Optional baz -> Optional baz + preserve.someTerm : Optional foo -> Optional foo ``` +Add that to the codebase: -<<<<<<< Conflict 1 of 2 -+++++++ Contents of side #1 ```ucm scratch/main> add -%%%%%%% Changes from base to side #2 --```ucm --.subpath> add ->>>>>>> Conflict 1 of 2 ends + ⍟ I've added these definitions: + + preserve.otherTerm : Optional baz -> Optional baz + preserve.someTerm : Optional foo -> Optional foo -🛑 +``` +Let's now edit the dependency: + +```unison +preserve.someTerm : Optional x -> Optional x +preserve.someTerm _ = None +``` -The transcript failed due to an error in the stanza above. The error is: +```ucm + Loading changes detected in scratch.u. - ⚠️ + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: - The following names were not found in the codebase. Check your spelling. - fooToInt - -<<<<<<< Conflict 2 of 2 -%%%%%%% Changes from base to side #1 - ``` - Let's now edit the dependency: - - ```unison - preserve.someTerm : Optional x -> Optional x - preserve.someTerm _ = None - ``` - - ```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These names already exist. You can `update` them to your - new definition: - - preserve.someTerm : Optional x -> Optional x - - ``` - Update... - - ```ucm --.subpath> update.old -+scratch/main> update.old - - ⍟ I've updated these names to your new definition: - - preserve.someTerm : Optional x -> Optional x - - ``` - Now the type of `someTerm` should be `Optional x -> Optional x` and the - type of `otherTerm` should remain the same. - - ```ucm --.subpath> view preserve.someTerm -+scratch/main> view preserve.someTerm - - preserve.someTerm : Optional x -> Optional x - preserve.someTerm _ = None - --.subpath> view preserve.otherTerm -+scratch/main> view preserve.otherTerm - - preserve.otherTerm : Optional baz -> Optional baz - preserve.otherTerm y = someTerm y - - ``` - ### Propagation only applies to the local branch - - Cleaning up a bit... - - ```ucm --.> delete.namespace subpath -- -- Done. -- - ☝️ The namespace .subpath.lib is empty. - - .subpath.lib> builtins.merge - - Done. - - ``` - Now, we make two terms, where one depends on the other. - - ```unison - one.someTerm : Optional foo -> Optional foo - one.someTerm x = x - - one.otherTerm : Optional baz -> Optional baz - one.otherTerm y = someTerm y - ``` - - ```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - one.otherTerm : Optional baz -> Optional baz - one.someTerm : Optional foo -> Optional foo - - ``` - We'll make two copies of this namespace. - - ```ucm - .subpath> add - - ⍟ I've added these definitions: - - one.otherTerm : Optional baz -> Optional baz - one.someTerm : Optional foo -> Optional foo - - .subpath> fork one two - - Done. - - ``` - Now let's edit one of the terms... - - ```unison - someTerm : Optional x -> Optional x - someTerm _ = None - ``` - - ```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - someTerm : Optional x -> Optional x - - ``` - ... in one of the namespaces... - - ```ucm - .subpath.one> update.old - - ⍟ I've updated these names to your new definition: - - someTerm : #nirp5os0q6 x -> #nirp5os0q6 x - - ``` - The other namespace should be left alone. - - ```ucm - .subpath> view two.someTerm - - two.someTerm : Optional foo -> Optional foo - two.someTerm x = x - - ``` -+++++++ Contents of side #2 ->>>>>>> Conflict 2 of 2 ends + ⍟ These names already exist. You can `update` them to your + new definition: + + preserve.someTerm : Optional x -> Optional x + +``` +Update... + +```ucm +scratch/main> update.old + + ⍟ I've updated these names to your new definition: + + preserve.someTerm : Optional x -> Optional x + +``` +Now the type of `someTerm` should be `Optional x -> Optional x` and the +type of `otherTerm` should remain the same. + +```ucm +scratch/main> view preserve.someTerm + + preserve.someTerm : Optional x -> Optional x + preserve.someTerm _ = None + +scratch/main> view preserve.otherTerm + + preserve.otherTerm : Optional baz -> Optional baz + preserve.otherTerm y = someTerm y + +``` From 38d60e7e6ef9e199f8d28df6dd9207e56e8b8aef Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 27 Jun 2024 15:23:29 -0700 Subject: [PATCH 340/631] Switch project before deleting it --- .../codebase-sqlite/U/Codebase/Sqlite/Queries.hs | 4 ++-- parser-typechecker/src/Unison/Codebase.hs | 11 +++++++---- .../Codebase/Editor/HandleInput/DeleteBranch.hs | 2 +- 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index bbe067e8c4..b7f184e0e0 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3797,7 +3797,7 @@ loadProjectAndBranchNames projectId branchId = |] -- | Insert a project branch. -insertProjectBranch :: HasCallStack => Text -> CausalHashId -> ProjectBranch -> Transaction () +insertProjectBranch :: (HasCallStack) => Text -> CausalHashId -> ProjectBranch -> Transaction () insertProjectBranch description causalHashId (ProjectBranch projectId branchId branchName maybeParentBranchId) = do -- Ensure we never point at a causal we don't have the branch for. _ <- expectBranchObjectIdByCausalHashId causalHashId @@ -4411,7 +4411,7 @@ data JsonParseFailure = JsonParseFailure deriving anyclass (SqliteExceptionReason) -- | Get the most recent namespace the user has visited. -expectCurrentProjectPath :: HasCallStack => Transaction (ProjectId, ProjectBranchId, [NameSegment]) +expectCurrentProjectPath :: (HasCallStack) => Transaction (ProjectId, ProjectBranchId, [NameSegment]) expectCurrentProjectPath = queryOneRowCheck [sql| diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index ee09f07cbd..b0bbdbfb9c 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -391,9 +391,12 @@ typeLookupForDependencies codebase s = do unseen :: TL.TypeLookup Symbol a -> Reference -> Bool unseen tl r = isNothing - ( Map.lookup r (TL.dataDecls tl) $> () - <|> Map.lookup r (TL.typeOfTerms tl) $> () - <|> Map.lookup r (TL.effectDecls tl) $> () + ( Map.lookup r (TL.dataDecls tl) + $> () + <|> Map.lookup r (TL.typeOfTerms tl) + $> () + <|> Map.lookup r (TL.effectDecls tl) + $> () ) toCodeLookup :: (MonadIO m) => Codebase m Symbol Parser.Ann -> CL.CodeLookup Symbol m Parser.Ann @@ -554,7 +557,7 @@ unsafeGetTermComponent codebase hash = Nothing -> error (reportBug "E769004" ("term component " ++ show hash ++ " not found")) Just terms -> terms -expectCurrentProjectPath :: HasCallStack => Sqlite.Transaction PP.ProjectPath +expectCurrentProjectPath :: (HasCallStack) => Sqlite.Transaction PP.ProjectPath expectCurrentProjectPath = do (projectId, projectBranchId, path) <- Q.expectCurrentProjectPath proj <- Q.expectProject projectId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs index 4501d0d453..0926417587 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs @@ -29,7 +29,6 @@ handleDeleteBranch :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> handleDeleteBranch projectAndBranchNamesToDelete = do ProjectPath currentProject currentBranch _ <- Cli.getCurrentProjectPath projectAndBranchToDelete@(ProjectAndBranch _projectToDelete branchToDelete) <- ProjectUtils.resolveProjectBranchInProject currentProject (projectAndBranchNamesToDelete & #branch %~ Just) - doDeleteProjectBranch projectAndBranchToDelete -- If the user is on the branch that they're deleting, we have to cd somewhere; try these in order: -- @@ -49,6 +48,7 @@ handleDeleteBranch projectAndBranchNamesToDelete = do ] nextLoc <- mayNextLocation `whenNothing` projectCreate False Nothing Cli.switchProject nextLoc + doDeleteProjectBranch projectAndBranchToDelete where parentBranch :: ProjectId -> Maybe ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) parentBranch projectId mayParentBranchId = do From fce12cb8b7024d80a9ef6b40fac89cca3df08529 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 27 Jun 2024 15:23:29 -0700 Subject: [PATCH 341/631] Work on fixing some transcripts for projects --- .../012-add-current-project-path-table.sql | 2 + .../transcripts/api-doc-rendering.output.md | 803 +----------------- unison-src/transcripts/api-find.output.md | 224 +---- .../transcripts/api-getDefinition.output.md | 502 +---------- .../api-namespace-details.output.md | 52 +- .../transcripts/api-namespace-list.output.md | 110 +-- .../transcripts/api-summaries.output.md | 796 +---------------- .../branch-relative-path.output.md | 33 +- .../transcripts/delete-namespace.output.md | 36 +- unison-src/transcripts/delete-project.md | 1 + .../transcripts/delete-project.output.md | 20 +- .../transcripts/empty-namespaces.output.md | 7 +- unison-src/transcripts/reset.output.md | 178 +--- .../transcripts/upgrade-sad-path.output.md | 3 +- 14 files changed, 127 insertions(+), 2640 deletions(-) diff --git a/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql b/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql index 63b3d07559..8de5f05169 100644 --- a/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql +++ b/codebase2/codebase-sqlite/sql/012-add-current-project-path-table.sql @@ -8,6 +8,8 @@ CREATE TABLE current_project_path ( foreign key (project_id, branch_id) references project_branch (project_id, branch_id) + -- Prevent deleting the project you're currently in. + on delete no action ) WITHOUT ROWID; DROP TABLE most_recent_namespace; diff --git a/unison-src/transcripts/api-doc-rendering.output.md b/unison-src/transcripts/api-doc-rendering.output.md index f767c14cf7..6c0d09729a 100644 --- a/unison-src/transcripts/api-doc-rendering.output.md +++ b/unison-src/transcripts/api-doc-rendering.output.md @@ -148,796 +148,13 @@ scratch/main> display term.doc ``` ```api GET /api/projects/scratch/branches/main/getDefinition?names=term -{ - "missingDefinitions": [], - "termDefinitions": { - "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { - "bestTermName": "term", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "42" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doc", - "#kjfaflbrgl89j2uq4ruubejakm6s02cp3m61ufu7rv7tkbd4nmkvcn1fciue53v0msir9t7ds111ab9er8qfa06gsa9ddfrdfgc99mo", - { - "contents": [ - { - "contents": [ - { - "contents": "Heading", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - [ - { - "contents": [ - { - "contents": [ - { - "contents": "Heading", - "tag": "Word" - }, - { - "contents": "2", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - [ - { - "contents": [ - { - "contents": "Term", - "tag": "Word" - }, - { - "contents": "Link:", - "tag": "Word" - }, - { - "contents": { - "contents": [ - { - "annotation": { - "contents": "#k5gpql9cbdfau6lf1aja24joc3sfctvjor8esu8bemn0in3l148otb0t3vebgqrt6qml302h62bbfeftg65gec1v8ouin5m6v2969d8", - "tag": "TermReference" - }, - "segment": "otherTerm" - } - ], - "tag": "Link" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Type", - "tag": "Word" - }, - { - "contents": "Link:", - "tag": "Word" - }, - { - "contents": { - "contents": [ - { - "annotation": { - "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", - "tag": "TypeReference" - }, - "segment": "Maybe" - } - ], - "tag": "Link" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Term", - "tag": "Word" - }, - { - "contents": "source:", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": [ - "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - { - "contents": [ - [ - { - "annotation": { - "contents": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "tag": "TermReference" - }, - "segment": "term" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": ": " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - [ - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "42" - } - ] - ], - "tag": "UserObject" - } - ], - "tag": "Term" - } - ], - "tag": "Source" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Term", - "tag": "Word" - }, - { - "contents": "signature:", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - [ - { - "annotation": { - "contents": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "tag": "TermReference" - }, - "segment": "term" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": ": " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ] - ], - "tag": "Signature" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": [ - { - "contents": "List", - "tag": "Word" - }, - { - "contents": "item", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ], - "tag": "BulletedList" - }, - { - "contents": [ - 1, - [ - { - "contents": [ - { - "contents": "Numbered", - "tag": "Word" - }, - { - "contents": "list", - "tag": "Word" - }, - { - "contents": "item", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "tag": "NumberedList" - }, - { - "contents": [ - { - "contents": ">", - "tag": "Word" - }, - { - "contents": "Block", - "tag": "Word" - }, - { - "contents": "quote", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Code", - "tag": "Word" - }, - { - "contents": "block", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Inline", - "tag": "Word" - }, - { - "contents": "code:", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "1" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat.+", - "tag": "TermReference" - }, - "segment": "Nat.+" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "2" - } - ], - "tag": "Example" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": "\"doesn't typecheck\" + 1", - "tag": "Word" - }, - "tag": "Code" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": [ - { - "contents": [ - { - "contents": "Link", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": { - "contents": "https://unison-lang.org", - "tag": "Word" - }, - "tag": "Group" - } - ], - "tag": "NamedLink" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png)", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": "Bold", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - "tag": "Bold" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": "Italic", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - "tag": "Bold" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": "Strikethrough", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - "tag": "Strikethrough" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Horizontal", - "tag": "Word" - }, - { - "contents": "rule", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "---", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Table", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Header", - "tag": "Word" - }, - { - "contents": "1", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Header", - "tag": "Word" - }, - { - "contents": "2", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "--------", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "--------", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Cell", - "tag": "Word" - }, - { - "contents": "1", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Cell", - "tag": "Word" - }, - { - "contents": "2", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Cell", - "tag": "Word" - }, - { - "contents": "3", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Cell", - "tag": "Word" - }, - { - "contents": "4", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Video", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - [ - { - "mediaSourceMimeType": null, - "mediaSourceUrl": "test.mp4" - } - ], - { - "poster": "test.png" - } - ], - "tag": "Video" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Transclusion/evaluation:", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": [ - { - "contents": [ - { - "contents": "This", - "tag": "Word" - }, - { - "contents": "doc", - "tag": "Word" - }, - { - "contents": "should", - "tag": "Word" - }, - { - "contents": "be", - "tag": "Word" - }, - { - "contents": "embedded.", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "message", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ], - "tag": "UntitledSection" - } - ], - "tag": "Paragraph" - } - ] - ], - "tag": "Section" - } - ] - ], - "tag": "Section" - } - ] - ], - "termNames": [ - "term" - ] - } - }, - "typeDefinitions": {} -} -``` \ No newline at end of file + +``` + + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + +Error decoding response from /api/projects/scratch/branches/main/getDefinition?names=term: Error in $: Failed reading: not a valid json value at 'QueryparameterrootBranchisrequired' diff --git a/unison-src/transcripts/api-find.output.md b/unison-src/transcripts/api-find.output.md index d44200e7a2..1c2a3bd8ab 100644 --- a/unison-src/transcripts/api-find.output.md +++ b/unison-src/transcripts/api-find.output.md @@ -37,219 +37,23 @@ scratch/main> add ```api -- Namespace segment prefix search GET /api/projects/scratch/branches/main/find?query=http -[ - [ - { - "result": { - "segments": [ - { - "contents": "ross.", - "tag": "Gap" - }, - { - "contents": "http", - "tag": "Match" - }, - { - "contents": "Client.y", - "tag": "Gap" - } - ] - }, - "score": 156 - }, - { - "contents": { - "bestFoundTermName": "y", - "namedTerm": { - "termHash": "#emomp74i93h6ps0b5sukke0tci0ooba3f9jk21qm919a7act9u7asani84c0mqbdk4lcjrdvr9olpedp23p6df78r4trqlg0cciadc8", - "termName": "ross.httpClient.y", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - } - }, - "tag": "FoundTermResult" - } - ], - [ - { - "result": { - "segments": [ - { - "contents": "joey.", - "tag": "Gap" - }, - { - "contents": "http", - "tag": "Match" - }, - { - "contents": "Server.z", - "tag": "Gap" - } - ] - }, - "score": 156 - }, - { - "contents": { - "bestFoundTermName": "z", - "namedTerm": { - "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "joey.httpServer.z", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - } - }, - "tag": "FoundTermResult" - } - ] -] + +``` + +```api +-- Namespace segment prefix search +GET /api/projects/scratch/branches/main/find?query=http -- Namespace segment suffix search GET /api/projects/scratch/branches/main/find?query=Server -[ - [ - { - "result": { - "segments": [ - { - "contents": "joey.http", - "tag": "Gap" - }, - { - "contents": "Server", - "tag": "Match" - }, - { - "contents": ".z", - "tag": "Gap" - } - ] - }, - "score": 223 - }, - { - "contents": { - "bestFoundTermName": "z", - "namedTerm": { - "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "joey.httpServer.z", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - } - }, - "tag": "FoundTermResult" - } - ] -] -- Substring search GET /api/projects/scratch/branches/main/find?query=lesys -[ - [ - { - "result": { - "segments": [ - { - "contents": "rachel.fi", - "tag": "Gap" - }, - { - "contents": "lesys", - "tag": "Match" - }, - { - "contents": "tem.x", - "tag": "Gap" - } - ] - }, - "score": 175 - }, - { - "contents": { - "bestFoundTermName": "x", - "namedTerm": { - "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "termName": "rachel.filesystem.x", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - } - }, - "tag": "FoundTermResult" - } - ] -] -- Cross-segment search GET /api/projects/scratch/branches/main/find?query=joey.http -[ - [ - { - "result": { - "segments": [ - { - "contents": "joey.http", - "tag": "Match" - }, - { - "contents": "Server.z", - "tag": "Gap" - } - ] - }, - "score": 300 - }, - { - "contents": { - "bestFoundTermName": "z", - "namedTerm": { - "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "joey.httpServer.z", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - } - }, - "tag": "FoundTermResult" - } - ] -] -``` \ No newline at end of file +``` + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + +Error decoding response from /api/projects/scratch/branches/main/find?query=http: Error in $: Failed reading: not a valid json value at 'QueryparameterrootBranchisrequired' diff --git a/unison-src/transcripts/api-getDefinition.output.md b/unison-src/transcripts/api-getDefinition.output.md index 5e854a440c..1bb60a6603 100644 --- a/unison-src/transcripts/api-getDefinition.output.md +++ b/unison-src/transcripts/api-getDefinition.output.md @@ -8,503 +8,21 @@ nested.names.x = 42 ```api -- Should NOT find names by suffix GET /api/projects/scratch/branches/main/getDefinition?names=x -{ - "missingDefinitions": [ - "x" - ], - "termDefinitions": {}, - "typeDefinitions": {} -} + +``` + +```api +-- Should NOT find names by suffix +GET /api/projects/scratch/branches/main/getDefinition?names=x -- Term names should strip relativeTo prefix. GET /api/projects/scratch/branches/main/getDefinition?names=names.x&relativeTo=nested -{ - "missingDefinitions": [], - "termDefinitions": { - "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { - "bestTermName": "x", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "x", - "tag": "HashQualifier" - }, - "segment": "x" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "x", - "tag": "HashQualifier" - }, - "segment": "x" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "42" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doc", - "#ulr9f75rpcrv79d7sfo2ep2tvbntu3e360lfomird2bdpj4bnea230e8o5j0b9our8vggocpa7eck3pus14fcfajlttat1bg71t6rbg", - { - "contents": [ - { - "contents": "Documentation", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "termNames": [ - "nested.names.x" - ] - } - }, - "typeDefinitions": {} -} -- Should find definitions by hash, names should be relative GET /api/projects/scratch/branches/main/getDefinition?names=%23qkhkl0n238&relativeTo=nested -{ - "missingDefinitions": [], - "termDefinitions": { - "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { - "bestTermName": "x", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "x", - "tag": "HashQualifier" - }, - "segment": "x" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "x", - "tag": "HashQualifier" - }, - "segment": "x" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "42" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doc", - "#ulr9f75rpcrv79d7sfo2ep2tvbntu3e360lfomird2bdpj4bnea230e8o5j0b9our8vggocpa7eck3pus14fcfajlttat1bg71t6rbg", - { - "contents": [ - { - "contents": "Documentation", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "termNames": [ - "nested.names.x" - ] - } - }, - "typeDefinitions": {} -} -``````unison -doctest.thing.doc = {{ The correct docs for the thing }} -doctest.thing = "A thing" -doctest.thingalias.doc = {{ Docs for the alias, should not be displayed }} -doctest.thingalias = "A thing" -doctest.otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} -doctest.otherstuff.thing = "A different thing" ``` -Only docs for the term we request should be returned, even if there are other term docs with the same suffix. -```api -GET /api/projects/scratch/branches/main/getDefinition?names=thing&relativeTo=doctest -{ - "missingDefinitions": [], - "termDefinitions": { - "#jksc1s5kud95ro5ivngossullt2oavsd41s3u48bch67jf3gknru5j6hmjslonkd5sdqs8mr8k4rrnef8fodngbg4sm7u6au564ekjg": { - "bestTermName": "doctest.thing", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "doctest.thing", - "tag": "HashQualifier" - }, - "segment": "doctest.thing" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "doctest.thing", - "tag": "HashQualifier" - }, - "segment": "doctest.thing" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TextLiteral" - }, - "segment": "\"A thing\"" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doctest.thing.doc", - "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o", - { - "contents": [ - { - "contents": "The", - "tag": "Word" - }, - { - "contents": "correct", - "tag": "Word" - }, - { - "contents": "docs", - "tag": "Word" - }, - { - "contents": "for", - "tag": "Word" - }, - { - "contents": "the", - "tag": "Word" - }, - { - "contents": "thing", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "termNames": [ - "doctest.thing", - "doctest.thingalias" - ] - } - }, - "typeDefinitions": {} -} -```If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. +🛑 -```api -GET /api/projects/scratch/branches/main/getDefinition?names=thing.doc&relativeTo=doctest -{ - "missingDefinitions": [], - "termDefinitions": { - "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o": { - "bestTermName": "doctest.thing.doc", - "defnTermTag": "Doc", - "signature": [ - { - "annotation": { - "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", - "tag": "TypeReference" - }, - "segment": "Doc2" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "doctest.thing.doc", - "tag": "HashQualifier" - }, - "segment": "doctest.thing.doc" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", - "tag": "TypeReference" - }, - "segment": "Doc2" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "doctest.thing.doc", - "tag": "HashQualifier" - }, - "segment": "doctest.thing.doc" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DocDelimiter" - }, - "segment": "{{" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "The" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "correct" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "docs" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "for" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "the" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "thing" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DocDelimiter" - }, - "segment": "}}" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doctest.thing.doc", - "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o", - { - "contents": [ - { - "contents": "The", - "tag": "Word" - }, - { - "contents": "correct", - "tag": "Word" - }, - { - "contents": "docs", - "tag": "Word" - }, - { - "contents": "for", - "tag": "Word" - }, - { - "contents": "the", - "tag": "Word" - }, - { - "contents": "thing", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "termNames": [ - "doctest.thing.doc" - ] - } - }, - "typeDefinitions": {} -} -``` \ No newline at end of file +The transcript failed due to an error in the stanza above. The error is: + +Error decoding response from /api/projects/scratch/branches/main/getDefinition?names=x: Error in $: Failed reading: not a valid json value at 'QueryparameterrootBranchisrequired' diff --git a/unison-src/transcripts/api-namespace-details.output.md b/unison-src/transcripts/api-namespace-details.output.md index 0cdf2e88be..81d6274319 100644 --- a/unison-src/transcripts/api-namespace-details.output.md +++ b/unison-src/transcripts/api-namespace-details.output.md @@ -37,45 +37,13 @@ scratch/main> add ```api -- Should find names by suffix GET /api/projects/scratch/branches/main/namespaces/nested.names -{ - "fqn": "nested.names", - "hash": "#6tnmlu9knsce0u2991u6fvcmf4v44fdf0aiqtmnq7mjj0gi5sephg3lf12iv3odr5rc7vlgq75ciborrd3625c701bdmdomia2gcm3o", - "readme": { - "contents": [ - { - "contents": "Here's", - "tag": "Word" - }, - { - "contents": "a", - "tag": "Word" - }, - { - "contents": { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": "README", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - "tag": "Bold" - }, - { - "contents": "!", - "tag": "Word" - } - ], - "tag": "Join" - }, - "tag": "Group" - } - ], - "tag": "Paragraph" - } -} -``` \ No newline at end of file + +``` + + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + +Error decoding response from /api/projects/scratch/branches/main/namespaces/nested.names: Error in $: Failed reading: not a valid json value at 'QueryparameterrootBranchisrequired' diff --git a/unison-src/transcripts/api-namespace-list.output.md b/unison-src/transcripts/api-namespace-list.output.md index 4219aa1916..c850e85676 100644 --- a/unison-src/transcripts/api-namespace-list.output.md +++ b/unison-src/transcripts/api-namespace-list.output.md @@ -34,101 +34,17 @@ scratch/main> add ``` ```api GET /api/projects/scratch/branches/main/list?namespace=nested.names -{ - "namespaceListingChildren": [ - { - "contents": { - "termHash": "#ddmmatmmiqsts2ku0i02kntd0s7rvcui4nn1cusio8thp9oqhbtilvcnhen52ibv43kr5q83f5er5q9h56s807k17tnelnrac7cch8o", - "termName": "readme", - "termTag": "Doc", - "termType": [ - { - "annotation": { - "contents": "#ej86si0ur1", - "tag": "HashQualifier" - }, - "segment": "#ej86si0ur1" - } - ] - }, - "tag": "TermObject" - }, - { - "contents": { - "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "termName": "x", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - }, - "tag": "TermObject" - }, - { - "contents": { - "namespaceHash": "#n1egracfeljprftoktbjcase2hs4f4p8idbhs5ujipl42agld1810hrq9t7p7ped16aagni2cm1fjcjhho770jh80ipthhmg0cnsur0", - "namespaceName": "x", - "namespaceSize": 1 - }, - "tag": "Subnamespace" - } - ], - "namespaceListingFQN": "nested.names", - "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" -} + +``` + +```api +GET /api/projects/scratch/branches/main/list?namespace=nested.names GET /api/projects/scratch/branches/main/list?namespace=names&relativeTo=nested -{ - "namespaceListingChildren": [ - { - "contents": { - "termHash": "#ddmmatmmiqsts2ku0i02kntd0s7rvcui4nn1cusio8thp9oqhbtilvcnhen52ibv43kr5q83f5er5q9h56s807k17tnelnrac7cch8o", - "termName": "readme", - "termTag": "Doc", - "termType": [ - { - "annotation": { - "contents": "#ej86si0ur1", - "tag": "HashQualifier" - }, - "segment": "#ej86si0ur1" - } - ] - }, - "tag": "TermObject" - }, - { - "contents": { - "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "termName": "x", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - }, - "tag": "TermObject" - }, - { - "contents": { - "namespaceHash": "#n1egracfeljprftoktbjcase2hs4f4p8idbhs5ujipl42agld1810hrq9t7p7ped16aagni2cm1fjcjhho770jh80ipthhmg0cnsur0", - "namespaceName": "x", - "namespaceSize": 1 - }, - "tag": "Subnamespace" - } - ], - "namespaceListingFQN": "nested.names", - "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" -} -``` \ No newline at end of file +``` + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + +Error decoding response from /api/projects/scratch/branches/main/list?namespace=nested.names: Error in $: Failed reading: not a valid json value at 'QueryparameterrootBranchisrequired' diff --git a/unison-src/transcripts/api-summaries.output.md b/unison-src/transcripts/api-summaries.output.md index e9f93e624e..806392ade5 100644 --- a/unison-src/transcripts/api-summaries.output.md +++ b/unison-src/transcripts/api-summaries.output.md @@ -24,803 +24,33 @@ structural ability Stream s where ```api -- term GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat -{ - "displayName": "nat", - "hash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "tag": "UserObject" - }, - "tag": "Plain" -} + +``` + +```api +-- term +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat -- term without name uses hash GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary -{ - "displayName": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "hash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "tag": "UserObject" - }, - "tag": "Plain" -} -- doc GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc -{ - "displayName": "doc", - "hash": "#icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo", - "summary": { - "contents": [ - { - "annotation": { - "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", - "tag": "TypeReference" - }, - "segment": "Doc2" - } - ], - "tag": "UserObject" - }, - "tag": "Doc" -} -- test GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest -{ - "displayName": "mytest", - "hash": "#u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8", - "summary": { - "contents": [ - { - "annotation": { - "tag": "DelimiterChar" - }, - "segment": "[" - }, - { - "annotation": { - "contents": "#aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0", - "tag": "TypeReference" - }, - "segment": "Result" - }, - { - "annotation": { - "tag": "DelimiterChar" - }, - "segment": "]" - } - ], - "tag": "UserObject" - }, - "tag": "Test" -} -- function GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func -{ - "displayName": "func", - "hash": "#6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "tag": "UserObject" - }, - "tag": "Plain" -} -- constructor GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This -{ - "displayName": "Thing.This", - "hash": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0#0", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0", - "tag": "TypeReference" - }, - "segment": "Thing" - } - ], - "tag": "UserObject" - }, - "tag": "DataConstructor" -} -- Long type signature GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType -{ - "displayName": "funcWithLongType", - "hash": "#ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "tag": "UserObject" - }, - "tag": "Plain" -} -- Long type signature with render width GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType -{ - "displayName": "funcWithLongType", - "hash": "#ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "tag": "UserObject" - }, - "tag": "Plain" -} -- Builtin Term GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl -{ - "displayName": "putBytesImpl", - "hash": "##IO.putBytes.impl.v3", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Handle", - "tag": "TypeReference" - }, - "segment": "Handle" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Bytes", - "tag": "TypeReference" - }, - "segment": "Bytes" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": { - "tag": "AbilityBraces" - }, - "segment": "{" - }, - { - "annotation": { - "contents": "##IO", - "tag": "TypeReference" - }, - "segment": "IO" - }, - { - "annotation": { - "tag": "AbilityBraces" - }, - "segment": "}" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#0o7mf021foma9acqdaibmlh1jidlijq08uf7f5se9tssttqs546pfunjpk6s31mqoq8s2o1natede8hkk6he45l95fibglidikt44v8", - "tag": "TypeReference" - }, - "segment": "Either" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#r29dja8j9dmjjp45trccchaata8eo1h6d6haar1eai74pq1jt4m7u3ldhlq79f7phfo57eq4bau39vqotl2h63k7ff1m5sj5o9ajuf8", - "tag": "TypeReference" - }, - "segment": "Failure" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "(" - }, - { - "annotation": null, - "segment": ")" - } - ], - "tag": "BuiltinObject" - }, - "tag": "Plain" -} -```## Type Summary APIs +``` -```api --- data -GET /api/projects/scratch/branches/main/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing -{ - "displayName": "Thing", - "hash": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0", - "summary": { - "contents": [ - { - "annotation": { - "tag": "DataTypeModifier" - }, - "segment": "structural" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DataTypeKeyword" - }, - "segment": "type" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "Thing", - "tag": "HashQualifier" - }, - "segment": "Thing" - } - ], - "tag": "UserObject" - }, - "tag": "Data" -} --- data with type args -GET /api/projects/scratch/branches/main/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe -{ - "displayName": "Maybe", - "hash": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", - "summary": { - "contents": [ - { - "annotation": { - "tag": "DataTypeModifier" - }, - "segment": "structural" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DataTypeKeyword" - }, - "segment": "type" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "Maybe", - "tag": "HashQualifier" - }, - "segment": "Maybe" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DataTypeParams" - }, - "segment": "a" - } - ], - "tag": "UserObject" - }, - "tag": "Data" -} --- ability -GET /api/projects/scratch/branches/main/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream -{ - "displayName": "Stream", - "hash": "#rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8", - "summary": { - "contents": [ - { - "annotation": { - "tag": "DataTypeModifier" - }, - "segment": "structural" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DataTypeKeyword" - }, - "segment": "ability" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "Stream", - "tag": "HashQualifier" - }, - "segment": "Stream" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DataTypeParams" - }, - "segment": "s" - } - ], - "tag": "UserObject" - }, - "tag": "Ability" -} --- builtin type -GET /api/projects/scratch/branches/main/definitions/types/by-hash/@@Nat/summary?name=Nat -{ - "displayName": "Nat", - "hash": "##Nat", - "summary": { - "contents": [ - { - "annotation": null, - "segment": "Nat" - } - ], - "tag": "BuiltinObject" - }, - "tag": "Data" -} -``` \ No newline at end of file + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + +Error decoding response from /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat: Error in $: Failed reading: not a valid json value at 'QueryparameterrootBranchisrequired' diff --git a/unison-src/transcripts/branch-relative-path.output.md b/unison-src/transcripts/branch-relative-path.output.md index 4f2be5861a..99611051fd 100644 --- a/unison-src/transcripts/branch-relative-path.output.md +++ b/unison-src/transcripts/branch-relative-path.output.md @@ -67,31 +67,20 @@ p1/main> find zzz p1/main> fork p0/main:foo yyy - Done. - -p1/main> find yyy - - 1. yyy.bar : ##Nat - - -p0/main> fork p1/main: p0/main:p1 - - Done. - -p0/main> ls p1 +``` - 1. bonk (##Nat) - 2. donk/ (1 term) - 3. yyy/ (1 term) - 4. zzz/ (2 terms) +```ucm +p1/main> addp1/main> fork p0/main: zzzp1/main> find zzzp1/main> fork p0/main:foo yyyp1/main> find yyyp0/main> fork p1/main: p0/main:p1p0/main> ls p1p0/main> ls p1.zzzp0/main> ls p1.yyy +``` -p0/main> ls p1.zzz - 1. foo (##Nat) - 2. foo/ (1 term) +🛑 -p0/main> ls p1.yyy +The transcript failed due to an error in the stanza above. The error is: - 1. bar (##Nat) +:1:9: + | +1 | p0/main:foo + | ^ +Expected an absolute path but found a relative path. Try adding a leading '.' to your path -``` diff --git a/unison-src/transcripts/delete-namespace.output.md b/unison-src/transcripts/delete-namespace.output.md index 563b98ad2c..b350e13f2e 100644 --- a/unison-src/transcripts/delete-namespace.output.md +++ b/unison-src/transcripts/delete-namespace.output.md @@ -75,35 +75,21 @@ Deleting the root namespace should require confirmation if not forced. ```ucm scratch/main> delete.namespace . - ⚠️ - - Are you sure you want to clear away everything? - You could use `project.create` to switch to a new project instead. - -scratch/main> delete.namespace . - - Okay, I deleted everything except the history. Use `undo` to - undo, or `builtins.merge` to restore the absolute basics to - the current path. - --- Should have an empty history -scratch/main> history . - - ☝️ The namespace . is empty. - ``` -Deleting the root namespace shouldn't require confirmation if forced. ```ucm -scratch/main> delete.namespace.force . +scratch/main> delete.namespace .scratch/main> delete.namespace .-- Should have an empty historyscratch/main> history . +``` - Okay, I deleted everything except the history. Use `undo` to - undo, or `builtins.merge` to restore the absolute basics to - the current path. --- Should have an empty history -scratch/main> history . +🛑 - ☝️ The namespace . is empty. +The transcript failed due to an error in the stanza above. The error is: + +1:1: + | +1 | . + | ^ +unexpected '.' +expecting '`' or operator (valid characters: !$%&*+-/:<=>\^|~) -``` diff --git a/unison-src/transcripts/delete-project.md b/unison-src/transcripts/delete-project.md index b317a9f31e..aeee8b55d2 100644 --- a/unison-src/transcripts/delete-project.md +++ b/unison-src/transcripts/delete-project.md @@ -4,6 +4,7 @@ scratch/main> project.create-empty foo scratch/main> project.create-empty bar scratch/main> projects +-- I can delete the project I'm currently on. foo/main> delete.project foo scratch/main> projects ``` diff --git a/unison-src/transcripts/delete-project.output.md b/unison-src/transcripts/delete-project.output.md index e2b974a9ca..9f479983da 100644 --- a/unison-src/transcripts/delete-project.output.md +++ b/unison-src/transcripts/delete-project.output.md @@ -39,11 +39,29 @@ scratch/main> projects 2. foo 3. scratch +-- I can delete the project I'm currently on. foo/main> delete.project foo + 🎉 I've created the project with the randomly-chosen name + helpful-ladybug (use `project.rename ` to change + it). + + 🎨 Type `ui` to explore this project's code in your browser. + 🔭 Discover libraries at https://share.unison-lang.org + 📖 Use `help-topic projects` to learn more about projects. + + Write your first Unison code with UCM: + + 1. Open scratch.u. + 2. Write some Unison code and save the file. + 3. In UCM, type `add` to save it to your new project. + + 🎉 🥳 Happy coding! + scratch/main> projects 1. bar - 2. scratch + 2. helpful-ladybug + 3. scratch ``` diff --git a/unison-src/transcripts/empty-namespaces.output.md b/unison-src/transcripts/empty-namespaces.output.md index 8eee1f1a13..f426189450 100644 --- a/unison-src/transcripts/empty-namespaces.output.md +++ b/unison-src/transcripts/empty-namespaces.output.md @@ -52,7 +52,12 @@ The history of the namespace should be empty. ```ucm scratch/main> history mynamespace - ☝️ The namespace mynamespace is empty. + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) ``` Add and then delete a term to add some history to a deleted namespace. diff --git a/unison-src/transcripts/reset.output.md b/unison-src/transcripts/reset.output.md index 9be437365f..ea8f1b645f 100644 --- a/unison-src/transcripts/reset.output.md +++ b/unison-src/transcripts/reset.output.md @@ -93,187 +93,19 @@ scratch/main> history scratch/main> reset 1 foo - Done. - -scratch/main> ls foo.foo - - 1. a (Nat) - -``` -# reset branch - -```ucm -foo/main> history - - ☝️ The namespace is empty. - -``` -```unison -a = 5 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - a : ##Nat - -``` -```ucm -foo/main> add - - ⍟ I've added these definitions: - - a : ##Nat - -foo/main> branch topic - - Done. I've created the topic branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic`. - -foo/main> history - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #5l94rduvel (start of history) - -``` -```unison -a = 3 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These names already exist. You can `update` them to your - new definition: - - a : ##Nat - -``` -```ucm -foo/main> update - - Okay, I'm searching the branch for code that needs to be - updated... + scratch/foo does not exist. - Done. - -foo/main> reset /topic - - Done. - -foo/main> history - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #5l94rduvel (start of history) - -``` -# ambiguous reset - -## ambiguous target -```unison -main.a = 3 ``` ```ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - main.a : ##Nat - +scratch/main> addscratch/main> ls fooscratch/main> historyscratch/main> reset 1 fooscratch/main> ls foo.foo ``` -```ucm -foo/main> add - ⍟ I've added these definitions: - - main.a : ##Nat -foo/main> history +🛑 - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #0i64kpfccl - - + Adds / updates: - - main.a - - □ 2. #5l94rduvel (start of history) +The transcript failed due to an error in the stanza above. The error is: -foo/main> reset 2 main - I'm not sure if you wanted to reset the branch foo/main or the - namespace main in the current branch. Could you be more - specific? - - 1. /main (the branch main in the current project) - 2. main (the relative path main in the current branch) - - Tip: use `reset 1` or `reset 2` to - pick one of these. + scratch/foo does not exist. -``` -## ambiguous hash - -```unison -main.a = 3 -``` - -```ucm - - Loading changes detected in scratch.u. - - I found and typechecked the definitions in scratch.u. This - file has been previously added to the codebase. - -``` -```ucm -foo/main> switch /topic - -foo/topic> add - - ⍟ I've added these definitions: - - main.a : ##Nat - -foo/topic> reset main - - I'm not sure if you wanted to reset to the branch foo/main or - to the namespace main in the current branch. Could you be more - specific? - - 1. /main (the branch main in the current project) - 2. main (the relative path main in the current branch) - - Tip: use `reset 1` or `reset 2` to pick one of these. - -``` diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md index f0811cd8ee..db089be327 100644 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ b/unison-src/transcripts/upgrade-sad-path.output.md @@ -93,12 +93,13 @@ proj/main> view thingy thingy : Int thingy = use Int + - foo + +10 + new.foo + +10 proj/main> ls lib 1. builtin/ (469 terms, 74 types) 2. new/ (1 term) + 3. old/ (1 term) proj/main> branches From 2002a562ca62df344a2383ba98cb0eff87071d45 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 1 Jul 2024 13:37:28 -0700 Subject: [PATCH 342/631] Remove loose code support from api --- .../src/Unison/Codebase/Editor/HandleInput.hs | 3 +- unison-cli/src/Unison/Main.hs | 3 +- .../src/Unison/Server/CodebaseServer.hs | 34 +++++-------------- .../Local/Endpoints/DefinitionSummary.hs | 3 -- .../Server/Local/Endpoints/FuzzyFind.hs | 2 -- .../Server/Local/Endpoints/GetDefinitions.hs | 12 ------- .../Local/Endpoints/NamespaceDetails.hs | 2 -- .../Local/Endpoints/NamespaceListing.hs | 2 -- 8 files changed, 12 insertions(+), 49 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 9a9c87785d..c19fa48dd6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -196,6 +196,7 @@ loop e = do Cli.respond $ Typechecked (Text.pack sourceName) suffixifiedPPE sr uf in Cli.time "InputPattern" case input of ApiI -> do + pp <- Cli.getCurrentProjectPath Cli.Env {serverBaseUrl} <- ask whenJust serverBaseUrl \baseUrl -> Cli.respond $ @@ -203,7 +204,7 @@ loop e = do P.lines [ "The API information is as follows:", P.newline, - P.indentN 2 (P.hiBlue ("UI: " <> Pretty.text (Server.urlFor (Server.LooseCodeUI Path.absoluteEmpty Nothing) baseUrl))), + P.indentN 2 (P.hiBlue ("UI: " <> Pretty.text (Server.urlFor (Server.ProjectBranchUI (PP.toProjectAndBranch . PP.toNames $ pp) Path.absoluteEmpty Nothing) baseUrl))), P.newline, P.indentN 2 (P.hiBlue ("API: " <> Pretty.text (Server.urlFor Server.Api baseUrl))) ] diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index ddb07d6a03..e20436cccf 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -83,6 +83,7 @@ import Unison.CommandLine.Main qualified as CommandLine import Unison.CommandLine.Types qualified as CommandLine import Unison.CommandLine.Welcome (CodebaseInitStatus (..)) import Unison.CommandLine.Welcome qualified as Welcome +import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName (..), ProjectName (..)) import Unison.LSP qualified as LSP import Unison.Parser.Ann (Ann) import Unison.Prelude @@ -338,7 +339,7 @@ main version = do [ "I've started the Codebase API server at", P.text $ Server.urlFor Server.Api baseUrl, "and the Codebase UI at", - P.text $ Server.urlFor (Server.LooseCodeUI Path.absoluteEmpty Nothing) baseUrl + P.text $ Server.urlFor (Server.ProjectBranchUI (ProjectAndBranch (UnsafeProjectName "scratch") (UnsafeProjectBranchName "main")) Path.absoluteEmpty Nothing) baseUrl ] PT.putPrettyLn $ P.string "Running the codebase manager headless with " diff --git a/unison-share-api/src/Unison/Server/CodebaseServer.hs b/unison-share-api/src/Unison/Server/CodebaseServer.hs index 4a3025a71f..fbb09b2310 100644 --- a/unison-share-api/src/Unison/Server/CodebaseServer.hs +++ b/unison-share-api/src/Unison/Server/CodebaseServer.hs @@ -141,11 +141,8 @@ type OpenApiJSON = "openapi.json" :> Get '[JSON] OpenApi type UnisonAndDocsAPI = UnisonLocalAPI :<|> OpenApiJSON :<|> Raw -type LooseCodeAPI = CodebaseServerAPI - type UnisonLocalAPI = ("projects" :> ProjectsAPI) - :<|> ("non-project-code" :> LooseCodeAPI) :<|> ("ucm" :> UCMAPI) type CodebaseServerAPI = @@ -233,8 +230,7 @@ data DefinitionReference deriving stock (Show) data Service - = LooseCodeUI Path.Absolute (Maybe DefinitionReference) - | -- (Project branch names, perspective within project, definition reference) + = -- (Project branch names, perspective within project, definition reference) ProjectBranchUI (ProjectAndBranch ProjectName ProjectBranchName) Path.Absolute (Maybe DefinitionReference) | Api deriving stock (Show) @@ -294,8 +290,6 @@ data URISegment urlFor :: Service -> BaseUrl -> Text urlFor service baseUrl = case service of - LooseCodeUI perspective def -> - tShow baseUrl <> "/" <> toUrlPath ([DontEscape "ui", DontEscape "non-project-code"] <> path perspective def) ProjectBranchUI (ProjectAndBranch projectName branchName) perspective def -> tShow baseUrl <> "/" <> toUrlPath ([DontEscape "ui", DontEscape "projects", DontEscape $ into @Text projectName, DontEscape $ into @Text branchName] <> path perspective def) Api -> tShow baseUrl <> "/" <> toUrlPath [DontEscape "api"] @@ -559,18 +553,6 @@ serveOpenAPI = pure openAPI hoistWithAuth :: forall api. (HasServer api '[]) => Proxy api -> ByteString -> ServerT api Handler -> ServerT (Authed api) Handler hoistWithAuth api expectedToken server token = hoistServer @api @Handler @Handler api (\h -> handleAuth expectedToken token *> h) server -serveLooseCode :: - Codebase IO Symbol Ann -> - Rt.Runtime Symbol -> - ServerT LooseCodeAPI (Backend IO) -serveLooseCode codebase rt = - (\root rel name -> setCacheControl <$> NamespaceListing.serve codebase (Left root) rel name) - :<|> (\namespaceName mayRoot renderWidth -> setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Left mayRoot) renderWidth) - :<|> (\mayRoot relativePath rawHqns renderWidth suff -> setCacheControl <$> serveDefinitions rt codebase (Left mayRoot) relativePath rawHqns renderWidth suff) - :<|> (\mayRoot relativePath limit renderWidth query -> setCacheControl <$> serveFuzzyFind codebase (Left mayRoot) relativePath limit renderWidth query) - :<|> (\shortHash mayName mayRoot relativeTo renderWidth -> setCacheControl <$> serveTermSummary codebase shortHash mayName (Left mayRoot) relativeTo renderWidth) - :<|> (\shortHash mayName mayRoot relativeTo renderWidth -> setCacheControl <$> serveTypeSummary codebase shortHash mayName (Left mayRoot) relativeTo renderWidth) - serveProjectsCodebaseServerAPI :: Codebase IO Symbol Ann -> Rt.Runtime Symbol -> @@ -586,26 +568,26 @@ serveProjectsCodebaseServerAPI codebase rt projectName branchName = do :<|> serveTypeSummaryEndpoint where projectAndBranchName = ProjectAndBranch projectName branchName - namespaceListingEndpoint _rootParam rel name = do + namespaceListingEndpoint rel name = do root <- resolveProjectRootHash codebase projectAndBranchName setCacheControl <$> NamespaceListing.serve codebase (Right $ root) rel name - namespaceDetailsEndpoint namespaceName _rootParam renderWidth = do + namespaceDetailsEndpoint namespaceName renderWidth = do root <- resolveProjectRootHash codebase projectAndBranchName setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Right $ root) renderWidth - serveDefinitionsEndpoint _rootParam relativePath rawHqns renderWidth suff = do + serveDefinitionsEndpoint relativePath rawHqns renderWidth suff = do root <- resolveProjectRootHash codebase projectAndBranchName setCacheControl <$> serveDefinitions rt codebase (Right $ root) relativePath rawHqns renderWidth suff - serveFuzzyFindEndpoint _rootParam relativePath limit renderWidth query = do + serveFuzzyFindEndpoint relativePath limit renderWidth query = do root <- resolveProjectRootHash codebase projectAndBranchName setCacheControl <$> serveFuzzyFind codebase (Right $ root) relativePath limit renderWidth query - serveTermSummaryEndpoint shortHash mayName _rootParam relativeTo renderWidth = do + serveTermSummaryEndpoint shortHash mayName relativeTo renderWidth = do root <- resolveProjectRootHash codebase projectAndBranchName setCacheControl <$> serveTermSummary codebase shortHash mayName (Right $ root) relativeTo renderWidth - serveTypeSummaryEndpoint shortHash mayName _rootParam relativeTo renderWidth = do + serveTypeSummaryEndpoint shortHash mayName relativeTo renderWidth = do root <- resolveProjectRootHash codebase projectAndBranchName setCacheControl <$> serveTypeSummary codebase shortHash mayName (Right $ root) relativeTo renderWidth @@ -687,7 +669,7 @@ serveUnisonLocal :: Server UnisonLocalAPI serveUnisonLocal env codebase rt = hoistServer (Proxy @UnisonLocalAPI) (backendHandler env) $ - serveProjectsAPI codebase rt :<|> serveLooseCode codebase rt :<|> (setCacheControl <$> ucmServer codebase) + serveProjectsAPI codebase rt :<|> (setCacheControl <$> ucmServer codebase) backendHandler :: BackendEnv -> Backend IO a -> Handler a backendHandler env m = diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs index bd939684dd..93e3648678 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/DefinitionSummary.hs @@ -48,7 +48,6 @@ import Unison.Server.Backend qualified as Backend import Unison.Server.Syntax (SyntaxText) import Unison.Server.Types ( APIGet, - RequiredQueryParam, TermTag (..), TypeTag, mayDefaultWidth, @@ -68,7 +67,6 @@ type TermSummaryAPI = -- It's propagated through to the response as-is. -- If missing, the short hash will be used instead. :> QueryParam "name" Name - :> RequiredQueryParam "rootBranch" ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParam "renderWidth" Width :> APIGet TermSummary @@ -151,7 +149,6 @@ type TypeSummaryAPI = -- It's propagated through to the response as-is. -- If missing, the short hash will be used instead. :> QueryParam "name" Name - :> RequiredQueryParam "rootBranch" ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParam "renderWidth" Width :> APIGet TypeSummary diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs index cff7e67f99..cb05dc5d50 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/FuzzyFind.hs @@ -37,7 +37,6 @@ import Unison.Server.Types HashQualifiedName, NamedTerm, NamedType, - RequiredQueryParam, UnisonName, mayDefaultWidth, ) @@ -47,7 +46,6 @@ import Unison.Util.Pretty (Width) type FuzzyFindAPI = "find" - :> RequiredQueryParam "rootBranch" SCH.ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParam "limit" Int :> QueryParam "renderWidth" Width diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/GetDefinitions.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/GetDefinitions.hs index f4ce8353ef..86cb6288d6 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/GetDefinitions.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/GetDefinitions.hs @@ -35,7 +35,6 @@ import Unison.Server.Local.Definitions qualified as Local import Unison.Server.Types ( APIGet, DefinitionDisplayResults, - RequiredQueryParam, Suffixify (..), defaultWidth, ) @@ -45,7 +44,6 @@ import Unison.Util.Pretty (Width) type DefinitionsAPI = "getDefinition" - :> RequiredQueryParam "rootBranch" ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParams "names" (HQ.HashQualified Name) :> QueryParam "renderWidth" Width @@ -97,16 +95,6 @@ instance ToParam (QueryParam "namespace" Path.Path) where ) Normal -instance ToParam (RequiredQueryParam "rootBranch" ShortCausalHash) where - toParam _ = - DocQueryParam - "rootBranch" - ["#abc123"] - ( "The hash or hash prefix of the namespace root. " - <> "If left absent, the most recent root will be used." - ) - Normal - instance ToParam (QueryParams "names" (HQ.HashQualified Name)) where toParam _ = DocQueryParam diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs index 0e2721511a..c0e2d94841 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceDetails.hs @@ -24,7 +24,6 @@ import Unison.Server.Doc qualified as Doc import Unison.Server.Types ( APIGet, NamespaceDetails (..), - RequiredQueryParam, v2CausalBranchToUnisonHash, ) import Unison.Symbol (Symbol) @@ -33,7 +32,6 @@ import Unison.Util.Pretty (Width) type NamespaceDetailsAPI = "namespaces" :> Capture "namespace" Path.Path - :> RequiredQueryParam "rootBranch" ShortCausalHash :> QueryParam "renderWidth" Width :> APIGet NamespaceDetails diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs index 8543fda7c5..c60357548d 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/NamespaceListing.hs @@ -35,7 +35,6 @@ import Unison.Server.Types HashQualifiedName, NamedTerm (..), NamedType (..), - RequiredQueryParam, UnisonHash, UnisonName, v2CausalBranchToUnisonHash, @@ -47,7 +46,6 @@ import Unison.Var (Var) type NamespaceListingAPI = "list" - :> RequiredQueryParam "rootBranch" ShortCausalHash :> QueryParam "relativeTo" Path.Path :> QueryParam "namespace" Path.Path :> APIGet NamespaceListing From 724dea4f19da44e2b11b2911235cf71135115376 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 1 Jul 2024 13:56:22 -0700 Subject: [PATCH 343/631] Update api transcripts --- .../transcripts/api-doc-rendering.output.md | 803 +++++++++++++++++- unison-src/transcripts/api-find.output.md | 224 ++++- .../transcripts/api-getDefinition.output.md | 502 ++++++++++- .../api-namespace-details.output.md | 52 +- .../transcripts/api-namespace-list.output.md | 110 ++- .../transcripts/api-summaries.output.md | 796 ++++++++++++++++- 6 files changed, 2417 insertions(+), 70 deletions(-) diff --git a/unison-src/transcripts/api-doc-rendering.output.md b/unison-src/transcripts/api-doc-rendering.output.md index 6c0d09729a..f767c14cf7 100644 --- a/unison-src/transcripts/api-doc-rendering.output.md +++ b/unison-src/transcripts/api-doc-rendering.output.md @@ -148,13 +148,796 @@ scratch/main> display term.doc ``` ```api GET /api/projects/scratch/branches/main/getDefinition?names=term - -``` - - - -🛑 - -The transcript failed due to an error in the stanza above. The error is: - -Error decoding response from /api/projects/scratch/branches/main/getDefinition?names=term: Error in $: Failed reading: not a valid json value at 'QueryparameterrootBranchisrequired' +{ + "missingDefinitions": [], + "termDefinitions": { + "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { + "bestTermName": "term", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "42" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "doc", + "#kjfaflbrgl89j2uq4ruubejakm6s02cp3m61ufu7rv7tkbd4nmkvcn1fciue53v0msir9t7ds111ab9er8qfa06gsa9ddfrdfgc99mo", + { + "contents": [ + { + "contents": [ + { + "contents": "Heading", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + [ + { + "contents": [ + { + "contents": [ + { + "contents": "Heading", + "tag": "Word" + }, + { + "contents": "2", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + [ + { + "contents": [ + { + "contents": "Term", + "tag": "Word" + }, + { + "contents": "Link:", + "tag": "Word" + }, + { + "contents": { + "contents": [ + { + "annotation": { + "contents": "#k5gpql9cbdfau6lf1aja24joc3sfctvjor8esu8bemn0in3l148otb0t3vebgqrt6qml302h62bbfeftg65gec1v8ouin5m6v2969d8", + "tag": "TermReference" + }, + "segment": "otherTerm" + } + ], + "tag": "Link" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Type", + "tag": "Word" + }, + { + "contents": "Link:", + "tag": "Word" + }, + { + "contents": { + "contents": [ + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Maybe" + } + ], + "tag": "Link" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Term", + "tag": "Word" + }, + { + "contents": "source:", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": [ + "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + { + "contents": [ + [ + { + "annotation": { + "contents": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "tag": "TermReference" + }, + "segment": "term" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": ": " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "42" + } + ] + ], + "tag": "UserObject" + } + ], + "tag": "Term" + } + ], + "tag": "Source" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Term", + "tag": "Word" + }, + { + "contents": "signature:", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + [ + { + "annotation": { + "contents": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "tag": "TermReference" + }, + "segment": "term" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": ": " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ] + ], + "tag": "Signature" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": [ + { + "contents": "List", + "tag": "Word" + }, + { + "contents": "item", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ], + "tag": "BulletedList" + }, + { + "contents": [ + 1, + [ + { + "contents": [ + { + "contents": "Numbered", + "tag": "Word" + }, + { + "contents": "list", + "tag": "Word" + }, + { + "contents": "item", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "tag": "NumberedList" + }, + { + "contents": [ + { + "contents": ">", + "tag": "Word" + }, + { + "contents": "Block", + "tag": "Word" + }, + { + "contents": "quote", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Code", + "tag": "Word" + }, + { + "contents": "block", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Inline", + "tag": "Word" + }, + { + "contents": "code:", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.+", + "tag": "TermReference" + }, + "segment": "Nat.+" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "2" + } + ], + "tag": "Example" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": "\"doesn't typecheck\" + 1", + "tag": "Word" + }, + "tag": "Code" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": [ + { + "contents": [ + { + "contents": "Link", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": { + "contents": "https://unison-lang.org", + "tag": "Word" + }, + "tag": "Group" + } + ], + "tag": "NamedLink" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png)", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": "Bold", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + "tag": "Bold" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": "Italic", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + "tag": "Bold" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": "Strikethrough", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + "tag": "Strikethrough" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Horizontal", + "tag": "Word" + }, + { + "contents": "rule", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "---", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Table", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Header", + "tag": "Word" + }, + { + "contents": "1", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Header", + "tag": "Word" + }, + { + "contents": "2", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "--------", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "--------", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Cell", + "tag": "Word" + }, + { + "contents": "1", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Cell", + "tag": "Word" + }, + { + "contents": "2", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Cell", + "tag": "Word" + }, + { + "contents": "3", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Cell", + "tag": "Word" + }, + { + "contents": "4", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Video", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + [ + { + "mediaSourceMimeType": null, + "mediaSourceUrl": "test.mp4" + } + ], + { + "poster": "test.png" + } + ], + "tag": "Video" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Transclusion/evaluation:", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": [ + { + "contents": [ + { + "contents": "This", + "tag": "Word" + }, + { + "contents": "doc", + "tag": "Word" + }, + { + "contents": "should", + "tag": "Word" + }, + { + "contents": "be", + "tag": "Word" + }, + { + "contents": "embedded.", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "message", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ], + "tag": "UntitledSection" + } + ], + "tag": "Paragraph" + } + ] + ], + "tag": "Section" + } + ] + ], + "tag": "Section" + } + ] + ], + "termNames": [ + "term" + ] + } + }, + "typeDefinitions": {} +} +``` \ No newline at end of file diff --git a/unison-src/transcripts/api-find.output.md b/unison-src/transcripts/api-find.output.md index 1c2a3bd8ab..d44200e7a2 100644 --- a/unison-src/transcripts/api-find.output.md +++ b/unison-src/transcripts/api-find.output.md @@ -37,23 +37,219 @@ scratch/main> add ```api -- Namespace segment prefix search GET /api/projects/scratch/branches/main/find?query=http - -``` - -```api --- Namespace segment prefix search -GET /api/projects/scratch/branches/main/find?query=http +[ + [ + { + "result": { + "segments": [ + { + "contents": "ross.", + "tag": "Gap" + }, + { + "contents": "http", + "tag": "Match" + }, + { + "contents": "Client.y", + "tag": "Gap" + } + ] + }, + "score": 156 + }, + { + "contents": { + "bestFoundTermName": "y", + "namedTerm": { + "termHash": "#emomp74i93h6ps0b5sukke0tci0ooba3f9jk21qm919a7act9u7asani84c0mqbdk4lcjrdvr9olpedp23p6df78r4trqlg0cciadc8", + "termName": "ross.httpClient.y", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + } + }, + "tag": "FoundTermResult" + } + ], + [ + { + "result": { + "segments": [ + { + "contents": "joey.", + "tag": "Gap" + }, + { + "contents": "http", + "tag": "Match" + }, + { + "contents": "Server.z", + "tag": "Gap" + } + ] + }, + "score": 156 + }, + { + "contents": { + "bestFoundTermName": "z", + "namedTerm": { + "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", + "termName": "joey.httpServer.z", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + } + }, + "tag": "FoundTermResult" + } + ] +] -- Namespace segment suffix search GET /api/projects/scratch/branches/main/find?query=Server +[ + [ + { + "result": { + "segments": [ + { + "contents": "joey.http", + "tag": "Gap" + }, + { + "contents": "Server", + "tag": "Match" + }, + { + "contents": ".z", + "tag": "Gap" + } + ] + }, + "score": 223 + }, + { + "contents": { + "bestFoundTermName": "z", + "namedTerm": { + "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", + "termName": "joey.httpServer.z", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + } + }, + "tag": "FoundTermResult" + } + ] +] -- Substring search GET /api/projects/scratch/branches/main/find?query=lesys +[ + [ + { + "result": { + "segments": [ + { + "contents": "rachel.fi", + "tag": "Gap" + }, + { + "contents": "lesys", + "tag": "Match" + }, + { + "contents": "tem.x", + "tag": "Gap" + } + ] + }, + "score": 175 + }, + { + "contents": { + "bestFoundTermName": "x", + "namedTerm": { + "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "termName": "rachel.filesystem.x", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + } + }, + "tag": "FoundTermResult" + } + ] +] -- Cross-segment search GET /api/projects/scratch/branches/main/find?query=joey.http -``` - - -🛑 - -The transcript failed due to an error in the stanza above. The error is: - -Error decoding response from /api/projects/scratch/branches/main/find?query=http: Error in $: Failed reading: not a valid json value at 'QueryparameterrootBranchisrequired' +[ + [ + { + "result": { + "segments": [ + { + "contents": "joey.http", + "tag": "Match" + }, + { + "contents": "Server.z", + "tag": "Gap" + } + ] + }, + "score": 300 + }, + { + "contents": { + "bestFoundTermName": "z", + "namedTerm": { + "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", + "termName": "joey.httpServer.z", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + } + }, + "tag": "FoundTermResult" + } + ] +] +``` \ No newline at end of file diff --git a/unison-src/transcripts/api-getDefinition.output.md b/unison-src/transcripts/api-getDefinition.output.md index 1bb60a6603..5e854a440c 100644 --- a/unison-src/transcripts/api-getDefinition.output.md +++ b/unison-src/transcripts/api-getDefinition.output.md @@ -8,21 +8,503 @@ nested.names.x = 42 ```api -- Should NOT find names by suffix GET /api/projects/scratch/branches/main/getDefinition?names=x - -``` - -```api --- Should NOT find names by suffix -GET /api/projects/scratch/branches/main/getDefinition?names=x +{ + "missingDefinitions": [ + "x" + ], + "termDefinitions": {}, + "typeDefinitions": {} +} -- Term names should strip relativeTo prefix. GET /api/projects/scratch/branches/main/getDefinition?names=names.x&relativeTo=nested +{ + "missingDefinitions": [], + "termDefinitions": { + "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { + "bestTermName": "x", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "x", + "tag": "HashQualifier" + }, + "segment": "x" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "x", + "tag": "HashQualifier" + }, + "segment": "x" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "42" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "doc", + "#ulr9f75rpcrv79d7sfo2ep2tvbntu3e360lfomird2bdpj4bnea230e8o5j0b9our8vggocpa7eck3pus14fcfajlttat1bg71t6rbg", + { + "contents": [ + { + "contents": "Documentation", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "termNames": [ + "nested.names.x" + ] + } + }, + "typeDefinitions": {} +} -- Should find definitions by hash, names should be relative GET /api/projects/scratch/branches/main/getDefinition?names=%23qkhkl0n238&relativeTo=nested +{ + "missingDefinitions": [], + "termDefinitions": { + "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { + "bestTermName": "x", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "x", + "tag": "HashQualifier" + }, + "segment": "x" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "x", + "tag": "HashQualifier" + }, + "segment": "x" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "42" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "doc", + "#ulr9f75rpcrv79d7sfo2ep2tvbntu3e360lfomird2bdpj4bnea230e8o5j0b9our8vggocpa7eck3pus14fcfajlttat1bg71t6rbg", + { + "contents": [ + { + "contents": "Documentation", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "termNames": [ + "nested.names.x" + ] + } + }, + "typeDefinitions": {} +} +``````unison +doctest.thing.doc = {{ The correct docs for the thing }} +doctest.thing = "A thing" +doctest.thingalias.doc = {{ Docs for the alias, should not be displayed }} +doctest.thingalias = "A thing" +doctest.otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} +doctest.otherstuff.thing = "A different thing" ``` +Only docs for the term we request should be returned, even if there are other term docs with the same suffix. -🛑 - -The transcript failed due to an error in the stanza above. The error is: +```api +GET /api/projects/scratch/branches/main/getDefinition?names=thing&relativeTo=doctest +{ + "missingDefinitions": [], + "termDefinitions": { + "#jksc1s5kud95ro5ivngossullt2oavsd41s3u48bch67jf3gknru5j6hmjslonkd5sdqs8mr8k4rrnef8fodngbg4sm7u6au564ekjg": { + "bestTermName": "doctest.thing", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "doctest.thing", + "tag": "HashQualifier" + }, + "segment": "doctest.thing" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "doctest.thing", + "tag": "HashQualifier" + }, + "segment": "doctest.thing" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"A thing\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "doctest.thing.doc", + "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o", + { + "contents": [ + { + "contents": "The", + "tag": "Word" + }, + { + "contents": "correct", + "tag": "Word" + }, + { + "contents": "docs", + "tag": "Word" + }, + { + "contents": "for", + "tag": "Word" + }, + { + "contents": "the", + "tag": "Word" + }, + { + "contents": "thing", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "termNames": [ + "doctest.thing", + "doctest.thingalias" + ] + } + }, + "typeDefinitions": {} +} +```If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. -Error decoding response from /api/projects/scratch/branches/main/getDefinition?names=x: Error in $: Failed reading: not a valid json value at 'QueryparameterrootBranchisrequired' +```api +GET /api/projects/scratch/branches/main/getDefinition?names=thing.doc&relativeTo=doctest +{ + "missingDefinitions": [], + "termDefinitions": { + "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o": { + "bestTermName": "doctest.thing.doc", + "defnTermTag": "Doc", + "signature": [ + { + "annotation": { + "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", + "tag": "TypeReference" + }, + "segment": "Doc2" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "doctest.thing.doc", + "tag": "HashQualifier" + }, + "segment": "doctest.thing.doc" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", + "tag": "TypeReference" + }, + "segment": "Doc2" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "doctest.thing.doc", + "tag": "HashQualifier" + }, + "segment": "doctest.thing.doc" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DocDelimiter" + }, + "segment": "{{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "The" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "correct" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "docs" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "for" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "the" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "thing" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DocDelimiter" + }, + "segment": "}}" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "doctest.thing.doc", + "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o", + { + "contents": [ + { + "contents": "The", + "tag": "Word" + }, + { + "contents": "correct", + "tag": "Word" + }, + { + "contents": "docs", + "tag": "Word" + }, + { + "contents": "for", + "tag": "Word" + }, + { + "contents": "the", + "tag": "Word" + }, + { + "contents": "thing", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "termNames": [ + "doctest.thing.doc" + ] + } + }, + "typeDefinitions": {} +} +``` \ No newline at end of file diff --git a/unison-src/transcripts/api-namespace-details.output.md b/unison-src/transcripts/api-namespace-details.output.md index 81d6274319..0cdf2e88be 100644 --- a/unison-src/transcripts/api-namespace-details.output.md +++ b/unison-src/transcripts/api-namespace-details.output.md @@ -37,13 +37,45 @@ scratch/main> add ```api -- Should find names by suffix GET /api/projects/scratch/branches/main/namespaces/nested.names - -``` - - - -🛑 - -The transcript failed due to an error in the stanza above. The error is: - -Error decoding response from /api/projects/scratch/branches/main/namespaces/nested.names: Error in $: Failed reading: not a valid json value at 'QueryparameterrootBranchisrequired' +{ + "fqn": "nested.names", + "hash": "#6tnmlu9knsce0u2991u6fvcmf4v44fdf0aiqtmnq7mjj0gi5sephg3lf12iv3odr5rc7vlgq75ciborrd3625c701bdmdomia2gcm3o", + "readme": { + "contents": [ + { + "contents": "Here's", + "tag": "Word" + }, + { + "contents": "a", + "tag": "Word" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": "README", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + "tag": "Bold" + }, + { + "contents": "!", + "tag": "Word" + } + ], + "tag": "Join" + }, + "tag": "Group" + } + ], + "tag": "Paragraph" + } +} +``` \ No newline at end of file diff --git a/unison-src/transcripts/api-namespace-list.output.md b/unison-src/transcripts/api-namespace-list.output.md index c850e85676..4219aa1916 100644 --- a/unison-src/transcripts/api-namespace-list.output.md +++ b/unison-src/transcripts/api-namespace-list.output.md @@ -34,17 +34,101 @@ scratch/main> add ``` ```api GET /api/projects/scratch/branches/main/list?namespace=nested.names - -``` - -```api -GET /api/projects/scratch/branches/main/list?namespace=nested.names +{ + "namespaceListingChildren": [ + { + "contents": { + "termHash": "#ddmmatmmiqsts2ku0i02kntd0s7rvcui4nn1cusio8thp9oqhbtilvcnhen52ibv43kr5q83f5er5q9h56s807k17tnelnrac7cch8o", + "termName": "readme", + "termTag": "Doc", + "termType": [ + { + "annotation": { + "contents": "#ej86si0ur1", + "tag": "HashQualifier" + }, + "segment": "#ej86si0ur1" + } + ] + }, + "tag": "TermObject" + }, + { + "contents": { + "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "termName": "x", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + }, + "tag": "TermObject" + }, + { + "contents": { + "namespaceHash": "#n1egracfeljprftoktbjcase2hs4f4p8idbhs5ujipl42agld1810hrq9t7p7ped16aagni2cm1fjcjhho770jh80ipthhmg0cnsur0", + "namespaceName": "x", + "namespaceSize": 1 + }, + "tag": "Subnamespace" + } + ], + "namespaceListingFQN": "nested.names", + "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" +} GET /api/projects/scratch/branches/main/list?namespace=names&relativeTo=nested -``` - - -🛑 - -The transcript failed due to an error in the stanza above. The error is: - -Error decoding response from /api/projects/scratch/branches/main/list?namespace=nested.names: Error in $: Failed reading: not a valid json value at 'QueryparameterrootBranchisrequired' +{ + "namespaceListingChildren": [ + { + "contents": { + "termHash": "#ddmmatmmiqsts2ku0i02kntd0s7rvcui4nn1cusio8thp9oqhbtilvcnhen52ibv43kr5q83f5er5q9h56s807k17tnelnrac7cch8o", + "termName": "readme", + "termTag": "Doc", + "termType": [ + { + "annotation": { + "contents": "#ej86si0ur1", + "tag": "HashQualifier" + }, + "segment": "#ej86si0ur1" + } + ] + }, + "tag": "TermObject" + }, + { + "contents": { + "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "termName": "x", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + }, + "tag": "TermObject" + }, + { + "contents": { + "namespaceHash": "#n1egracfeljprftoktbjcase2hs4f4p8idbhs5ujipl42agld1810hrq9t7p7ped16aagni2cm1fjcjhho770jh80ipthhmg0cnsur0", + "namespaceName": "x", + "namespaceSize": 1 + }, + "tag": "Subnamespace" + } + ], + "namespaceListingFQN": "nested.names", + "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" +} +``` \ No newline at end of file diff --git a/unison-src/transcripts/api-summaries.output.md b/unison-src/transcripts/api-summaries.output.md index 806392ade5..e9f93e624e 100644 --- a/unison-src/transcripts/api-summaries.output.md +++ b/unison-src/transcripts/api-summaries.output.md @@ -24,33 +24,803 @@ structural ability Stream s where ```api -- term GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat - -``` - -```api --- term -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat +{ + "displayName": "nat", + "hash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "tag": "Plain" +} -- term without name uses hash GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary +{ + "displayName": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "hash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "tag": "Plain" +} -- doc GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc +{ + "displayName": "doc", + "hash": "#icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo", + "summary": { + "contents": [ + { + "annotation": { + "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", + "tag": "TypeReference" + }, + "segment": "Doc2" + } + ], + "tag": "UserObject" + }, + "tag": "Doc" +} -- test GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest +{ + "displayName": "mytest", + "hash": "#u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8", + "summary": { + "contents": [ + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "[" + }, + { + "annotation": { + "contents": "#aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0", + "tag": "TypeReference" + }, + "segment": "Result" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "]" + } + ], + "tag": "UserObject" + }, + "tag": "Test" +} -- function GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func +{ + "displayName": "func", + "hash": "#6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "tag": "UserObject" + }, + "tag": "Plain" +} -- constructor GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This +{ + "displayName": "Thing.This", + "hash": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0#0", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0", + "tag": "TypeReference" + }, + "segment": "Thing" + } + ], + "tag": "UserObject" + }, + "tag": "DataConstructor" +} -- Long type signature GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType +{ + "displayName": "funcWithLongType", + "hash": "#ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "tag": "UserObject" + }, + "tag": "Plain" +} -- Long type signature with render width GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType +{ + "displayName": "funcWithLongType", + "hash": "#ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "tag": "UserObject" + }, + "tag": "Plain" +} -- Builtin Term GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl -``` - - -🛑 +{ + "displayName": "putBytesImpl", + "hash": "##IO.putBytes.impl.v3", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Handle", + "tag": "TypeReference" + }, + "segment": "Handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Bytes", + "tag": "TypeReference" + }, + "segment": "Bytes" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "##IO", + "tag": "TypeReference" + }, + "segment": "IO" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#0o7mf021foma9acqdaibmlh1jidlijq08uf7f5se9tssttqs546pfunjpk6s31mqoq8s2o1natede8hkk6he45l95fibglidikt44v8", + "tag": "TypeReference" + }, + "segment": "Either" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#r29dja8j9dmjjp45trccchaata8eo1h6d6haar1eai74pq1jt4m7u3ldhlq79f7phfo57eq4bau39vqotl2h63k7ff1m5sj5o9ajuf8", + "tag": "TypeReference" + }, + "segment": "Failure" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "(" + }, + { + "annotation": null, + "segment": ")" + } + ], + "tag": "BuiltinObject" + }, + "tag": "Plain" +} +```## Type Summary APIs -The transcript failed due to an error in the stanza above. The error is: - -Error decoding response from /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat: Error in $: Failed reading: not a valid json value at 'QueryparameterrootBranchisrequired' +```api +-- data +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing +{ + "displayName": "Thing", + "hash": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0", + "summary": { + "contents": [ + { + "annotation": { + "tag": "DataTypeModifier" + }, + "segment": "structural" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "Thing", + "tag": "HashQualifier" + }, + "segment": "Thing" + } + ], + "tag": "UserObject" + }, + "tag": "Data" +} +-- data with type args +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe +{ + "displayName": "Maybe", + "hash": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "summary": { + "contents": [ + { + "annotation": { + "tag": "DataTypeModifier" + }, + "segment": "structural" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "Maybe", + "tag": "HashQualifier" + }, + "segment": "Maybe" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DataTypeParams" + }, + "segment": "a" + } + ], + "tag": "UserObject" + }, + "tag": "Data" +} +-- ability +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream +{ + "displayName": "Stream", + "hash": "#rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8", + "summary": { + "contents": [ + { + "annotation": { + "tag": "DataTypeModifier" + }, + "segment": "structural" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "Stream", + "tag": "HashQualifier" + }, + "segment": "Stream" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DataTypeParams" + }, + "segment": "s" + } + ], + "tag": "UserObject" + }, + "tag": "Ability" +} +-- builtin type +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@@Nat/summary?name=Nat +{ + "displayName": "Nat", + "hash": "##Nat", + "summary": { + "contents": [ + { + "annotation": null, + "segment": "Nat" + } + ], + "tag": "BuiltinObject" + }, + "tag": "Data" +} +``` \ No newline at end of file From d93b5dee4f07c96aa437ef9951a3f9b2c35f6017 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 1 Jul 2024 14:31:01 -0700 Subject: [PATCH 344/631] Update paths in branch-relative-path.md --- .../transcripts/branch-relative-path.md | 12 ++---- .../branch-relative-path.output.md | 37 ++++++++++++------- 2 files changed, 27 insertions(+), 22 deletions(-) diff --git a/unison-src/transcripts/branch-relative-path.md b/unison-src/transcripts/branch-relative-path.md index 74298f4b2b..49bd4863b3 100644 --- a/unison-src/transcripts/branch-relative-path.md +++ b/unison-src/transcripts/branch-relative-path.md @@ -1,9 +1,3 @@ -```ucm:hide -scratch/main> builtins.merge -scratch/main> project.create-empty p0 -scratch/main> project.create-empty p1 -``` - ```unison foo = 5 foo.bar = 1 @@ -20,11 +14,11 @@ donk.bonk = 1 ```ucm p1/main> add -p1/main> fork p0/main: zzz +p1/main> fork p0/main:. zzz p1/main> find zzz -p1/main> fork p0/main:foo yyy +p1/main> fork p0/main:.foo yyy p1/main> find yyy -p0/main> fork p1/main: p0/main:p1 +p0/main> fork p1/main:. p0/main:.p1 p0/main> ls p1 p0/main> ls p1.zzz p0/main> ls p1.yyy diff --git a/unison-src/transcripts/branch-relative-path.output.md b/unison-src/transcripts/branch-relative-path.output.md index 99611051fd..14635d4851 100644 --- a/unison-src/transcripts/branch-relative-path.output.md +++ b/unison-src/transcripts/branch-relative-path.output.md @@ -55,7 +55,7 @@ p1/main> add bonk : ##Nat donk.bonk : ##Nat -p1/main> fork p0/main: zzz +p1/main> fork p0/main:. zzz Done. @@ -65,22 +65,33 @@ p1/main> find zzz 2. zzz.foo.bar : ##Nat -p1/main> fork p0/main:foo yyy +p1/main> fork p0/main:.foo yyy -``` + Done. -```ucm -p1/main> addp1/main> fork p0/main: zzzp1/main> find zzzp1/main> fork p0/main:foo yyyp1/main> find yyyp0/main> fork p1/main: p0/main:p1p0/main> ls p1p0/main> ls p1.zzzp0/main> ls p1.yyy -``` +p1/main> find yyy + + 1. yyy.bar : ##Nat + +p0/main> fork p1/main:. p0/main:.p1 -🛑 + Done. + +p0/main> ls p1 + + 1. bonk (##Nat) + 2. donk/ (1 term) + 3. yyy/ (1 term) + 4. zzz/ (2 terms) -The transcript failed due to an error in the stanza above. The error is: +p0/main> ls p1.zzz -:1:9: - | -1 | p0/main:foo - | ^ -Expected an absolute path but found a relative path. Try adding a leading '.' to your path + 1. foo (##Nat) + 2. foo/ (1 term) +p0/main> ls p1.yyy + + 1. bar (##Nat) + +``` From fbd7bb90a6db54d22d4816fd625460c4b648ba6b Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 1 Jul 2024 22:12:00 -0700 Subject: [PATCH 345/631] Update 'bug-strange-closure.md' --- unison-src/transcripts/bug-strange-closure.md | 18 +++++++++--------- .../transcripts/bug-strange-closure.output.md | 14 +++++++------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/unison-src/transcripts/bug-strange-closure.md b/unison-src/transcripts/bug-strange-closure.md index f2f805d682..75c4064db3 100644 --- a/unison-src/transcripts/bug-strange-closure.md +++ b/unison-src/transcripts/bug-strange-closure.md @@ -1,15 +1,15 @@ ```ucm:hide -.> builtins.mergeio -.> load unison-src/transcripts-using-base/doc.md.files/syntax.u +scratch/main> builtins.mergeio lib.builtins +scratch/main> load unison-src/transcripts-using-base/doc.md.files/syntax.u ``` We can display the guide before and after adding it to the codebase: ```ucm -.> display doc.guide -.> add -.> display doc.guide +scratch/main> display doc.guide +scratch/main> add +scratch/main> display doc.guide ``` But we can't display this due to a decompilation problem. @@ -19,10 +19,10 @@ rendered = Pretty.get (docFormatConsole doc.guide) ``` ```ucm -.> display rendered -.> add -.> display rendered -.> undo +scratch/main> display rendered +scratch/main> add +scratch/main> display rendered +scratch/main> undo ``` And then this sometimes generates a GHC crash "strange closure error" but doesn't seem deterministic. diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md index 8b9f7fa75c..426f0c1e32 100644 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ b/unison-src/transcripts/bug-strange-closure.output.md @@ -2,7 +2,7 @@ We can display the guide before and after adding it to the codebase: ```ucm -.> display doc.guide +scratch/main> display doc.guide # Unison computable documentation @@ -200,7 +200,7 @@ We can display the guide before and after adding it to the codebase: rendered table. Some text More text Zounds! -.> add +scratch/main> add ⍟ I've added these definitions: @@ -213,7 +213,7 @@ We can display the guide before and after adding it to the codebase: otherElements : Doc2 sqr : Nat -> Nat -.> display doc.guide +scratch/main> display doc.guide # Unison computable documentation @@ -432,7 +432,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) ``` ```ucm -.> display rendered +scratch/main> display rendered # Unison computable documentation @@ -630,13 +630,13 @@ rendered = Pretty.get (docFormatConsole doc.guide) rendered table. Some text More text Zounds! -.> add +scratch/main> add ⍟ I've added these definitions: rendered : Annotated () (Either SpecialForm ConsoleText) -.> display rendered +scratch/main> display rendered # Unison computable documentation @@ -834,7 +834,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) rendered table. Some text More text Zounds! -.> undo +scratch/main> undo Here are the changes I undid From 081f34457895146e00094b3ecd0e3e33001fc49c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 1 Jul 2024 22:14:16 -0700 Subject: [PATCH 346/631] Fix delete.md --- unison-src/transcripts/delete.md | 76 ++++++++++---------- unison-src/transcripts/delete.output.md | 95 ++++++++++++------------- 2 files changed, 85 insertions(+), 86 deletions(-) diff --git a/unison-src/transcripts/delete.md b/unison-src/transcripts/delete.md index aadb7a602f..9c1b8efd1a 100644 --- a/unison-src/transcripts/delete.md +++ b/unison-src/transcripts/delete.md @@ -1,7 +1,7 @@ # Delete ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge lib.builtins ``` The delete command can delete both terms and types. @@ -10,7 +10,7 @@ First, let's make sure it complains when we try to delete a name that doesn't exist. ```ucm:error -.> delete.verbose foo +scratch/main> delete.verbose foo ``` Now for some easy cases. Deleting an unambiguous term, then deleting an @@ -22,43 +22,43 @@ structural type Foo = Foo () ``` ```ucm -.> add -.> delete.verbose foo -.> delete.verbose Foo -.> delete.verbose Foo.Foo +scratch/main> add +scratch/main> delete.verbose foo +scratch/main> delete.verbose Foo +scratch/main> delete.verbose Foo.Foo ``` How about an ambiguous term? ```unison:hide -foo = 1 -bar = 2 +a.foo = 1 +a.bar = 2 ``` ```ucm -.a> add -.a> debug.alias.term.force bar foo +scratch/main> add +scratch/main> debug.alias.term.force a.bar a.foo ``` A delete should remove both versions of the term. ```ucm -.> delete.verbose a.foo -.a> ls +scratch/main> delete.verbose a.foo +scratch/main> ls a ``` Let's repeat all that on a type, for completeness. ```unison:hide -structural type Foo = Foo () -structural type Bar = Bar +structural type a.Foo = Foo () +structural type a.Bar = Bar ``` ```ucm -.a> add -.a> debug.alias.type.force Bar Foo -.> delete.verbose a.Foo -.> delete.verbose a.Foo.Foo +scratch/main> add +scratch/main> debug.alias.type.force a.Bar a.Foo +scratch/main> delete.verbose a.Foo +scratch/main> delete.verbose a.Foo.Foo ``` Finally, let's try to delete a term and a type with the same name. @@ -69,8 +69,8 @@ structural type foo = Foo () ``` ```ucm -.> add -.> delete.verbose foo +scratch/main> add +scratch/main> delete.verbose foo ``` We want to be able to delete multiple terms at once @@ -82,8 +82,8 @@ c = "c" ``` ```ucm -.> add -.> delete.verbose a b c +scratch/main> add +scratch/main> delete.verbose a b c ``` We can delete terms and types in the same invocation of delete @@ -96,9 +96,9 @@ c = "c" ``` ```ucm -.> add -.> delete.verbose a b c Foo -.> delete.verbose Foo.Foo +scratch/main> add +scratch/main> delete.verbose a b c Foo +scratch/main> delete.verbose Foo.Foo ``` We can delete a type and its constructors @@ -108,8 +108,8 @@ structural type Foo = Foo () ``` ```ucm -.> add -.> delete.verbose Foo Foo.Foo +scratch/main> add +scratch/main> delete.verbose Foo Foo.Foo ``` You should not be able to delete terms which are referenced by other terms @@ -122,8 +122,8 @@ d = a + b + c ``` ```ucm:error -.> add -.> delete.verbose a b c +scratch/main> add +scratch/main> delete.verbose a b c ``` But you should be able to delete all terms which reference each other in a single command @@ -136,8 +136,8 @@ h = e + f + g ``` ```ucm -.> add -.> delete.verbose e f g h +scratch/main> add +scratch/main> delete.verbose e f g h ``` You should be able to delete a type and all the functions that reference it in a single command @@ -151,8 +151,8 @@ incrementFoo = cases ``` ```ucm -.> add -.> delete.verbose Foo Foo.Foo incrementFoo +scratch/main> add +scratch/main> delete.verbose Foo Foo.Foo incrementFoo ``` If you mess up on one of the names of your command, delete short circuits @@ -165,8 +165,8 @@ h = e + f + g ``` ```ucm:error -.> add -.> delete.verbose e f gg +scratch/main> add +scratch/main> delete.verbose e f gg ``` Cyclical terms which are guarded by a lambda are allowed to be deleted @@ -177,7 +177,7 @@ pong _ = 4 Nat.+ !ping ``` ```ucm -.> add -.> delete.verbose ping -.> view pong +scratch/main> add +scratch/main> delete.verbose ping +scratch/main> view pong ``` diff --git a/unison-src/transcripts/delete.output.md b/unison-src/transcripts/delete.output.md index 14ca930fe1..46414513b2 100644 --- a/unison-src/transcripts/delete.output.md +++ b/unison-src/transcripts/delete.output.md @@ -6,7 +6,7 @@ First, let's make sure it complains when we try to delete a name that doesn't exist. ```ucm -.> delete.verbose foo +scratch/main> delete.verbose foo ⚠️ @@ -23,14 +23,14 @@ structural type Foo = Foo () ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: structural type Foo foo : Nat -.> delete.verbose foo +scratch/main> delete.verbose foo Removed definitions: @@ -38,7 +38,7 @@ structural type Foo = Foo () Tip: You can use `undo` or `reflog` to undo this change. -.> delete.verbose Foo +scratch/main> delete.verbose Foo Removed definitions: @@ -46,7 +46,7 @@ structural type Foo = Foo () Tip: You can use `undo` or `reflog` to undo this change. -.> delete.verbose Foo.Foo +scratch/main> delete.verbose Foo.Foo Removed definitions: @@ -58,21 +58,19 @@ structural type Foo = Foo () How about an ambiguous term? ```unison -foo = 1 -bar = 2 +a.foo = 1 +a.bar = 2 ``` ```ucm - ☝️ The namespace .a is empty. - -.a> add +scratch/main> add ⍟ I've added these definitions: - bar : ##Nat - foo : ##Nat + a.bar : Nat + a.foo : Nat -.a> debug.alias.term.force bar foo +scratch/main> debug.alias.term.force a.bar a.foo Done. @@ -80,7 +78,7 @@ bar = 2 A delete should remove both versions of the term. ```ucm -.> delete.verbose a.foo +scratch/main> delete.verbose a.foo Removed definitions: @@ -94,31 +92,32 @@ A delete should remove both versions of the term. Tip: You can use `undo` or `reflog` to undo this change. -.a> ls +scratch/main> ls a - 1. bar (##Nat) + 1. bar (Nat) ``` Let's repeat all that on a type, for completeness. ```unison -structural type Foo = Foo () -structural type Bar = Bar +structural type a.Foo = Foo () +structural type a.Bar = Bar ``` ```ucm -.a> add +scratch/main> add ⍟ I've added these definitions: - structural type Bar - structural type Foo + structural type a.Bar + (also named lib.builtins.Unit) + structural type a.Foo -.a> debug.alias.type.force Bar Foo +scratch/main> debug.alias.type.force a.Bar a.Foo Done. -.> delete.verbose a.Foo +scratch/main> delete.verbose a.Foo Removed definitions: @@ -126,14 +125,14 @@ structural type Bar = Bar Name changes: - Original Changes - 2. a.Bar ┐ 3. a.Foo#00nv2kob8f (removed) - 4. builtin.Unit │ - 5. a.Foo#00nv2kob8f ┘ + Original Changes + 2. a.Bar ┐ 3. a.Foo#00nv2kob8f (removed) + 4. lib.builtins.Unit │ + 5. a.Foo#00nv2kob8f ┘ Tip: You can use `undo` or `reflog` to undo this change. -.> delete.verbose a.Foo.Foo +scratch/main> delete.verbose a.Foo.Foo Removed definitions: @@ -150,14 +149,14 @@ structural type foo = Foo () ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: structural type foo foo : Nat -.> delete.verbose foo +scratch/main> delete.verbose foo Removed definitions: @@ -176,7 +175,7 @@ c = "c" ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -184,7 +183,7 @@ c = "c" b : Text c : Text -.> delete.verbose a b c +scratch/main> delete.verbose a b c Removed definitions: @@ -205,7 +204,7 @@ c = "c" ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -214,7 +213,7 @@ c = "c" b : Text c : Text -.> delete.verbose a b c Foo +scratch/main> delete.verbose a b c Foo Removed definitions: @@ -225,7 +224,7 @@ c = "c" Tip: You can use `undo` or `reflog` to undo this change. -.> delete.verbose Foo.Foo +scratch/main> delete.verbose Foo.Foo Name changes: @@ -243,13 +242,13 @@ structural type Foo = Foo () ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: structural type Foo -.> delete.verbose Foo Foo.Foo +scratch/main> delete.verbose Foo Foo.Foo Removed definitions: @@ -274,7 +273,7 @@ d = a + b + c ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -284,7 +283,7 @@ d = a + b + c c : Nat d : Nat -.> delete.verbose a b c +scratch/main> delete.verbose a b c ⚠️ @@ -307,7 +306,7 @@ h = e + f + g ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -316,7 +315,7 @@ h = e + f + g g : Nat h : Nat -.> delete.verbose e f g h +scratch/main> delete.verbose e f g h Removed definitions: @@ -339,14 +338,14 @@ incrementFoo = cases ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: structural type Foo incrementFoo : Foo -> Nat -.> delete.verbose Foo Foo.Foo incrementFoo +scratch/main> delete.verbose Foo Foo.Foo incrementFoo Removed definitions: @@ -367,7 +366,7 @@ h = e + f + g ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -376,7 +375,7 @@ h = e + f + g g : Nat h : Nat -.> delete.verbose e f gg +scratch/main> delete.verbose e f gg ⚠️ @@ -392,14 +391,14 @@ pong _ = 4 Nat.+ !ping ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: ping : 'Nat pong : 'Nat -.> delete.verbose ping +scratch/main> delete.verbose ping Removed definitions: @@ -407,7 +406,7 @@ pong _ = 4 Nat.+ !ping Tip: You can use `undo` or `reflog` to undo this change. -.> view pong +scratch/main> view pong pong : 'Nat pong _ = From 99bad7616eb007d3f49024995e3cd670d90e7087 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 1 Jul 2024 22:21:14 -0700 Subject: [PATCH 347/631] Allow hashes or branches in diff.namespace --- unison-cli/src/Unison/Cli/MonadUtils.hs | 2 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 22 +++++++------ .../src/Unison/Codebase/Editor/Input.hs | 7 +++-- .../Unison/CommandLine/BranchRelativePath.hs | 31 +++++++++---------- .../src/Unison/CommandLine/InputPatterns.hs | 19 ++++++------ 5 files changed, 42 insertions(+), 39 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 287b761f14..ba182aacbb 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -355,7 +355,7 @@ branchExistsAtPath' path' = do ------------------------------------------------------------------------------------------------------------------------ -- Updating branches -makeActionsUnabsolute :: Functor f => f (Path.Absolute, x) -> f (Path, x) +makeActionsUnabsolute :: (Functor f) => f (Path.Absolute, x) -> f (Path, x) makeActionsUnabsolute = fmap (first Path.unabsolute) stepAt :: diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index c19fa48dd6..6247d42b85 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -314,16 +314,10 @@ loop e = do (ppe, diff) <- diffHelper (Branch.head destBranch) (Branch.head merged) Cli.respondNumbered (ShowDiffAfterMergePreview (Left destPP) destPP ppe diff) DiffNamespaceI before after -> do - beforeLoc <- case before of - BranchAtSCH sch -> pure $ Left sch - BranchAtPath path' -> Right <$> Cli.resolvePath' path' - BranchAtProjectPath pp -> pure $ Right pp - afterLoc <- case after of - BranchAtSCH sch -> pure $ Left sch - BranchAtPath path' -> Right <$> Cli.resolvePath' path' - BranchAtProjectPath pp -> pure $ Right pp - beforeBranch0 <- Branch.head <$> Cli.resolveBranchId before - afterBranch0 <- Branch.head <$> Cli.resolveBranchId after + beforeLoc <- traverse ProjectUtils.resolveBranchRelativePath before + beforeBranch0 <- Branch.head <$> resolveBranchId2 before + afterLoc <- traverse ProjectUtils.resolveBranchRelativePath after + afterBranch0 <- Branch.head <$> resolveBranchId2 after case (Branch.isEmpty0 beforeBranch0, Branch.isEmpty0 afterBranch0) of (True, True) -> Cli.returnEarly . NamespaceEmpty $ (beforeLoc Nel.:| [afterLoc]) (True, False) -> Cli.returnEarly . NamespaceEmpty $ (beforeLoc Nel.:| []) @@ -1683,3 +1677,11 @@ addWatch watchName (Just uf) = do (UF.watchComponents uf <> [(WK.RegularWatch, [(v2, ann, Term.var a v, ty)])]) ) _ -> addWatch watchName Nothing + +resolveBranchId2 :: BranchId2 -> Cli (Branch IO) +resolveBranchId2 = \case + Left sch -> Cli.resolveShortCausalHash sch + Right brp -> do + pp <- ProjectUtils.resolveBranchRelativePath brp + Cli.Env {codebase} <- ask + fromMaybe Branch.empty <$> liftIO (Codebase.getBranchAtProjectPath codebase pp) diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index adcdcd2c10..774e840d9d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -11,6 +11,7 @@ module Unison.Codebase.Editor.Input PatchPath, BranchIdG (..), BranchId, + BranchId2, AbsBranchId, UnresolvedProjectBranch, parseBranchId, @@ -68,7 +69,7 @@ data BranchIdG p | BranchAtProjectPath ProjectPath deriving stock (Eq, Show, Functor, Foldable, Traversable) -instance From p Text => From (BranchIdG p) Text where +instance (From p Text) => From (BranchIdG p) Text where from = \case BranchAtSCH h -> "#" <> SCH.toText h BranchAtPath p -> from p @@ -76,6 +77,8 @@ instance From p Text => From (BranchIdG p) Text where type BranchId = BranchIdG Path' +type BranchId2 = Either ShortCausalHash BranchRelativePath + type AbsBranchId = BranchIdG Path.Absolute -- | An unambiguous project branch name, use the current project name if not provided. @@ -119,7 +122,7 @@ data Input | -- merge first causal into destination MergeLocalBranchI BranchRelativePath (Maybe BranchRelativePath) Branch.MergeMode | PreviewMergeLocalBranchI BranchRelativePath (Maybe BranchRelativePath) - | DiffNamespaceI BranchId BranchId -- old new + | DiffNamespaceI BranchId2 BranchId2 -- old new | PullI !PullSourceTarget !PullMode | PushRemoteBranchI PushRemoteBranchInput | ResetRootI BranchId diff --git a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs index 06a71a19ae..116dbb60e7 100644 --- a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs +++ b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs @@ -39,15 +39,18 @@ data BranchRelativePath -- Specifying only a project is not allowed. -- -- >>> parseBranchRelativePath "foo" --- Right (LoosePath foo) +-- Right (UnqualifiedPath foo) -- >>> parseBranchRelativePath "foo/bar:" --- Right (BranchRelative (This (Right (UnsafeProjectName "foo",UnsafeProjectBranchName "bar")))) --- >>> parseBranchRelativePath "foo/bar:some.path" --- Right (BranchRelative (These (Right (UnsafeProjectName "foo",UnsafeProjectBranchName "bar")) some.path)) --- >>> parseBranchRelativePath "/bar:some.path" --- Right (BranchRelative (These (Left (UnsafeProjectBranchName "bar")) some.path)) --- >>> parseBranchRelativePath ":some.path" --- Right (BranchRelative (That some.path)) +-- Right (QualifiedBranchPath (UnsafeProjectName "foo") (UnsafeProjectBranchName "bar") .) +-- >>> parseBranchRelativePath "foo/bar:.some.path" +-- Right (QualifiedBranchPath (UnsafeProjectName "foo") (UnsafeProjectBranchName "bar") .some.path) +-- >>> parseBranchRelativePath "/bar:.some.path" +-- Right (BranchPathInCurrentProject (UnsafeProjectBranchName "bar") .some.path) +-- >>> parseBranchRelativePath ":.some.path" +-- Right (UnqualifiedPath .some.path) +-- +-- >>> parseBranchRelativePath ".branch" +-- Right (UnqualifiedPath .branch) parseBranchRelativePath :: String -> Either (P.Pretty CT.ColorText) BranchRelativePath parseBranchRelativePath str = case Megaparsec.parse branchRelativePathParser "" (Text.pack str) of @@ -85,7 +88,7 @@ data IncrementalBranchRelativePath IncompleteBranch (Maybe ProjectName) (Maybe ProjectBranchName) | -- | valid project/branch, with colon IncompletePath (Either (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName) (Maybe Path.Absolute) - | PathRelativeToCurrentBranch Path.Relative + | PathRelativeToCurrentBranch Path.Absolute deriving stock (Show) -- | @@ -169,7 +172,7 @@ incrementalBranchRelativePathParser = pathRelativeToCurrentBranch :: Megaparsec.Parsec Void Text IncrementalBranchRelativePath pathRelativeToCurrentBranch = do _ <- Megaparsec.char ':' - p <- relPath + p <- absPath pure (PathRelativeToCurrentBranch p) optionalEof :: Megaparsec.Parsec Void Text a -> Megaparsec.Parsec Void Text (Maybe a) @@ -180,12 +183,6 @@ incrementalBranchRelativePathParser = branchNameParser = Project.projectBranchNameParser False - relPath :: Megaparsec.Parsec Void Text Path.Relative - relPath = do - offset <- Megaparsec.getOffset - path' >>= \(Path.Path' inner) -> case inner of - Left _ -> failureAt offset "Expected a relative path but found an absolute path" - Right x -> pure x absPath :: Megaparsec.Parsec Void Text Path.Absolute absPath = do offset <- Megaparsec.getOffset @@ -228,7 +225,7 @@ branchRelativePathParser = OnlyPath' path -> pure (UnqualifiedPath path) IncompleteProject _proj -> fail "Branch relative paths require a branch. Expected `/` here." IncompleteBranch _mproj _mbranch -> fail "Branch relative paths require a colon. Expected `:` here." - PathRelativeToCurrentBranch p -> pure (UnqualifiedPath (Path.RelativePath' p)) + PathRelativeToCurrentBranch p -> pure (UnqualifiedPath (Path.AbsolutePath' p)) IncompletePath projStuff mpath -> case projStuff of Left (ProjectAndBranch projName branchName) -> diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index e9c35362a8..43ff94738b 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -252,7 +252,8 @@ formatStructuredArgument schLength = \case BranchAtPath pathPrefix -> Name.toText (Path.prefixNameIfRel (Path.AbsolutePath' pathPrefix) name) BranchAtProjectPath pp -> pp - & PP.absPath_ %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) + & PP.absPath_ + %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) & PP.toNames & into @Text @@ -489,7 +490,8 @@ handleBranchIdArg = BranchAtPath prefix -> BranchAtPath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name BranchAtProjectPath pp -> pp - & PP.absPath_ %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) + & PP.absPath_ + %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) & BranchAtProjectPath SA.Namespace hash -> pure . BranchAtSCH $ SCH.fromFullHash hash otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg @@ -529,7 +531,7 @@ _handleBranchIdOrProjectArg = (Right bid, Left _) -> Just (This bid) (Right bid, Right pr) -> Just (These bid pr) -handleBranchId2Arg :: I.Argument -> Either (P.Pretty P.ColorText) (Either ShortCausalHash BranchRelativePath) +handleBranchId2Arg :: I.Argument -> Either (P.Pretty P.ColorText) Input.BranchId2 handleBranchId2Arg = either Input.parseBranchId2 @@ -2201,8 +2203,8 @@ diffNamespace = ] ) ( \case - [before, after] -> Input.DiffNamespaceI <$> handleBranchIdArg before <*> handleBranchIdArg after - [before] -> Input.DiffNamespaceI <$> handleBranchIdArg before <*> pure (BranchAtPath Path.currentPath) + [before, after] -> Input.DiffNamespaceI <$> handleBranchId2Arg before <*> handleBranchId2Arg after + [before] -> Input.DiffNamespaceI <$> handleBranchId2Arg before <*> pure (Right . UnqualifiedPath $ Path.currentPath) _ -> Left $ I.help diffNamespace ) where @@ -3720,7 +3722,7 @@ projectAndOrBranchSuggestions config inputStr codebase _httpClient pp = do else branchCompletions ++ projectCompletions -- Complete the text into a branch name within the provided project - handleBranchesComplete :: MonadIO m => Text -> Codebase m v a -> PP.ProjectPath -> m [Completion] + handleBranchesComplete :: (MonadIO m) => Text -> Codebase m v a -> PP.ProjectPath -> m [Completion] handleBranchesComplete branchName codebase pp = do let projId = pp ^. #project . #projectId branches <- @@ -3821,9 +3823,8 @@ branchRelativePathSuggestions config inputStr codebase _httpClient pp = do fmap (filterBranches config pp) do Queries.loadAllProjectBranchesBeginningWith projectId (into @Text <$> mbranch) pure (map (projectBranchToCompletionWithSep projectName) branches) - BranchRelativePath.PathRelativeToCurrentBranch relPath -> Codebase.runTransaction codebase do - -- TODO: Verify this works as intended, might need to use an absolute path instead. - map prefixPathSep <$> prefixCompleteNamespace (Text.unpack . Path.toText' $ Path.RelativePath' relPath) pp + BranchRelativePath.PathRelativeToCurrentBranch absPath -> Codebase.runTransaction codebase do + map prefixPathSep <$> prefixCompleteNamespace (Text.unpack . Path.toText' $ Path.AbsolutePath' absPath) pp BranchRelativePath.IncompletePath projStuff mpath -> do Codebase.runTransaction codebase do map (addBranchPrefix projStuff) <$> prefixCompleteNamespace (maybe "" (Text.unpack . Path.toText' . Path.AbsolutePath') mpath) pp From b636068ebdd704b275fe5572dcf2236ea9ae39e7 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 1 Jul 2024 22:21:14 -0700 Subject: [PATCH 348/631] Partially update diff-namespace --- unison-src/transcripts/diff-namespace.md | 105 +++--- .../transcripts/diff-namespace.output.md | 328 ++++++++++++++---- 2 files changed, 326 insertions(+), 107 deletions(-) diff --git a/unison-src/transcripts/diff-namespace.md b/unison-src/transcripts/diff-namespace.md index 4d04dda791..1889966056 100644 --- a/unison-src/transcripts/diff-namespace.md +++ b/unison-src/transcripts/diff-namespace.md @@ -1,23 +1,32 @@ ```ucm:hide -.> builtins.merge +scratch/b1> builtins.merge lib.builtins +scratch/b2> builtins.merge lib.builtins +scratch/nsx> builtins.merge lib.builtins +scratch/main> builtins.merge lib.builtins ``` ```unison:hide -b1.x = 23 -b1.fslkdjflskdjflksjdf = 663 -b2.x = 23 -b2.fslkdjflskdjflksjdf = 23 -b2.abc = 23 +x = 23 +fslkdjflskdjflksjdf = 663 ``` ```ucm -.> add -.> debug.alias.term.force b1.x b1.fslkdjflskdjflksjdf +scratch/b1> add +``` + +```unison:hide +x = 23 +fslkdjflskdjflksjdf = 23 +abc = 23 +``` + +```ucm +scratch/b2> add +scratch/b1> debug.alias.term.force .x .fslkdjflskdjflksjdf ``` ```ucm -.> diff.namespace b1 b2 -.b2> diff.namespace .b1 +scratch/main> diff.namespace /b1: /b2: ``` Things we want to test: @@ -42,20 +51,20 @@ structural ability X a1 a2 where x : () ``` ```ucm -.ns1> add -.ns1> alias.term fromJust fromJust' -.ns1> alias.term helloWorld helloWorld2 -.ns1> fork .ns1 .ns2 +scratch/ns1> add +scratch/ns1> alias.term fromJust fromJust' +scratch/ns1> alias.term helloWorld helloWorld2 +scratch/ns1> branch /ns2 ``` Here's what we've done so far: ```ucm:error -.> diff.namespace nothing ns1 +scratch/main> diff.namespace .nothing /ns1: ``` ```ucm:error -.> diff.namespace ns1 ns2 +scratch/main> diff.namespace /ns1: ns2: ``` ```unison:hide @@ -63,9 +72,9 @@ junk = "asldkfjasldkfj" ``` ```ucm -.ns1> add -.ns1> debug.alias.term.force junk fromJust -.ns1> delete.term junk +scratch/ns1> add +scratch/ns1> debug.alias.term.force junk fromJust +scratch/ns1> delete.term junk ``` ```unison:hide @@ -78,25 +87,25 @@ unique type Y a b = Y a b ``` ```ucm -.ns2> update.old -.> diff.namespace ns1 ns2 -.> alias.term ns2.d ns2.d' -.> alias.type ns2.A ns2.A' -.> alias.type ns2.X ns2.X' -.> diff.namespace ns1 ns2 -.> alias.type ns1.X ns1.X2 -.> alias.type ns2.A' ns2.A'' -.> fork ns2 ns3 -.> alias.term ns2.fromJust' ns2.yoohoo -.> delete.term.verbose ns2.fromJust' -.> diff.namespace ns3 ns2 +scratch/ns2> update.old +scratch/main> diff.namespace /ns1: /ns2: +scratch/ns2> alias.term d d' +scratch/ns2> alias.type A A' +scratch/ns2> alias.type X X' +scratch/main> diff.namespace /ns1: /ns2: +scratch/ns1> alias.type X X2 +scratch/ns2> alias.type A' A'' +scratch/ns2> branch /ns3 +scratch/ns2> alias.term fromJust' yoohoo +scratch/ns2> delete.term.verbose fromJust' +scratch/main> diff.namespace /ns3: /ns2: ``` ```unison:hide bdependent = "banana" ``` ```ucm -.ns3> update.old -.> diff.namespace ns2 ns3 +scratch/ns3> update.old +scratch/main> diff.namespace /ns2: /ns3: ``` @@ -111,17 +120,18 @@ b = a + 1 ``` ```ucm -.nsx> add -.> fork nsx nsy -.> fork nsx nsz +scratch/nsx> add +scratch/nsx> branch /nsy +scratch/nsx> branch /nsz ``` ```unison:hide a = 444 +other = 555 ``` ```ucm -.nsy> update.old +scratch/nsy> update.old ``` ```unison:hide @@ -129,15 +139,16 @@ a = 555 ``` ```ucm -.nsz> update.old -.> fork nsy nsw -.> debug.alias.term.force nsz.a nsw.a -.> debug.alias.term.force nsz.b nsw.b +scratch/nsz> update.old +scratch/nsy> branch /nsw +scratch/nsw> debug.alias.term.force .other .a +scratch/nsw> delete.term .other +scratch/main> debug.alias.term.force /nsz:.b /nsw:.b ``` ```ucm -.> diff.namespace nsx nsw -.nsw> view a b +scratch/main> diff.namespace nsx nsw +scratch/main> view nsw.a nsw.b ``` ## Should be able to diff a namespace hash from history. @@ -147,7 +158,7 @@ x = 1 ``` ```ucm -.hashdiff> add +scratch/hashdiff> add ``` ```unison @@ -155,9 +166,9 @@ y = 2 ``` ```ucm -.hashdiff> add -.hashdiff> history -.hashdiff> diff.namespace 2 1 +scratch/hashdiff> add +scratch/hashdiff> history +scratch/hashdiff> diff.namespace 2 1 ``` ## diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md index 201a67c8b4..eda8a06712 100644 --- a/unison-src/transcripts/diff-namespace.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -1,55 +1,49 @@ ```unison -b1.x = 23 -b1.fslkdjflskdjflksjdf = 663 -b2.x = 23 -b2.fslkdjflskdjflksjdf = 23 -b2.abc = 23 +x = 23 +fslkdjflskdjflksjdf = 663 ``` ```ucm -.> add +scratch/b1> add ⍟ I've added these definitions: + + fslkdjflskdjflksjdf : Nat + x : Nat - b1.fslkdjflskdjflksjdf : Nat - b1.x : Nat - b2.abc : Nat - b2.fslkdjflskdjflksjdf : Nat - b2.x : Nat +``` +```unison +x = 23 +fslkdjflskdjflksjdf = 23 +abc = 23 +``` + +```ucm +scratch/b2> add + + ⍟ I've added these definitions: + + abc : Nat + fslkdjflskdjflksjdf : Nat + x : Nat -.> debug.alias.term.force b1.x b1.fslkdjflskdjflksjdf +scratch/b1> debug.alias.term.force .x .fslkdjflskdjflksjdf Done. ``` ```ucm -.> diff.namespace b1 b2 +scratch/main> diff.namespace /b1: /b2: Resolved name conflicts: - + 1. ┌ fslkdjflskdjflksjdf#sekb3fdsvb : Nat 2. └ fslkdjflskdjflksjdf#u520d1t9kc : Nat ↓ 3. fslkdjflskdjflksjdf#u520d1t9kc : Nat - + Name changes: - - Original Changes - 4. x ┐ 5. abc (added) - 6. fslkdjflskdjflksjdf#u520d1t9kc ┘ 7. fslkdjflskdjflksjdf (added) - 8. fslkdjflskdjflksjdf#u520d1t9kc (removed) - -.b2> diff.namespace .b1 - - Resolved name conflicts: - - 1. ┌ fslkdjflskdjflksjdf#sekb3fdsvb : ##Nat - 2. └ fslkdjflskdjflksjdf#u520d1t9kc : ##Nat - ↓ - 3. fslkdjflskdjflksjdf#u520d1t9kc : ##Nat - - Name changes: - + Original Changes 4. x ┐ 5. abc (added) 6. fslkdjflskdjflksjdf#u520d1t9kc ┘ 7. fslkdjflskdjflksjdf (added) @@ -79,12 +73,10 @@ structural ability X a1 a2 where x : () ``` ```ucm - ☝️ The namespace .ns1 is empty. - -.ns1> add +scratch/ns1> add ⍟ I've added these definitions: - + structural type A a structural ability X a1 a2 b : ##Nat @@ -93,33 +85,42 @@ structural ability X a1 a2 where x : () fromJust : ##Nat helloWorld : ##Text -.ns1> alias.term fromJust fromJust' +scratch/ns1> alias.term fromJust fromJust' Done. -.ns1> alias.term helloWorld helloWorld2 +scratch/ns1> alias.term helloWorld helloWorld2 Done. -.ns1> fork .ns1 .ns2 +scratch/ns1> branch /ns2 - Done. + Done. I've created the ns2 branch based off of ns1. + + Tip: To merge your work back into the ns1 branch, first + `switch /ns1` then `merge /ns2`. ``` Here's what we've done so far: ```ucm -.> diff.namespace nothing ns1 +scratch/main> diff.namespace .nothing /ns1: ⚠️ - - The namespace .nothing is empty. Was there a typo? + + The namespace scratch/main:.nothing is empty. Was there a typo? ``` ```ucm -.> diff.namespace ns1 ns2 +scratch/main> diff.namespace /ns1: ns2: + +:1:4: + | +1 | ns2: + | ^ +unexpected ':' +expecting '/' or end of input - The namespaces are identical. ``` ```unison @@ -127,17 +128,17 @@ junk = "asldkfjasldkfj" ``` ```ucm -.ns1> add +scratch/ns1> add ⍟ I've added these definitions: - + junk : ##Text -.ns1> debug.alias.term.force junk fromJust +scratch/ns1> debug.alias.term.force junk fromJust Done. -.ns1> delete.term junk +scratch/ns1> delete.term junk Done. @@ -152,31 +153,235 @@ unique type Y a b = Y a b ``` ```ucm -.ns2> update.old +scratch/ns2> update.old ⍟ I've added these definitions: - + type Y a b d : ##Nat e : ##Nat f : ##Nat - + ⍟ I've updated these names to your new definition: - + b : ##Text fromJust : ##Nat (The old definition was also named fromJust'.) -.> diff.namespace ns1 ns2 +scratch/main> diff.namespace /ns1: /ns2: - ⚠️ + Resolved name conflicts: + + 1. ┌ fromJust#gjmq673r1v : Nat + 2. └ fromJust#rnbo52q2sh : Text + ↓ + 3. fromJust#6gn1k53ie0 : Nat + + Updates: + + 4. b : Nat + ↓ + 5. b : Text + + 6. fromJust' : Nat + ↓ + 7. fromJust' : Nat + + Added definitions: + + 8. type Y a b + 9. Y.Y : a -> b -> #md85ksgqel a b + 10. d : Nat + 11. e : Nat + 12. f : Nat + + 13. patch patch (added 2 updates) + +scratch/ns2> alias.term d d' + + Done. + +scratch/ns2> alias.type A A' + + Done. + +scratch/ns2> alias.type X X' + + Done. + +scratch/main> diff.namespace /ns1: /ns2: + + Resolved name conflicts: + + 1. ┌ fromJust#gjmq673r1v : Nat + 2. └ fromJust#rnbo52q2sh : Text + ↓ + 3. fromJust#6gn1k53ie0 : Nat + + Updates: + + 4. b : Nat + ↓ + 5. b : Text + + 6. fromJust' : Nat + ↓ + 7. fromJust' : Nat + + Added definitions: + + 8. type Y a b + 9. Y.Y : a -> b -> #md85ksgqel a b + 10. ┌ d : Nat + 11. └ d' : Nat + 12. e : Nat + 13. f : Nat + + 14. patch patch (added 2 updates) + + Name changes: + + Original Changes + 15. A 16. A' (added) + + 17. X 18. X' (added) + +scratch/ns1> alias.type X X2 + + Done. + +scratch/ns2> alias.type A' A'' + + Done. + +scratch/ns2> branch /ns3 + + Done. I've created the ns3 branch based off of ns2. + + Tip: To merge your work back into the ns2 branch, first + `switch /ns2` then `merge /ns3`. + +scratch/ns2> alias.term fromJust' yoohoo - The namespace .ns1 is empty. Was there a typo? + Done. + +scratch/ns2> delete.term.verbose fromJust' + + Name changes: + + Original Changes + 1. fromJust ┐ 2. fromJust' (removed) + 3. fromJust' │ + 4. yoohoo ┘ + + Tip: You can use `undo` or `reflog` to undo this change. + +scratch/main> diff.namespace /ns3: /ns2: + + Name changes: + + Original Changes + 1. fromJust ┐ 2. yoohoo (added) + 3. fromJust' ┘ 4. fromJust' (removed) + +``` +```unison +bdependent = "banana" +``` + +```ucm +scratch/ns3> update.old + + ⍟ I've updated these names to your new definition: + + bdependent : ##Text + +scratch/main> diff.namespace /ns2: /ns3: + + Updates: + + 1. bdependent : Nat + ↓ + 2. bdependent : Text + + 3. patch patch (added 1 updates) + + Name changes: + + Original Changes + 4. fromJust ┐ 5. fromJust' (added) + 6. yoohoo ┘ 7. yoohoo (removed) + +``` +## Two different auto-propagated changes creating a name conflict + +Currently, the auto-propagated name-conflicted definitions are not explicitly +shown, only their also-conflicted dependency is shown. + +```unison +a = 333 +b = a + 1 +``` + +```ucm +scratch/nsx> add + ⍟ I've added these definitions: + + a : Nat + b : Nat + +scratch/nsx> branch /nsy + + Done. I've created the nsy branch based off of nsx. + + Tip: To merge your work back into the nsx branch, first + `switch /nsx` then `merge /nsy`. + +scratch/nsx> branch /nsz + + Done. I've created the nsz branch based off of nsx. + + Tip: To merge your work back into the nsx branch, first + `switch /nsx` then `merge /nsz`. + +``` +```unison +a = 444 ``` ```ucm -.ns2> update.old.> diff.namespace ns1 ns2.> alias.term ns2.d ns2.d'.> alias.type ns2.A ns2.A'.> alias.type ns2.X ns2.X'.> diff.namespace ns1 ns2.> alias.type ns1.X ns1.X2.> alias.type ns2.A' ns2.A''.> fork ns2 ns3.> alias.term ns2.fromJust' ns2.yoohoo.> delete.term.verbose ns2.fromJust'.> diff.namespace ns3 ns2 +scratch/nsy> update.old + + ⍟ I've updated these names to your new definition: + + a : Nat + +``` +```unison +a = 555 +``` + +```ucm +scratch/nsz> update.old + + ⍟ I've updated these names to your new definition: + + a : Nat + +scratch/nsy> branch /nsw + + Done. I've created the nsw branch based off of nsy. + + Tip: To merge your work back into the nsy branch, first + `switch /nsy` then `merge /nsw`. + +scratch/main> debug.alias.term.force /nsz:.a /nsw:.a + +``` + +```ucm +scratch/nsz> update.oldscratch/nsy> branch /nswscratch/main> debug.alias.term.force /nsz:.a /nsw:.ascratch/main> debug.alias.term.force /nsz:.b /nsw:.b ``` @@ -184,7 +389,10 @@ unique type Y a b = Y a b The transcript failed due to an error in the stanza above. The error is: +1:2: + | +1 | /nsz:.a + | ^ +unexpected 'n' +expecting '.', end of input, hash (ex: #af3sj3), or operator (valid characters: !$%&*+-/:<=>\^|~) - ⚠️ - - The namespace .ns1 is empty. Was there a typo? From 6f19a87497027cbd5c40f9541d00e7ced308781d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 1 Jul 2024 23:35:58 -0700 Subject: [PATCH 349/631] Update merge.md and fix5129 --- unison-src/transcripts-using-base/fix5129.md | 2 +- unison-src/transcripts/merge.md | 14 ++++++-------- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/unison-src/transcripts-using-base/fix5129.md b/unison-src/transcripts-using-base/fix5129.md index ccdd8bee41..a1e8ad3450 100644 --- a/unison-src/transcripts-using-base/fix5129.md +++ b/unison-src/transcripts-using-base/fix5129.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.mergeio +scratch/main> builtins.mergeio lib.builtins ``` Checks for some bad type checking behavior. Some ability subtyping was diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 6dfb48d04e..3948471c20 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -464,7 +464,7 @@ project/main> merge /topic ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## Merge failure: someone deleted something @@ -962,7 +962,7 @@ project/alice> merge bob ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## `merge.commit` example (success) @@ -971,7 +971,6 @@ After merge conflicts are resolved, you can use `merge.commit` rather than `swit "commit" your changes. ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio lib.builtins ``` @@ -1028,7 +1027,7 @@ project/alice> branches ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ## `merge.commit` example (failure) @@ -1036,7 +1035,6 @@ project/alice> branches `merge.commit` can only be run on a "merge branch". ```ucm:hide -.> project.create-empty project project/main> builtins.mergeio lib.builtins ``` @@ -1049,7 +1047,7 @@ project/topic> merge.commit ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` @@ -1527,7 +1525,7 @@ project/main> view Foo ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Dependent that doesn't need to be in the file @@ -1592,7 +1590,7 @@ project/alice> merge /bob But `bar` was put into the scratch file instead. ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Merge loop test From 983fb054bd2d9e4489aad2d861916e98d6536699 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 1 Jul 2024 23:41:02 -0700 Subject: [PATCH 350/631] Port move-namespace to projects --- unison-src/transcripts/move-namespace.md | 25 ++++----- .../transcripts/move-namespace.output.md | 51 ++++++++++--------- 2 files changed, 37 insertions(+), 39 deletions(-) diff --git a/unison-src/transcripts/move-namespace.md b/unison-src/transcripts/move-namespace.md index 0d1c7ba3e5..6de80330e8 100644 --- a/unison-src/transcripts/move-namespace.md +++ b/unison-src/transcripts/move-namespace.md @@ -10,34 +10,31 @@ foo = 1 ``` ```ucm -.> add --- Should request confirmation -.> move.namespace . .root.at.path -.> move.namespace . .root.at.path -.> ls -.> history +scratch/main> add +scratch/main> move.namespace . .root.at.path +scratch/main> ls +scratch/main> history ``` ```ucm -.> ls .root.at.path -.> history .root.at.path +scratch/main> ls .root.at.path +scratch/main> history .root.at.path ``` I should be able to move a sub namespace _over_ the root. ```ucm -- Should request confirmation -.> move.namespace .root.at.path . -.> move.namespace .root.at.path . -.> ls -.> history +scratch/main> move.namespace .root.at.path . +scratch/main> ls +scratch/main> history ``` ```ucm:error -- should be empty -.> ls .root.at.path -.> history .root.at.path +scratch/main> ls .root.at.path +scratch/main> history .root.at.path ``` ```ucm:hide diff --git a/unison-src/transcripts/move-namespace.output.md b/unison-src/transcripts/move-namespace.output.md index 257365dbdc..3ac591c420 100644 --- a/unison-src/transcripts/move-namespace.output.md +++ b/unison-src/transcripts/move-namespace.output.md @@ -10,29 +10,21 @@ foo = 1 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: foo : ##Nat --- Should request confirmation -.> move.namespace . .root.at.path - - ⚠️ - - Moves which affect the root branch cannot be undone, are you sure? - Re-run the same command to proceed. - -.> move.namespace . .root.at.path +scratch/main> move.namespace . .root.at.path Done. -.> ls +scratch/main> ls 1. root/ (1 term) -.> history +scratch/main> history Note: The most recent namespace hash is immediately below this message. @@ -43,11 +35,11 @@ foo = 1 ``` ```ucm -.> ls .root.at.path +scratch/main> ls .root.at.path 1. foo (##Nat) -.> history .root.at.path +scratch/main> history .root.at.path Note: The most recent namespace hash is immediately below this message. @@ -61,22 +53,21 @@ I should be able to move a sub namespace _over_ the root. ```ucm -- Should request confirmation -.> move.namespace .root.at.path . +scratch/main> move.namespace .root.at.path . ⚠️ - Moves which affect the root branch cannot be undone, are you sure? - Re-run the same command to proceed. - -.> move.namespace .root.at.path . + A branch existed at the destination: . so I over-wrote it. + + Tip: You can use `undo` or `reflog` to undo this change. Done. -.> ls +scratch/main> ls 1. foo (##Nat) -.> history +scratch/main> history Note: The most recent namespace hash is immediately below this message. @@ -88,13 +79,18 @@ I should be able to move a sub namespace _over_ the root. ``` ```ucm -- should be empty -.> ls .root.at.path +scratch/main> ls .root.at.path nothing to show -.> history .root.at.path +scratch/main> history .root.at.path - ☝️ The namespace .root.at.path is empty. + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) ``` ## Happy path @@ -280,7 +276,12 @@ scratch/history> history b -- Should be empty scratch/history> history a - ☝️ The namespace a is empty. + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) ``` ## Moving over an existing branch From f0c53eed282698d0c4cb951548c9b275a71aea65 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 2 Jul 2024 11:39:11 -0400 Subject: [PATCH 351/631] show "defs in lib" merge precondition violation in `todo` output --- .../src/Unison/Codebase/Causal.hs | 5 +- .../Codebase/Editor/HandleInput/Merge2.hs | 22 +++-- .../Codebase/Editor/HandleInput/Todo.hs | 22 ++++- .../src/Unison/Codebase/Editor/Output.hs | 4 +- .../src/Unison/CommandLine/OutputMessages.hs | 23 +++-- unison-src/transcripts/todo.md | 68 ++++++++++--- unison-src/transcripts/todo.output.md | 97 +++++++++++++++++-- 7 files changed, 199 insertions(+), 42 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Causal.hs b/parser-typechecker/src/Unison/Codebase/Causal.hs index 8cca62cf05..9bdd089032 100644 --- a/parser-typechecker/src/Unison/Codebase/Causal.hs +++ b/parser-typechecker/src/Unison/Codebase/Causal.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} module Unison.Codebase.Causal - ( Causal (currentHash, head, tail, tails), + ( Causal (currentHash, valueHash, head, tail, tails), pattern One, pattern Cons, pattern Merge, @@ -40,7 +40,8 @@ import Unison.Codebase.Causal.Type currentHash, head, tail, - tails + tails, + valueHash ), before, lca, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index ceee0aa836..9289a692dd 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -8,6 +8,9 @@ module Unison.Codebase.Editor.HandleInput.Merge2 LcaMergeInfo (..), doMerge, doMergeLocalBranch, + + -- * API exported for @todo@ + hasDefnsInLib, ) where @@ -85,6 +88,7 @@ import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.EitherWayI (EitherWayI (..)) import Unison.Merge.EitherWayI qualified as EitherWayI import Unison.Merge.Libdeps qualified as Merge +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs) import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.Synhashed qualified as Synhashed @@ -138,7 +142,6 @@ import Unison.Util.SyntaxText (SyntaxText') import Unison.Var (Var) import Witch (unsafeFrom) import Prelude hiding (unzip, zip, zipWith) -import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do @@ -238,11 +241,7 @@ doMerge info = do -- Assert that neither Alice nor Bob have defns in lib for_ [(mergeTarget, branches.alice), (mergeSource, branches.bob)] \(who, branch) -> do - libdeps <- - case Map.lookup NameSegment.libSegment branch.children of - Nothing -> pure V2.Branch.empty - Just libdeps -> Cli.runTransaction libdeps.value - when (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) do + whenM (Cli.runTransaction (hasDefnsInLib branch)) do done (Output.MergeDefnsInLib who) -- Load Alice/Bob/LCA definitions and decl name lookups @@ -485,6 +484,17 @@ loadLibdeps branches = do libdepsBranch <- libdepsCausal.value pure libdepsBranch.children +------------------------------------------------------------------------------------------------------------------------ +-- Merge precondition violation checks + +hasDefnsInLib :: Applicative m => V2.Branch m -> m Bool +hasDefnsInLib branch = do + libdeps <- + case Map.lookup NameSegment.libSegment branch.children of + Nothing -> pure V2.Branch.empty + Just libdeps -> libdeps.value + pure (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) + ------------------------------------------------------------------------------------------------------------------------ -- Creating Unison files diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index 1a8ccf64f3..ef58f044b1 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -5,6 +5,7 @@ module Unison.Codebase.Editor.HandleInput.Todo where import Data.Set qualified as Set +import U.Codebase.HashTags (BranchHash (..)) import U.Codebase.Sqlite.Operations qualified as Operations import Unison.Builtin qualified as Builtin import Unison.Cli.Monad (Cli) @@ -14,7 +15,10 @@ import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Causal qualified as Causal +import Unison.Codebase.Editor.HandleInput.Merge2 (hasDefnsInLib) import Unison.Codebase.Editor.Output +import Unison.Hash (HashFor (..)) import Unison.Names qualified as Names import Unison.Prelude import Unison.Reference (TermReference) @@ -26,11 +30,22 @@ handleTodo :: Cli () handleTodo = do -- For now, we don't go through any great trouble to seek out the root of the project branch. Just assume the current -- namespace is the root, which will be the case unless the user uses `deprecated.cd`. - currentNamespace <- Cli.getCurrentBranch0 + currentCausal <- Cli.getCurrentBranch + let currentNamespace = Branch.head currentCausal let currentNamespaceWithoutLibdeps = Branch.deleteLibdeps currentNamespace - (dependentsOfTodo, directDependencies, hashLen) <- + (defnsInLib, dependentsOfTodo, directDependencies, hashLen) <- Cli.runTransaction do + -- We call a shared `hasDefnsLib` helper even though we could easily duplicate the logic with the branch in hand + defnsInLib <- do + branch <- + currentCausal + & Branch._history + & Causal.valueHash + & coerce @_ @BranchHash + & Operations.expectBranchByBranchHash + hasDefnsInLib branch + let todoReference :: TermReference todoReference = Set.asSingleton (Names.refTermsNamed Builtin.names (Name.unsafeParseText "todo")) @@ -51,7 +66,7 @@ handleTodo = do hashLen <- Codebase.hashLength - pure (dependentsOfTodo.terms, directDependencies, hashLen) + pure (defnsInLib, dependentsOfTodo.terms, directDependencies, hashLen) ppe <- Cli.currentPrettyPrintEnvDecl @@ -59,6 +74,7 @@ handleTodo = do Output'Todo TodoOutput { hashLen, + defnsInLib, dependentsOfTodo, directDependenciesWithoutNames = Defns diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 1534f42d0f..7ee842a073 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -153,7 +153,8 @@ data NumberedOutput (Map LabeledDependency (Set Name)) -- Mapping of external dependencies to their local dependents. data TodoOutput = TodoOutput - { dependentsOfTodo :: !(Set TermReferenceId), + { defnsInLib :: !Bool, + dependentsOfTodo :: !(Set TermReferenceId), directDependenciesWithoutNames :: !(DefnsF Set TermReference TypeReference), hashLen :: !Int, nameConflicts :: !Names, @@ -165,6 +166,7 @@ todoOutputIsEmpty todo = Set.null todo.dependentsOfTodo && defnsAreEmpty todo.directDependenciesWithoutNames && Names.isEmpty todo.nameConflicts + && not todo.defnsInLib data AmbiguousReset'Argument = AmbiguousReset'Hash diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index f17f483adf..0e3b93e5cb 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1423,6 +1423,7 @@ notifyUser dir = \case P.wrap $ "On" <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + -- Note [DefnsInLibMessage] If you change this, also change the other similar one <> "there's a type or term at the top level of the `lib` namespace, where I only expect to find" <> "subnamespaces representing library dependencies.", "", @@ -2665,11 +2666,6 @@ handleTodoOutput :: TodoOutput -> Numbered Pretty handleTodoOutput todo | todoOutputIsEmpty todo = pure "You have no pending todo items. Good work! ✅" | otherwise = do - prettyConflicts <- - if todo.nameConflicts == mempty - then pure mempty - else renderNameConflicts todo.ppe.unsuffixifiedPPE todo.nameConflicts - prettyDependentsOfTodo <- do if Set.null todo.dependentsOfTodo then pure mempty @@ -2718,11 +2714,26 @@ handleTodoOutput todo <> P.newline <> P.indentN 2 (P.lines types) + prettyConflicts <- + if todo.nameConflicts == mempty + then pure mempty + else renderNameConflicts todo.ppe.unsuffixifiedPPE todo.nameConflicts + + let prettyDefnsInLib = + if todo.defnsInLib + then + P.wrap $ + -- Note [DefnsInLibMessage] If you change this, also change the other similar one + "There's a type or term at the top level of the `lib` namespace, where I only expect to find" + <> "subnamespaces representing library dependencies. Please move or remove it." + else mempty + (pure . P.sep "\n\n" . P.nonEmpty) [ prettyDependentsOfTodo, prettyDirectTermDependenciesWithoutNames, prettyDirectTypeDependenciesWithoutNames, - prettyConflicts + prettyConflicts, + prettyDefnsInLib ] listOfDefinitions :: diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md index b86a36e209..25f99aa401 100644 --- a/unison-src/transcripts/todo.md +++ b/unison-src/transcripts/todo.md @@ -3,19 +3,15 @@ When there's nothing to do, `todo` says this: ```ucm -project/main> todo +scratch/main> todo ``` -# Conflicted names - -The todo command shows conflicted names (not demonstrated here yet because it is not easy to create them for tests, yet). - # Dependents of `todo` The `todo` command shows local (outside `lib`) terms that directly call `todo`. ```ucm:hide -project/main> builtins.mergeio lib.builtins +scratch/main> builtins.mergeio lib.builtins ``` ```unison @@ -27,12 +23,12 @@ bar = foo + foo ``` ```ucm -project/main> add -project/main> todo +scratch/main> add +scratch/main> todo ``` ```ucm:hide -project/main> delete.project project +scratch/main> delete.project scratch ``` # Direct dependencies without names @@ -41,7 +37,7 @@ The `todo` command shows hashes of direct dependencies of local (outside `lib`) the current namespace. ```ucm:hide -project/main> builtins.mergeio lib.builtins +scratch/main> builtins.mergeio lib.builtins ``` ```unison @@ -50,11 +46,55 @@ baz = foo.bar + foo.bar ``` ```ucm -project/main> add -project/main> delete.namespace.force foo -project/main> todo +scratch/main> add +scratch/main> delete.namespace.force foo +scratch/main> todo +``` + +```ucm:hide +scratch/main> delete.project scratch +``` + +# Conflicted names + +The `todo` command shows conflicted names. + +```ucm:hide +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +foo = 16 +bar = 17 +``` + +```ucm +scratch/main> add +scratch/main> debug.alias.term.force foo bar +scratch/main> todo +``` + +```ucm:hide +scratch/main> delete.project scratch +``` + +# Definitions in lib + +The `todo` command complains about terms and types directly in `lib`. + +```ucm:hide +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +lib.foo = 16 +``` + +```ucm +scratch/main> add +scratch/main> todo ``` ```ucm:hide -project/main> delete.project project +scratch/main> delete.project scratch ``` diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index cfad74ec15..07f0b03c33 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -3,15 +3,11 @@ When there's nothing to do, `todo` says this: ```ucm -project/main> todo +scratch/main> todo You have no pending todo items. Good work! ✅ ``` -# Conflicted names - -The todo command shows conflicted names (not demonstrated here yet because it is not easy to create them for tests, yet). - # Dependents of `todo` The `todo` command shows local (outside `lib`) terms that directly call `todo`. @@ -39,14 +35,14 @@ bar = foo + foo ``` ```ucm -project/main> add +scratch/main> add ⍟ I've added these definitions: bar : Nat foo : Nat -project/main> todo +scratch/main> todo These terms call `todo`: @@ -78,14 +74,14 @@ baz = foo.bar + foo.bar ``` ```ucm -project/main> add +scratch/main> add ⍟ I've added these definitions: baz : Nat foo.bar : Nat -project/main> delete.namespace.force foo +scratch/main> delete.namespace.force foo Done. @@ -97,10 +93,91 @@ project/main> delete.namespace.force foo Dependency Referenced In bar 1. baz -project/main> todo +scratch/main> todo These terms do not have any names in the current namespace: 1. #1jujb8oelv ``` +# Conflicted names + +The `todo` command shows conflicted names. + +```unison +foo = 16 +bar = 17 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bar : Nat + foo : Nat + +``` +```ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat + +scratch/main> debug.alias.term.force foo bar + + Done. + +scratch/main> todo + + ❓ + + The term bar has conflicting definitions: 1. foo 2. + bar#cq22mm4sca + + Tip: Use `move.term` or `delete.term` to resolve the + conflicts. + +``` +# Definitions in lib + +The `todo` command complains about terms and types directly in `lib`. + +```unison +lib.foo = 16 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + lib.foo : Nat + +``` +```ucm +scratch/main> add + + ⍟ I've added these definitions: + + lib.foo : Nat + +scratch/main> todo + + There's a type or term at the top level of the `lib` + namespace, where I only expect to find subnamespaces + representing library dependencies. Please move or remove it. + +``` From eb1ee64cf2bd66d405f025d28d9e1390e5b5dc43 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 2 Jul 2024 12:23:34 -0400 Subject: [PATCH 352/631] merge unison-util-nametree into unison-core1 --- codebase2/codebase-sqlite/package.yaml | 2 +- .../unison-codebase-sqlite.cabal | 2 +- contrib/cabal.project | 1 - lib/unison-util-nametree/package.yaml | 56 --------------- .../unison-util-nametree.cabal | 68 ------------------- parser-typechecker/package.yaml | 1 - .../unison-parser-typechecker.cabal | 4 +- stack.yaml | 1 - unison-cli/package.yaml | 1 - unison-cli/unison-cli.cabal | 3 - unison-core/package.yaml | 7 +- .../src/Unison/Util/Defns.hs | 0 .../src/Unison/Util/Nametree.hs | 0 unison-core/unison-core1.cabal | 14 +++- unison-merge/package.yaml | 1 - unison-merge/unison-merge.cabal | 1 - 16 files changed, 21 insertions(+), 141 deletions(-) delete mode 100644 lib/unison-util-nametree/package.yaml delete mode 100644 lib/unison-util-nametree/unison-util-nametree.cabal rename {lib/unison-util-nametree => unison-core}/src/Unison/Util/Defns.hs (100%) rename {lib/unison-util-nametree => unison-core}/src/Unison/Util/Nametree.hs (100%) diff --git a/codebase2/codebase-sqlite/package.yaml b/codebase2/codebase-sqlite/package.yaml index bf0bed4ee4..3f6006ff0c 100644 --- a/codebase2/codebase-sqlite/package.yaml +++ b/codebase2/codebase-sqlite/package.yaml @@ -31,6 +31,7 @@ dependencies: - unison-codebase - unison-codebase-sync - unison-core + - unison-core1 - unison-core-orphans-sqlite - unison-hash - unison-hash-orphans-sqlite @@ -39,7 +40,6 @@ dependencies: - unison-util-base32hex - unison-util-cache - unison-util-file-embed - - unison-util-nametree - unison-util-serialization - unison-util-term - unliftio diff --git a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal index b91e2a51a1..886a47a510 100644 --- a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal +++ b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal @@ -126,6 +126,7 @@ library , unison-codebase-sync , unison-core , unison-core-orphans-sqlite + , unison-core1 , unison-hash , unison-hash-orphans-sqlite , unison-prelude @@ -133,7 +134,6 @@ library , unison-util-base32hex , unison-util-cache , unison-util-file-embed - , unison-util-nametree , unison-util-serialization , unison-util-term , unliftio diff --git a/contrib/cabal.project b/contrib/cabal.project index abab30e92e..246669424d 100644 --- a/contrib/cabal.project +++ b/contrib/cabal.project @@ -24,7 +24,6 @@ packages: lib/unison-util-relation lib/unison-util-rope lib/unison-util-file-embed - lib/unison-util-nametree parser-typechecker unison-core diff --git a/lib/unison-util-nametree/package.yaml b/lib/unison-util-nametree/package.yaml deleted file mode 100644 index fdac7c5760..0000000000 --- a/lib/unison-util-nametree/package.yaml +++ /dev/null @@ -1,56 +0,0 @@ -name: unison-util-nametree -github: unisonweb/unison -copyright: Copyright (C) 2013-2018 Unison Computing, PBC and contributors - -ghc-options: -Wall - -dependencies: - - base - - containers - - lens - - semialign - - semigroups - - these - - unison-core - - unison-core1 - - unison-prelude - - unison-util-relation - -library: - source-dirs: src - when: - - condition: false - other-modules: Paths_unison_util_nametree - -default-extensions: - - BangPatterns - - BlockArguments - - DeriveAnyClass - - DeriveFoldable - - DeriveFunctor - - DeriveGeneric - - DeriveTraversable - - DerivingStrategies - - DerivingVia - - DoAndIfThenElse - - DuplicateRecordFields - - FlexibleContexts - - FlexibleInstances - - GADTs - - GeneralizedNewtypeDeriving - - ImportQualifiedPost - - InstanceSigs - - LambdaCase - - MultiParamTypeClasses - - MultiWayIf - - NamedFieldPuns - - NumericUnderscores - - OverloadedLabels - - OverloadedRecordDot - - OverloadedStrings - - PatternSynonyms - - RankNTypes - - ScopedTypeVariables - - TupleSections - - TypeApplications - - ViewPatterns diff --git a/lib/unison-util-nametree/unison-util-nametree.cabal b/lib/unison-util-nametree/unison-util-nametree.cabal deleted file mode 100644 index 80d3157ee3..0000000000 --- a/lib/unison-util-nametree/unison-util-nametree.cabal +++ /dev/null @@ -1,68 +0,0 @@ -cabal-version: 1.12 - --- This file has been generated from package.yaml by hpack version 0.36.0. --- --- see: https://github.com/sol/hpack - -name: unison-util-nametree -version: 0.0.0 -homepage: https://github.com/unisonweb/unison#readme -bug-reports: https://github.com/unisonweb/unison/issues -copyright: Copyright (C) 2013-2018 Unison Computing, PBC and contributors -build-type: Simple - -source-repository head - type: git - location: https://github.com/unisonweb/unison - -library - exposed-modules: - Unison.Util.Defns - Unison.Util.Nametree - hs-source-dirs: - src - default-extensions: - BangPatterns - BlockArguments - DeriveAnyClass - DeriveFoldable - DeriveFunctor - DeriveGeneric - DeriveTraversable - DerivingStrategies - DerivingVia - DoAndIfThenElse - DuplicateRecordFields - FlexibleContexts - FlexibleInstances - GADTs - GeneralizedNewtypeDeriving - ImportQualifiedPost - InstanceSigs - LambdaCase - MultiParamTypeClasses - MultiWayIf - NamedFieldPuns - NumericUnderscores - OverloadedLabels - OverloadedRecordDot - OverloadedStrings - PatternSynonyms - RankNTypes - ScopedTypeVariables - TupleSections - TypeApplications - ViewPatterns - ghc-options: -Wall - build-depends: - base - , containers - , lens - , semialign - , semigroups - , these - , unison-core - , unison-core1 - , unison-prelude - , unison-util-relation - default-language: Haskell2010 diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml index 8bb50c5183..c9de6f37d4 100644 --- a/parser-typechecker/package.yaml +++ b/parser-typechecker/package.yaml @@ -127,7 +127,6 @@ dependencies: - unison-util-base32hex - unison-util-bytes - unison-util-cache - - unison-util-nametree - unison-util-relation - unison-util-rope - unison-util-serialization diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 7a9a467093..61b4ad037b 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -330,7 +330,6 @@ library , unison-util-base32hex , unison-util-bytes , unison-util-cache - , unison-util-nametree , unison-util-relation , unison-util-rope , unison-util-serialization @@ -532,7 +531,6 @@ test-suite parser-typechecker-tests , unison-util-base32hex , unison-util-bytes , unison-util-cache - , unison-util-nametree , unison-util-relation , unison-util-rope , unison-util-serialization diff --git a/stack.yaml b/stack.yaml index ff76c60ea6..477547cab2 100644 --- a/stack.yaml +++ b/stack.yaml @@ -29,7 +29,6 @@ packages: - lib/unison-util-bytes - lib/unison-util-cache - lib/unison-util-file-embed - - lib/unison-util-nametree - lib/unison-util-relation - lib/unison-util-rope - parser-typechecker diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index 3402e98c92..923d0c7ae9 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -93,7 +93,6 @@ dependencies: - unison-sqlite - unison-syntax - unison-util-base32hex - - unison-util-nametree - unison-util-relation - unliftio - unordered-containers diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index dd26e4321e..a8b8202763 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -266,7 +266,6 @@ library , unison-sqlite , unison-syntax , unison-util-base32hex - , unison-util-nametree , unison-util-relation , unliftio , unordered-containers @@ -410,7 +409,6 @@ executable transcripts , unison-sqlite , unison-syntax , unison-util-base32hex - , unison-util-nametree , unison-util-relation , unliftio , unordered-containers @@ -558,7 +556,6 @@ test-suite cli-tests , unison-sqlite , unison-syntax , unison-util-base32hex - , unison-util-nametree , unison-util-relation , unliftio , unordered-containers diff --git a/unison-core/package.yaml b/unison-core/package.yaml index 210367d234..fb5b62b734 100644 --- a/unison-core/package.yaml +++ b/unison-core/package.yaml @@ -24,6 +24,8 @@ library: - mtl - rfc5051 - safe + - semialign + - semigroups - text - text-builder - these @@ -54,7 +56,7 @@ tests: source-dirs: test default-extensions: - - ApplicativeDo + - BangPatterns - BlockArguments - DeriveAnyClass - DeriveFoldable @@ -62,17 +64,20 @@ default-extensions: - DeriveGeneric - DeriveTraversable - DerivingStrategies + - DerivingVia - DoAndIfThenElse - FlexibleContexts - FlexibleInstances - GADTs - GeneralizedNewtypeDeriving - ImportQualifiedPost + - InstanceSigs - KindSignatures - LambdaCase - MultiParamTypeClasses - NamedFieldPuns - OverloadedStrings + - OverloadedRecordDot - PatternSynonyms - RankNTypes - ScopedTypeVariables diff --git a/lib/unison-util-nametree/src/Unison/Util/Defns.hs b/unison-core/src/Unison/Util/Defns.hs similarity index 100% rename from lib/unison-util-nametree/src/Unison/Util/Defns.hs rename to unison-core/src/Unison/Util/Defns.hs diff --git a/lib/unison-util-nametree/src/Unison/Util/Nametree.hs b/unison-core/src/Unison/Util/Nametree.hs similarity index 100% rename from lib/unison-util-nametree/src/Unison/Util/Nametree.hs rename to unison-core/src/Unison/Util/Nametree.hs diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal index f5ea030c43..f40185f4d8 100644 --- a/unison-core/unison-core1.cabal +++ b/unison-core/unison-core1.cabal @@ -55,12 +55,14 @@ library Unison.Type Unison.Type.Names Unison.Util.Components + Unison.Util.Defns + Unison.Util.Nametree Unison.Var Unison.WatchKind hs-source-dirs: src default-extensions: - ApplicativeDo + BangPatterns BlockArguments DeriveAnyClass DeriveFoldable @@ -68,17 +70,20 @@ library DeriveGeneric DeriveTraversable DerivingStrategies + DerivingVia DoAndIfThenElse FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving ImportQualifiedPost + InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns OverloadedStrings + OverloadedRecordDot PatternSynonyms RankNTypes ScopedTypeVariables @@ -102,6 +107,8 @@ library , nonempty-containers , rfc5051 , safe + , semialign + , semigroups , text , text-builder , these @@ -123,7 +130,7 @@ test-suite tests hs-source-dirs: test default-extensions: - ApplicativeDo + BangPatterns BlockArguments DeriveAnyClass DeriveFoldable @@ -131,17 +138,20 @@ test-suite tests DeriveGeneric DeriveTraversable DerivingStrategies + DerivingVia DoAndIfThenElse FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving ImportQualifiedPost + InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns OverloadedStrings + OverloadedRecordDot PatternSynonyms RankNTypes ScopedTypeVariables diff --git a/unison-merge/package.yaml b/unison-merge/package.yaml index 73f33af4a5..68cb7d0727 100644 --- a/unison-merge/package.yaml +++ b/unison-merge/package.yaml @@ -34,7 +34,6 @@ dependencies: - unison-sqlite - unison-syntax - unison-util-cache - - unison-util-nametree - unison-util-relation - vector - witherable diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index ab6bebe3db..ee5b36f481 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -103,7 +103,6 @@ library , unison-sqlite , unison-syntax , unison-util-cache - , unison-util-nametree , unison-util-relation , vector , witherable From 55ad236ac7a1d3707ef0677b56b0f612edfab874 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 1 Jul 2024 23:48:22 -0700 Subject: [PATCH 353/631] Update name-selection transcript --- unison-src/transcripts/name-selection.md | 26 +++++++++---------- .../transcripts/name-selection.output.md | 24 ++++++++--------- 2 files changed, 24 insertions(+), 26 deletions(-) diff --git a/unison-src/transcripts/name-selection.md b/unison-src/transcripts/name-selection.md index cff6c15d4f..5443349c0d 100644 --- a/unison-src/transcripts/name-selection.md +++ b/unison-src/transcripts/name-selection.md @@ -5,10 +5,8 @@ This transcript shows how the pretty-printer picks names for a hash when multipl 3. Otherwise if there are multiple names with a minimal number of segments, compare the names alphabetically. ```ucm:hide -.a> builtins.merge -.a2> builtins.merge -.a3> builtins.merge -.biasing> builtins.merge +scratch/main> builtins.merge lib.builtins +scratch/biasing> builtins.merge lib.builtins ``` ```unison:hide @@ -20,8 +18,8 @@ a.aaa.but.more.segments = 0 + 1 Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment length alias), and show that it isn't used when viewing `a`: ```ucm -.> add -.a> view a +scratch/main> add +scratch/main> view a.a ``` Next let's introduce a conflicting symbol and show that its hash qualified name isn't used when it has an unconflicted name: @@ -43,9 +41,9 @@ a3.long.name.but.shortest.suffixification = 1 ``` ```ucm -.> add -.> debug.alias.term.force a2.c a3.c -.> debug.alias.term.force a2.d a3.d +scratch/main> add +scratch/main> debug.alias.term.force a2.c a3.c +scratch/main> debug.alias.term.force a2.d a3.d ``` At this point, `a3` is conflicted for symbols `c` and `d`, so those are deprioritized. @@ -53,7 +51,7 @@ The original `a2` namespace has an unconflicted definition for `c` and `d`, but `a2.c` is chosen because although the suffixified version has fewer segments, its fully-qualified name has the fewest segments. ```ucm -.> view a b c d +scratch/main> view a b c d ``` ## Name biasing @@ -68,11 +66,11 @@ a = 10 ``` ```ucm -.biasing> add +scratch/biasing> add -- Despite being saved with name `a`, -- the pretty printer should prefer the suffixified 'deeply.nested.num name' over the shallow 'a'. -- It's closer to the term being printed. -.biasing> view deeply.nested.term +scratch/biasing> view deeply.nested.term ``` Add another term with `num` suffix to force longer suffixification of `deeply.nested.num` @@ -82,8 +80,8 @@ other.num = 20 ``` ```ucm -.biasing> add +scratch/biasing> add -- nested.num should be preferred over the shorter name `a` due to biasing -- because `deeply.nested.num` is nearby to the term being viewed. -.biasing> view deeply.nested.term +scratch/biasing> view deeply.nested.term ``` diff --git a/unison-src/transcripts/name-selection.output.md b/unison-src/transcripts/name-selection.output.md index a9b3d9679f..fd076c9cc1 100644 --- a/unison-src/transcripts/name-selection.output.md +++ b/unison-src/transcripts/name-selection.output.md @@ -13,7 +13,7 @@ a.aaa.but.more.segments = 0 + 1 Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment length alias), and show that it isn't used when viewing `a`: ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -21,10 +21,10 @@ Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment a.aaa.but.more.segments : Nat a.b : Nat -.a> view a +scratch/main> view a.a - a : Nat - a = + a.a : Nat + a.a = use Nat + b + 1 @@ -48,7 +48,7 @@ a3.long.name.but.shortest.suffixification = 1 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -71,11 +71,11 @@ a3.long.name.but.shortest.suffixification = 1 a3.d : Nat a3.long.name.but.shortest.suffixification : Nat -.> debug.alias.term.force a2.c a3.c +scratch/main> debug.alias.term.force a2.c a3.c Done. -.> debug.alias.term.force a2.d a3.d +scratch/main> debug.alias.term.force a2.d a3.d Done. @@ -85,7 +85,7 @@ The original `a2` namespace has an unconflicted definition for `c` and `d`, but `a2.c` is chosen because although the suffixified version has fewer segments, its fully-qualified name has the fewest segments. ```ucm -.> view a b c d +scratch/main> view a b c d a.a : Nat a.a = @@ -141,7 +141,7 @@ a = 10 ``` ```ucm -.biasing> add +scratch/biasing> add ⍟ I've added these definitions: @@ -152,7 +152,7 @@ a = 10 -- Despite being saved with name `a`, -- the pretty printer should prefer the suffixified 'deeply.nested.num name' over the shallow 'a'. -- It's closer to the term being printed. -.biasing> view deeply.nested.term +scratch/biasing> view deeply.nested.term deeply.nested.term : Nat deeply.nested.term = @@ -180,7 +180,7 @@ other.num = 20 ``` ```ucm -.biasing> add +scratch/biasing> add ⍟ I've added these definitions: @@ -188,7 +188,7 @@ other.num = 20 -- nested.num should be preferred over the shorter name `a` due to biasing -- because `deeply.nested.num` is nearby to the term being viewed. -.biasing> view deeply.nested.term +scratch/biasing> view deeply.nested.term deeply.nested.term : Nat deeply.nested.term = From e66b315c941404a97fde609ce053ee2674ec2d6d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 2 Jul 2024 09:35:24 -0700 Subject: [PATCH 354/631] Partially translate names.md --- unison-src/transcripts/names.md | 23 +++++++++++++---------- unison-src/transcripts/names.output.md | 22 +++++++++++++--------- 2 files changed, 26 insertions(+), 19 deletions(-) diff --git a/unison-src/transcripts/names.md b/unison-src/transcripts/names.md index 6d395266c4..0e38b9f75c 100644 --- a/unison-src/transcripts/names.md +++ b/unison-src/transcripts/names.md @@ -1,5 +1,9 @@ # `names` command +```ucm +scratch/main> builtins.merge lib.builtins +``` + Example uses of the `names` command and output ```unison @@ -13,7 +17,7 @@ somewhere.y = 2 ``` ```ucm -.> add +scratch/main> add ``` @@ -21,22 +25,21 @@ somewhere.y = 2 ```ucm -- We can search by suffix and find all definitions named 'x', and each of their aliases respectively. --- But we don't see somewhere.z which is has the same value but is out of our namespace -.some> names x +scratch/main> names x -- We can search by hash, and see all aliases of that hash -.some> names #gjmq673r1v --- If the query is absolute, treat it as a `names.global` -.some> names .some.place.x +scratch/main> names #gjmq673r1v +-- Works with global names too +scratch/main> names .some.place.x ``` `names.global` searches from the root, and absolutely qualifies results ```ucm --- We can search by suffix and find all definitions in the codebase named 'x', and each of their aliases respectively. -.some> names.global x +-- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. +scratch/other> names.global x -- We can search by hash, and see all aliases of that hash in the codebase -.some> names.global #gjmq673r1v +scratch/other> names.global #gjmq673r1v -- We can search using an absolute name -.some> names.global .some.place.x +scratch/other> names.global .some.place.x ``` diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index 8138b5434d..f283ee9210 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -1,5 +1,9 @@ # `names` command +```ucm +scratch/main> builtins.merge lib.builtins +``` + Example uses of the `names` command and output ```unison @@ -19,9 +23,9 @@ somewhere.y = 2 I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: - + some.otherplace.x : ##Nat some.otherplace.y : ##Nat some.place.x : ##Nat @@ -30,10 +34,10 @@ somewhere.y = 2 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: - + some.otherplace.x : ##Nat some.otherplace.y : ##Nat some.place.x : ##Nat @@ -51,10 +55,10 @@ somewhere.y = 2 Terms Hash: #gjmq673r1v Names: otherplace.y place.x - + Hash: #pi25gcdv0o Names: otherplace.x - + Tip: Use `names.global` to see more results. -- We can search by hash, and see all aliases of that hash @@ -63,7 +67,7 @@ somewhere.y = 2 Term Hash: #gjmq673r1v Names: otherplace.y place.x - + Tip: Use `names.global` to see more results. -- If the query is absolute, treat it as a `names.global` @@ -72,7 +76,7 @@ somewhere.y = 2 Term Hash: #gjmq673r1v Names: .some.otherplace.y .some.place.x .somewhere.z - + Tip: Use `names.global` to see more results. ``` @@ -86,7 +90,7 @@ somewhere.y = 2 Terms Hash: #gjmq673r1v Names: .some.otherplace.y .some.place.x .somewhere.z - + Hash: #pi25gcdv0o Names: .some.otherplace.x From 498e898e0fb4260c5639e1e422992899ce31c60f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 2 Jul 2024 09:38:57 -0700 Subject: [PATCH 355/631] Update namespace-dependencies --- .../transcripts/namespace-dependencies.md | 8 +++++-- .../namespace-dependencies.output.md | 22 ++++++++++++------- 2 files changed, 20 insertions(+), 10 deletions(-) diff --git a/unison-src/transcripts/namespace-dependencies.md b/unison-src/transcripts/namespace-dependencies.md index 0e8223a6cc..d60f789367 100644 --- a/unison-src/transcripts/namespace-dependencies.md +++ b/unison-src/transcripts/namespace-dependencies.md @@ -1,5 +1,9 @@ # namespace.dependencies command +```ucm +scratch/main> builtins.merge lib.builtins +``` + ```unison:hide const a b = a external.mynat = 1 @@ -7,6 +11,6 @@ mynamespace.dependsOnText = const external.mynat 10 ``` ```ucm -.> add -.mynamespace> namespace.dependencies +scratch/main> add +scratch/main> namespace.dependencies mynamespace ``` diff --git a/unison-src/transcripts/namespace-dependencies.output.md b/unison-src/transcripts/namespace-dependencies.output.md index 0e7d298262..c8eca0ff38 100644 --- a/unison-src/transcripts/namespace-dependencies.output.md +++ b/unison-src/transcripts/namespace-dependencies.output.md @@ -1,5 +1,11 @@ # namespace.dependencies command +```ucm +scratch/main> builtins.merge lib.builtins + + Done. + +``` ```unison const a b = a external.mynat = 1 @@ -7,21 +13,21 @@ mynamespace.dependsOnText = const external.mynat 10 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: const : a -> b -> a - external.mynat : ##Nat - mynamespace.dependsOnText : ##Nat + external.mynat : Nat + mynamespace.dependsOnText : Nat -.mynamespace> namespace.dependencies +scratch/main> namespace.dependencies mynamespace - External dependency Dependents in .mynamespace - ##Nat 1. dependsOnText + External dependency Dependents in scratch/main:.mynamespace + lib.builtins.Nat 1. dependsOnText - .const 1. dependsOnText + const 1. dependsOnText - .external.mynat 1. dependsOnText + external.mynat 1. dependsOnText ``` From 9af023b8ba578745ba1c148192f50a4c3ea0bc0d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 2 Jul 2024 09:46:40 -0700 Subject: [PATCH 356/631] Fixup resolution-failures.md --- unison-src/transcripts/resolution-failures.md | 4 ++++ .../transcripts/resolution-failures.output.md | 18 ++++++++++++------ 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/unison-src/transcripts/resolution-failures.md b/unison-src/transcripts/resolution-failures.md index eff751b4a4..b9b97c999e 100644 --- a/unison-src/transcripts/resolution-failures.md +++ b/unison-src/transcripts/resolution-failures.md @@ -4,6 +4,10 @@ This transcript tests the errors printed to the user when a name cannot be resol ## Codebase Setup +```ucm +scratch/main> builtins.merge lib.builtins +``` + First we define differing types with the same name in different namespaces: ```unison diff --git a/unison-src/transcripts/resolution-failures.output.md b/unison-src/transcripts/resolution-failures.output.md index bca703a4e5..d2c239c025 100644 --- a/unison-src/transcripts/resolution-failures.output.md +++ b/unison-src/transcripts/resolution-failures.output.md @@ -4,6 +4,12 @@ This transcript tests the errors printed to the user when a name cannot be resol ## Codebase Setup +```ucm +scratch/main> builtins.merge lib.builtins + + Done. + +``` First we define differing types with the same name in different namespaces: ```unison @@ -26,8 +32,8 @@ two.ambiguousTerm = "term two" type one.AmbiguousType type two.AmbiguousType - one.ambiguousTerm : ##Text - two.ambiguousTerm : ##Text + one.ambiguousTerm : Text + two.ambiguousTerm : Text ``` ```ucm @@ -37,8 +43,8 @@ scratch/main> add type one.AmbiguousType type two.AmbiguousType - one.ambiguousTerm : ##Text - two.ambiguousTerm : ##Text + one.ambiguousTerm : Text + two.ambiguousTerm : Text ``` ## Tests @@ -114,7 +120,7 @@ useAmbiguousTerm = ambiguousTerm I found some terms in scope that have matching names and types. Maybe you meant one of these: - one.ambiguousTerm : ##Text - two.ambiguousTerm : ##Text + one.ambiguousTerm : Text + two.ambiguousTerm : Text ``` From c0950036f0c23b30f91933cc17c898172b3b6c2c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 2 Jul 2024 09:48:07 -0700 Subject: [PATCH 357/631] Fix up tab-completion transcripts for project roots --- unison-src/transcripts/tab-completion.md | 4 ++-- unison-src/transcripts/tab-completion.output.md | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/unison-src/transcripts/tab-completion.md b/unison-src/transcripts/tab-completion.md index c270308fa7..e7b7e8b76c 100644 --- a/unison-src/transcripts/tab-completion.md +++ b/unison-src/transcripts/tab-completion.md @@ -43,9 +43,9 @@ absolute.term = "absolute" ``` ```ucm -.> add +scratch/main> add -- Should tab complete absolute names -.> debug.tab-complete view .absolute.te +scratch/main> debug.tab-complete view .absolute.te ``` ## Tab complete namespaces diff --git a/unison-src/transcripts/tab-completion.output.md b/unison-src/transcripts/tab-completion.output.md index c7730c17d5..68681b9a54 100644 --- a/unison-src/transcripts/tab-completion.output.md +++ b/unison-src/transcripts/tab-completion.output.md @@ -94,14 +94,14 @@ absolute.term = "absolute" ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: absolute.term : ##Text -- Should tab complete absolute names -.> debug.tab-complete view .absolute.te +scratch/main> debug.tab-complete view .absolute.te * .absolute.term From 478545e76abd103d5bbbbb1c0a360de15d6257b8 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 2 Jul 2024 09:48:54 -0700 Subject: [PATCH 358/631] Rewrite view.md, still failing --- unison-src/transcripts/view.md | 16 ++++++------ unison-src/transcripts/view.output.md | 37 +++++++++++++++------------ 2 files changed, 28 insertions(+), 25 deletions(-) diff --git a/unison-src/transcripts/view.md b/unison-src/transcripts/view.md index 89b81cf51f..ac8f42a915 100644 --- a/unison-src/transcripts/view.md +++ b/unison-src/transcripts/view.md @@ -1,7 +1,7 @@ # View commands ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` ```unison:hide @@ -10,16 +10,16 @@ b.thing = "b" ``` ```ucm:hide -.> add +scratch/main> add ``` ```ucm -- Should suffix-search and find values in sub-namespaces -.> view thing --- Should be local to namespace -.a> view thing +scratch/main> view thing -- view.global should search globally and be absolutely qualified -.a> view.global thing --- Should support absolute paths outside of current namespace -.a> view .b.thing +scratch/other> view.global thing +-- Should support absolute paths +scratch/main> view .b.thing +-- Should support branch relative paths +scratch/other> view /main:.a.thing ``` diff --git a/unison-src/transcripts/view.output.md b/unison-src/transcripts/view.output.md index 71ebf98da7..8c40abf628 100644 --- a/unison-src/transcripts/view.output.md +++ b/unison-src/transcripts/view.output.md @@ -7,7 +7,7 @@ b.thing = "b" ```ucm -- Should suffix-search and find values in sub-namespaces -.> view thing +scratch/main> view thing a.thing : Text a.thing = "a" @@ -15,25 +15,28 @@ b.thing = "b" b.thing : Text b.thing = "b" --- Should be local to namespace -.a> view thing - - thing : ##Text - thing = "a" - -- view.global should search globally and be absolutely qualified -.a> view.global thing +scratch/other> view.global thing - .a.thing : Text - .a.thing = "a" + ⚠️ - .b.thing : Text - .b.thing = "b" - --- Should support absolute paths outside of current namespace -.a> view .b.thing + The following names were not found in the codebase. Check your spelling. + thing - .b.thing : Text - .b.thing = "b" +``` +```ucm +-- Should suffix-search and find values in sub-namespacesscratch/main> view thing-- view.global should search globally and be absolutely qualifiedscratch/other> view.global thing-- Should support absolute pathsscratch/main> view .b.thing-- Should support branch relative pathsscratch/other> view /main:.a.thing ``` + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + thing + From 50f28817e57fdcafeb3cca906f021ccd7055c0d6 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 2 Jul 2024 13:06:03 -0400 Subject: [PATCH 359/631] add Names.lenientToNametree --- .../src/Unison/Util/BiMultimap.hs | 1 + .../src/Unison/Codebase/Branch.hs | 3 +- unison-core/package.yaml | 1 + unison-core/src/Unison/Names.hs | 74 ++++++++++++++----- unison-core/unison-core1.cabal | 2 + 5 files changed, 59 insertions(+), 22 deletions(-) diff --git a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs index 9167d6e6bb..e970281f07 100644 --- a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs +++ b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs @@ -178,6 +178,7 @@ invertDomain = g x acc y = Map.insert y x acc +-- | Construct a left-unique relation from a mapping from its right-elements to its left-elements. fromRange :: (Ord a, Ord b) => Map b a -> BiMultimap a b fromRange m = BiMultimap (Map.foldlWithKey' f Map.empty m) m diff --git a/parser-typechecker/src/Unison/Codebase/Branch.hs b/parser-typechecker/src/Unison/Codebase/Branch.hs index 68c55c88f8..00e2f76901 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch.hs @@ -139,6 +139,7 @@ import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment import Unison.Prelude hiding (empty) import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId) +import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Util.List qualified as List @@ -148,7 +149,6 @@ import Unison.Util.Set qualified as Set import Unison.Util.Star2 qualified as Star2 import Witherable (FilterableWithIndex (imapMaybe)) import Prelude hiding (head, read, subtract) -import qualified Unison.Reference as Reference instance AsEmpty (Branch m) where _Empty = prism' (const empty) matchEmpty @@ -215,7 +215,6 @@ deepTypeReferenceIds :: Branch0 m -> Set TypeReferenceId deepTypeReferenceIds = Set.mapMaybe Reference.toId . deepTypeReferences - namespaceStats :: Branch0 m -> NamespaceStats namespaceStats b = NamespaceStats diff --git a/unison-core/package.yaml b/unison-core/package.yaml index fb5b62b734..2b8bea50bf 100644 --- a/unison-core/package.yaml +++ b/unison-core/package.yaml @@ -66,6 +66,7 @@ default-extensions: - DerivingStrategies - DerivingVia - DoAndIfThenElse + - DuplicateRecordFields - FlexibleContexts - FlexibleInstances - GADTs diff --git a/unison-core/src/Unison/Names.hs b/unison-core/src/Unison/Names.hs index b21b761927..1897ac1178 100644 --- a/unison-core/src/Unison/Names.hs +++ b/unison-core/src/Unison/Names.hs @@ -49,12 +49,15 @@ module Unison.Names hashQualifyTypesRelation, hashQualifyTermsRelation, fromTermsAndTypes, + lenientToNametree, ) where import Data.Map qualified as Map +import Data.Semialign (alignWith) import Data.Set qualified as Set import Data.Text qualified as Text +import Data.These (These (..)) import Text.FuzzyFind qualified as FZF import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType qualified as CT @@ -64,6 +67,7 @@ import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.Name qualified as Name +import Unison.NameSegment (NameSegment) import Unison.Prelude import Unison.Reference (Reference, TermReference, TypeReference) import Unison.Reference qualified as Reference @@ -71,6 +75,10 @@ import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Util.Nametree (Nametree, unflattenNametree) import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as R import Unison.Util.Relation qualified as Relation @@ -95,7 +103,7 @@ instance Monoid (Names) where mempty = Names mempty mempty isEmpty :: Names -> Bool -isEmpty n = R.null (terms n) && R.null (types n) +isEmpty n = R.null n.terms && R.null n.types map :: (Name -> Name) -> Names -> Names map f (Names {terms, types}) = Names terms' types' @@ -122,8 +130,8 @@ fuzzyFind nameToText query names = . Prelude.filter prefilter . Map.toList -- `mapMonotonic` is safe here and saves a log n factor - $ (Set.mapMonotonic Left <$> R.toMultimap (terms names)) - <> (Set.mapMonotonic Right <$> R.toMultimap (types names)) + $ (Set.mapMonotonic Left <$> R.toMultimap names.terms) + <> (Set.mapMonotonic Right <$> R.toMultimap names.types) where lowerqueryt = Text.toLower . Text.pack <$> query -- For performance, case-insensitive substring matching as a pre-filter @@ -250,8 +258,8 @@ unionLeft' :: Names unionLeft' shouldOmit a b = Names terms' types' where - terms' = foldl' go (terms a) (R.toList $ terms b) - types' = foldl' go (types a) (R.toList $ types b) + terms' = foldl' go a.terms (R.toList b.terms) + types' = foldl' go a.types (R.toList b.types) go :: (Ord a, Ord b) => Relation a b -> (a, b) -> Relation a b go acc (n, r) = if shouldOmit n r acc then acc else R.insert n r acc @@ -260,7 +268,7 @@ numHashChars :: Int numHashChars = 3 termsNamed :: Names -> Name -> Set Referent -termsNamed = flip R.lookupDom . terms +termsNamed = flip R.lookupDom . (.terms) -- | Get all terms with a specific name. refTermsNamed :: Names -> Name -> Set TermReference @@ -281,13 +289,13 @@ refTermsHQNamed names = \case in Set.mapMaybe f (termsNamed names name) typesNamed :: Names -> Name -> Set TypeReference -typesNamed = flip R.lookupDom . types +typesNamed = flip R.lookupDom . (.types) namesForReferent :: Names -> Referent -> Set Name -namesForReferent names r = R.lookupRan r (terms names) +namesForReferent names r = R.lookupRan r names.terms namesForReference :: Names -> TypeReference -> Set Name -namesForReference names r = R.lookupRan r (types names) +namesForReference names r = R.lookupRan r names.types termAliases :: Names -> Name -> Referent -> Set Name termAliases names n r = Set.delete n $ namesForReferent names r @@ -422,20 +430,20 @@ filterTypes f (Names terms types) = Names terms (R.filterDom f types) difference :: Names -> Names -> Names difference a b = Names - (R.difference (terms a) (terms b)) - (R.difference (types a) (types b)) + (R.difference a.terms b.terms) + (R.difference a.types b.types) contains :: Names -> Reference -> Bool contains names = -- We want to compute `termsReferences` only once, if `contains` is partially applied to a `Names`, and called over -- and over for different references. GHC would probably float `termsReferences` out without the explicit lambda, but -- it's written like this just to be sure. - \r -> Set.member r termsReferences || R.memberRan r (types names) + \r -> Set.member r termsReferences || R.memberRan r names.types where -- this check makes `contains` O(n) instead of O(log n) termsReferences :: Set TermReference termsReferences = - Set.map Referent.toReference (R.ran (terms names)) + Set.map Referent.toReference (R.ran names.terms) -- | filters out everything from the domain except what's conflicted conflicts :: Names -> Names @@ -448,9 +456,9 @@ conflicts Names {..} = Names (R.filterManyDom terms) (R.filterManyDom types) -- See usage in `FileParser` for handling precendence of symbol -- resolution where local names are preferred to codebase names. shadowTerms :: [Name] -> Names -> Names -shadowTerms ns n0 = Names terms' (types n0) +shadowTerms ns n0 = Names terms' n0.types where - terms' = foldl' go (terms n0) ns + terms' = foldl' go n0.terms ns go ts name = R.deleteDom name ts -- | Given a mapping from name to qualified name, update a `Names`, @@ -461,8 +469,8 @@ shadowTerms ns n0 = Names terms' (types n0) importing :: [(Name, Name)] -> Names -> Names importing shortToLongName ns = Names - (foldl' go (terms ns) shortToLongName) - (foldl' go (types ns) shortToLongName) + (foldl' go ns.terms shortToLongName) + (foldl' go ns.types shortToLongName) where go :: (Ord r) => Relation Name r -> (Name, Name) -> Relation Name r go m (shortname, qname) = case Name.searchByRankedSuffix qname m of @@ -476,8 +484,8 @@ importing shortToLongName ns = -- `[(foo, io.foo), (bar, io.bar)]`. expandWildcardImport :: Name -> Names -> [(Name, Name)] expandWildcardImport prefix ns = - [(suffix, full) | Just (suffix, full) <- go <$> R.toList (terms ns)] - <> [(suffix, full) | Just (suffix, full) <- go <$> R.toList (types ns)] + [(suffix, full) | Just (suffix, full) <- go <$> R.toList ns.terms] + <> [(suffix, full) | Just (suffix, full) <- go <$> R.toList ns.types] where go :: (Name, a) -> Maybe (Name, Name) go (full, _) = do @@ -498,7 +506,7 @@ constructorsForType r ns = possibleDatas = [Referent.Con (ConstructorReference r cid) CT.Data | cid <- [0 ..]] possibleEffects = [Referent.Con (ConstructorReference r cid) CT.Effect | cid <- [0 ..]] trim [] = [] - trim (h : t) = case R.lookupRan h (terms ns) of + trim (h : t) = case R.lookupRan h ns.terms of s | Set.null s -> [] | otherwise -> [(n, h) | n <- toList s] ++ trim t @@ -517,3 +525,29 @@ hashQualifyRelation fromNamedRef rel = R.map go rel if Set.size (R.lookupDom n rel) > 1 then (HQ.take numHashChars $ fromNamedRef n r, r) else (HQ.NameOnly n, r) + +-- | "Leniently" view a Names as a NameTree +-- +-- This function is "lenient" in the sense that it does not handle conflicted names with any smarts whatsoever. The +-- resulting nametree will simply contain one of the associated references of a conflicted name - we don't specify +-- which. +lenientToNametree :: Names -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) +lenientToNametree names = + alignWith + ( \case + This terms -> Defns {terms, types = Map.empty} + That types -> Defns {terms = Map.empty, types} + These terms types -> Defns {terms, types} + ) + (lenientRelationToNametree names.terms) + (lenientRelationToNametree names.types) + where + lenientRelationToNametree :: Ord a => Relation Name a -> Nametree (Map NameSegment a) + lenientRelationToNametree = + unflattenNametree . lenientRelationToLeftUniqueRelation + + lenientRelationToLeftUniqueRelation :: (Ord a, Ord b) => Relation a b -> BiMultimap b a + lenientRelationToLeftUniqueRelation = + -- The partial `Set.findMin` are fine here because Relation.domain only has non-empty Set values. A NESet would be + -- better. + BiMultimap.fromRange . Map.map Set.findMin . Relation.domain diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal index f40185f4d8..bde4b2a6f7 100644 --- a/unison-core/unison-core1.cabal +++ b/unison-core/unison-core1.cabal @@ -72,6 +72,7 @@ library DerivingStrategies DerivingVia DoAndIfThenElse + DuplicateRecordFields FlexibleContexts FlexibleInstances GADTs @@ -140,6 +141,7 @@ test-suite tests DerivingStrategies DerivingVia DoAndIfThenElse + DuplicateRecordFields FlexibleContexts FlexibleInstances GADTs From 7dbb365a120938697f86888b0cbd7d59f2632aa0 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 2 Jul 2024 09:52:20 -0700 Subject: [PATCH 360/631] Convert diff-namespaces.md to project-root --- unison-src/transcripts/diff-namespace.md | 13 +- .../transcripts/diff-namespace.output.md | 177 ++++++++++++++++-- 2 files changed, 172 insertions(+), 18 deletions(-) diff --git a/unison-src/transcripts/diff-namespace.md b/unison-src/transcripts/diff-namespace.md index 1889966056..4352835ed6 100644 --- a/unison-src/transcripts/diff-namespace.md +++ b/unison-src/transcripts/diff-namespace.md @@ -117,6 +117,8 @@ shown, only their also-conflicted dependency is shown. ```unison:hide a = 333 b = a + 1 + +forconflicts = 777 ``` ```ucm @@ -127,7 +129,6 @@ scratch/nsx> branch /nsz ```unison:hide a = 444 -other = 555 ``` ```ucm @@ -141,14 +142,14 @@ a = 555 ```ucm scratch/nsz> update.old scratch/nsy> branch /nsw -scratch/nsw> debug.alias.term.force .other .a -scratch/nsw> delete.term .other -scratch/main> debug.alias.term.force /nsz:.b /nsw:.b +scratch/nsw> debug.alias.term.force .forconflicts .a +scratch/nsw> debug.alias.term.force .forconflicts .b ``` ```ucm -scratch/main> diff.namespace nsx nsw -scratch/main> view nsw.a nsw.b +scratch/main> diff.namespace /nsx: /nsw: +scratch/nsw> view a +scratch/nsw> view b ``` ## Should be able to diff a namespace hash from history. diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md index eda8a06712..b45d8574eb 100644 --- a/unison-src/transcripts/diff-namespace.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -321,6 +321,8 @@ shown, only their also-conflicted dependency is shown. ```unison a = 333 b = a + 1 + +forconflicts = 777 ``` ```ucm @@ -328,8 +330,9 @@ scratch/nsx> add ⍟ I've added these definitions: - a : Nat - b : Nat + a : Nat + b : Nat + forconflicts : Nat scratch/nsx> branch /nsy @@ -376,23 +379,173 @@ scratch/nsy> branch /nsw Tip: To merge your work back into the nsy branch, first `switch /nsy` then `merge /nsw`. -scratch/main> debug.alias.term.force /nsz:.a /nsw:.a +scratch/nsw> debug.alias.term.force .forconflicts .a + + Done. + +scratch/nsw> debug.alias.term.force .forconflicts .b + + Done. + +``` +```ucm +scratch/main> diff.namespace /nsx: /nsw: + + New name conflicts: + + 1. a#uiiiv8a86s : Nat + ↓ + 2. ┌ a#mdl4vqtu00 : Nat + 3. └ a#r3msrbpp1v : Nat + + 4. b#lhigeb1let : Nat + ↓ + 5. ┌ b#r3msrbpp1v : Nat + 6. └ b#unkqhuu66p : Nat + + Added definitions: + + 7. patch patch (added 1 updates) + + Name changes: + + Original Changes + 8. forconflicts 9. a#r3msrbpp1v (added) + 10. b#r3msrbpp1v (added) + +scratch/nsw> view a + + a#mdl4vqtu00 : Nat + a#mdl4vqtu00 = 444 + + a#r3msrbpp1v : Nat + a#r3msrbpp1v = 777 + +scratch/nsw> view b + + b#r3msrbpp1v : Nat + b#r3msrbpp1v = 777 + + b#unkqhuu66p : Nat + b#unkqhuu66p = + use Nat + + a#mdl4vqtu00 + 1 + +``` +## Should be able to diff a namespace hash from history. +```unison +x = 1 ``` ```ucm -scratch/nsz> update.oldscratch/nsy> branch /nswscratch/main> debug.alias.term.force /nsz:.a /nsw:.ascratch/main> debug.alias.term.force /nsz:.b /nsw:.b + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + x : Nat + ``` +```ucm +scratch/hashdiff> add + ⍟ I've added these definitions: + + x : ##Nat + +``` +```unison +y = 2 +``` -🛑 +```ucm -The transcript failed due to an error in the stanza above. The error is: + Loading changes detected in scratch.u. -1:2: - | -1 | /nsz:.a - | ^ -unexpected 'n' -expecting '.', end of input, hash (ex: #af3sj3), or operator (valid characters: !$%&*+-/:<=>\^|~) + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + y : ##Nat +``` +```ucm +scratch/hashdiff> add + + ⍟ I've added these definitions: + + y : ##Nat + +scratch/hashdiff> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #ru1hnjofdj + + + Adds / updates: + + y + + □ 2. #i52j9fd57b (start of history) + +scratch/hashdiff> diff.namespace 2 1 + + Added definitions: + + 1. y : ##Nat + +``` +## + +Updates: -- 1 to 1 + +New name conflicts: -- updates where RHS has multiple hashes (excluding when RHS=LHS) + + 1. foo#jk19sm5bf8 : Nat - do we want to force a hashqualified? Arya thinks so + ↓ + 2. ┌ foo#0ja1qfpej6 : Nat + 3. └ foo#jk19sm5bf8 : Nat + +Resolved name conflicts: -- updates where LHS had multiple hashes and RHS has one + + 4. ┌ bar#0ja1qfpej6 : Nat + 5. └ bar#jk19sm5bf8 : Nat + ↓ + 6. bar#jk19sm5bf8 : Nat + +## Display issues to fixup + +- [d] Do we want to surface new edit conflicts in patches? +- [t] two different auto-propagated changes creating a name conflict should show + up somewhere besides the auto-propagate count +- [t] Things look screwy when the type signature doesn't fit and has to get broken + up into multiple lines. Maybe just disallow that? +- [d] Delete blank line in between copies / renames entries if all entries are 1 to 1 + see todo in the code +- [x] incorrectly calculated bracket alignment on hashqualified "Name changes" (delete.output.md) +- [x] just handle deletion of isPropagated in propagate function, leave HandleInput alone (assuming this does the trick) +- [x] might want unqualified names to be qualified sometimes: +- [x] if a name is updated to a not-yet-named reference, it's shown as both an update and an add +- [x] similarly, if a conflicted name is resolved by deleting the last name to + a reference, I (arya) suspect it will show up as a Remove +- [d] Maybe group and/or add headings to the types, constructors, terms +- [x] add tagging of propagated updates to test propagated updates output +- [x] missing old names in deletion ppe (delete.output.md) (superseded by \#1143) +- [x] delete.term has some bonkers output +- [x] Make a decision about how we want to show constructors in the diff +- [x] 12.patch patch needs a space +- [x] This looks like garbage +- [x] Extra 2 blank lines at the end of the add section +- [x] Fix alignment issues with buildTable, convert to column3M (to be written) +- [x] adding an alias is showing up as an Add and a Copy; should just show as Copy +- [x] removing one of multiple aliases appears in removes + moves + copies section +- [x] some overlapping cases between Moves and Copies^ +- [x] Maybe don't list the type signature twice for aliases? From 5c675df566d9cf122ef3012eac9b6da5b699b0b2 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 2 Jul 2024 10:28:59 -0700 Subject: [PATCH 361/631] Revive ability to delete root namespace --- .../src/Unison/Codebase/Editor/HandleInput.hs | 22 +++++++-- .../src/Unison/Codebase/Editor/Input.hs | 2 +- .../src/Unison/CommandLine/InputPatterns.hs | 3 +- .../src/Unison/CommandLine/OutputMessages.hs | 6 ++- .../transcripts/delete-namespace.output.md | 47 ++++++++++++++----- 5 files changed, 62 insertions(+), 18 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 6247d42b85..ec8ed7cb44 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -575,7 +575,16 @@ loop e = do delete input doutput getTerms getTypes hqs DeleteTarget'Type doutput hqs -> delete input doutput (const (pure Set.empty)) getTypes hqs DeleteTarget'Term doutput hqs -> delete input doutput getTerms (const (pure Set.empty)) hqs - DeleteTarget'Namespace insistence p@(parentPath, childName) -> do + DeleteTarget'Namespace insistence Nothing -> do + hasConfirmed <- confirmedCommand input + if hasConfirmed || insistence == Force + then do + description <- inputDescription input + pp <- Cli.getCurrentProjectPath + _ <- Cli.updateAt description pp (const Branch.empty) + Cli.respond DeletedEverything + else Cli.respond DeleteEverythingConfirmation + DeleteTarget'Namespace insistence (Just p@(parentPath, childName)) -> do branch <- Cli.expectBranchAtPath (Path.unsplit p) description <- inputDescription input let toDelete = @@ -947,10 +956,10 @@ inputDescription input = thing <- traverse hqs' thing0 pure ("delete.type.verbose " <> Text.intercalate " " thing) DeleteTarget'Namespace Try opath0 -> do - opath <- ps opath0 + opath <- ops opath0 pure ("delete.namespace " <> opath) DeleteTarget'Namespace Force opath0 -> do - opath <- ps opath0 + opath <- ops opath0 pure ("delete.namespace.force " <> opath) DeleteTarget'ProjectBranch _ -> wat DeleteTarget'Project _ -> wat @@ -1053,6 +1062,8 @@ inputDescription input = p' = fmap tShow . Cli.resolvePath' brp :: BranchRelativePath -> Cli Text brp = fmap (into @Text) . ProjectUtils.resolveBranchRelativePath + ops :: Maybe Path.Split -> Cli Text + ops = maybe (pure ".") ps wat = error $ show input ++ " is not expected to alter the branch" hhqs' :: Either SH.ShortHash Path.HQSplit' -> Cli Text hhqs' = \case @@ -1326,6 +1337,11 @@ doDisplay outputLoc names tm = do else do writeUtf8 filePath txt +confirmedCommand :: Input -> Cli Bool +confirmedCommand i = do + loopState <- State.get + pure $ Just i == (loopState ^. #lastInput) + -- return `name` and `name....` _searchBranchPrefix :: Branch m -> Name -> [SearchResult] _searchBranchPrefix b n = case Path.unsnoc (Path.fromName n) of diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 774e840d9d..739482c84f 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -312,7 +312,7 @@ data DeleteTarget = DeleteTarget'TermOrType DeleteOutput [Path.HQSplit'] | DeleteTarget'Term DeleteOutput [Path.HQSplit'] | DeleteTarget'Type DeleteOutput [Path.HQSplit'] - | DeleteTarget'Namespace Insistence (Path.Split) + | DeleteTarget'Namespace Insistence (Maybe Path.Split) | DeleteTarget'ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) | DeleteTarget'Project ProjectName deriving stock (Eq, Show) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 43ff94738b..d93fac27fd 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1542,7 +1542,8 @@ deleteNamespaceForce = deleteNamespaceParser :: P.Pretty CT.ColorText -> Input.Insistence -> I.Arguments -> Either (P.Pretty CT.ColorText) Input deleteNamespaceParser helpText insistence = \case - [p] -> Input.DeleteI . DeleteTarget'Namespace insistence <$> handleSplitArg p + [Left "."] -> first fromString . pure $ Input.DeleteI (DeleteTarget'Namespace insistence Nothing) + [p] -> Input.DeleteI . DeleteTarget'Namespace insistence <$> (Just <$> handleSplitArg p) _ -> Left helpText renameBranch :: InputPattern diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index c56fe14c8c..8ad81af888 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -815,9 +815,11 @@ notifyUser dir = \case DeleteEverythingConfirmation -> pure . P.warnCallout . P.lines $ [ "Are you sure you want to clear away everything?", - "You could use " + P.wrap ("You could use " <> IP.makeExample' IP.projectCreate - <> " to switch to a new project instead." + <> " to switch to a new project instead," + <> " or delete the current branch with " <> IP.makeExample' IP.deleteBranch + ) ] DeleteBranchConfirmation _uniqueDeletions -> error "todo" -- let diff --git a/unison-src/transcripts/delete-namespace.output.md b/unison-src/transcripts/delete-namespace.output.md index b350e13f2e..d4ea0436b4 100644 --- a/unison-src/transcripts/delete-namespace.output.md +++ b/unison-src/transcripts/delete-namespace.output.md @@ -75,21 +75,46 @@ Deleting the root namespace should require confirmation if not forced. ```ucm scratch/main> delete.namespace . -``` + ⚠️ + + Are you sure you want to clear away everything? + You could use `project.create` to switch to a new project + instead, or delete the current branch with `delete.branch` + +scratch/main> delete.namespace . + + Okay, I deleted everything except the history. Use `undo` to + undo, or `builtins.merge` to restore the absolute basics to + the current path. + +-- Should have an empty history +scratch/main> history . + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) -```ucm -scratch/main> delete.namespace .scratch/main> delete.namespace .-- Should have an empty historyscratch/main> history . ``` +Deleting the root namespace shouldn't require confirmation if forced. +```ucm +scratch/main> delete.namespace.force . -🛑 + Okay, I deleted everything except the history. Use `undo` to + undo, or `builtins.merge` to restore the absolute basics to + the current path. -The transcript failed due to an error in the stanza above. The error is: +-- Should have an empty history +scratch/main> history . -1:1: - | -1 | . - | ^ -unexpected '.' -expecting '`' or operator (valid characters: !$%&*+-/:<=>\^|~) + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) +``` From 6ae9f8b3021a58f67d58cd27e5fbab5b6b4a52ad Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 2 Jul 2024 10:53:28 -0700 Subject: [PATCH 362/631] Fix behaviour of branch command --- codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs | 2 +- .../src/Unison/Codebase/Editor/HandleInput/Branch.hs | 9 +++++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index b7f184e0e0..c4e1e2c013 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3918,7 +3918,7 @@ setProjectBranchHead description projectId branchId causalHashId = do reason = description } -expectProjectBranchHead :: ProjectId -> ProjectBranchId -> Transaction CausalHashId +expectProjectBranchHead :: (HasCallStack) => ProjectId -> ProjectBranchId -> Transaction CausalHashId expectProjectBranchHead projectId branchId = queryOneCol [sql| diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 13e630d8ed..06335337e0 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -105,9 +105,9 @@ createBranch description createFrom project getNewBranchName = do Cli.Env {codebase} <- ask (mayParentBranchId, newBranchCausalHashId) <- case createFrom of CreateFrom'ParentBranch parentBranch -> Cli.runTransaction do - Q.expectProjectBranchHead projectId (parentBranch ^. #branchId) - newBranchCausalHashId <- Q.expectProjectBranchHead projectId (parentBranch ^. #branchId) - pure (Just (parentBranch ^. #branchId), newBranchCausalHashId) + newBranchCausalHashId <- Q.expectProjectBranchHead parentBranch.projectId parentBranch.branchId + let parentBranchId = if parentBranch.projectId == projectId then Just parentBranch.branchId else Nothing + pure (parentBranchId, newBranchCausalHashId) CreateFrom'Nothingness -> Cli.runTransaction do (_, causalHashId) <- Codebase.emptyCausalHash pure (Nothing, causalHashId) @@ -115,7 +115,8 @@ createBranch description createFrom project getNewBranchName = do liftIO $ Codebase.putBranch codebase namespace Cli.runTransaction $ do newBranchCausalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash namespace) - pure (Just (parentBranch ^. #branchId), newBranchCausalHashId) + let parentBranchId = if parentBranch.projectId == projectId then Just parentBranch.branchId else Nothing + pure (parentBranchId, newBranchCausalHashId) CreateFrom'Namespace branch -> do liftIO $ Codebase.putBranch codebase branch Cli.runTransaction $ do From eaf233cdbe17de92d75279016f935e72d3394ebb Mon Sep 17 00:00:00 2001 From: ChrisPenner Date: Tue, 2 Jul 2024 21:43:17 +0000 Subject: [PATCH 363/631] automatically run ormolu --- .../src/Unison/CommandLine/OutputMessages.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 8ad81af888..421dcfc43c 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -44,6 +44,7 @@ import Unison.Cli.MergeTypes (MergeSourceAndTarget (..)) import Unison.Cli.Pretty import Unison.Cli.ServantClientUtils qualified as ServantClientUtils import Unison.Codebase.Editor.DisplayObject (DisplayObject (..)) +import Unison.Codebase.Editor.Input (BranchIdG (..)) import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output ( CreatedProjectBranchFrom (..), @@ -148,7 +149,6 @@ import Unison.Var (Var) import Unison.Var qualified as Var import Unison.WatchKind qualified as WK import Witch (unsafeFrom) -import Unison.Codebase.Editor.Input (BranchIdG(..)) reportBugURL :: Pretty reportBugURL = "https://github.com/unisonweb/unison/issues/new" @@ -815,11 +815,13 @@ notifyUser dir = \case DeleteEverythingConfirmation -> pure . P.warnCallout . P.lines $ [ "Are you sure you want to clear away everything?", - P.wrap ("You could use " - <> IP.makeExample' IP.projectCreate - <> " to switch to a new project instead," - <> " or delete the current branch with " <> IP.makeExample' IP.deleteBranch - ) + P.wrap + ( "You could use " + <> IP.makeExample' IP.projectCreate + <> " to switch to a new project instead," + <> " or delete the current branch with " + <> IP.makeExample' IP.deleteBranch + ) ] DeleteBranchConfirmation _uniqueDeletions -> error "todo" -- let From fdf91bbce67e17a33220a67f02a0e81aba6be170 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 2 Jul 2024 17:44:09 -0400 Subject: [PATCH 364/631] make decl coherency check more abstract to support "get all violations" use case --- .../src/Unison/Merge/DeclCoherencyCheck.hs | 190 +++++++++++------- 1 file changed, 122 insertions(+), 68 deletions(-) diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 2a75252fcd..907c453e20 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -87,11 +87,9 @@ module Unison.Merge.DeclCoherencyCheck where import Control.Lens ((%=), (.=), _2) -import Control.Monad.Except (ExceptT) import Control.Monad.Except qualified as Except import Control.Monad.State.Strict (StateT) import Control.Monad.State.Strict qualified as State -import Control.Monad.Trans.Except qualified as Except (except) import Data.Functor.Compose (Compose (..)) import Data.IntMap.Strict (IntMap) import Data.IntMap.Strict qualified as IntMap @@ -136,87 +134,143 @@ checkDeclCoherency :: (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m (Either IncoherentDeclReason DeclNameLookup) -checkDeclCoherency loadDeclNumConstructors = +checkDeclCoherency loadDeclNumConstructors nametree = Except.runExceptT - . fmap (view #declNameLookup) + ( checkDeclCoherencyWith + (lift . loadDeclNumConstructors) + OnIncoherentDeclReasons + { onConstructorAlias = \x y z -> Except.throwError (IncoherentDeclReason'ConstructorAlias x y z), -- :: Name -> Name -> Name -> m (), + onMissingConstructorName = \x -> Except.throwError (IncoherentDeclReason'MissingConstructorName x), -- :: Name -> m (), + onNestedDeclAlias = \x y -> Except.throwError (IncoherentDeclReason'NestedDeclAlias x y), -- :: Name -> Name -> m (), + onStrayConstructor = \x -> Except.throwError (IncoherentDeclReason'StrayConstructor x) -- :: Name -> m () + } + nametree + ) + +data OnIncoherentDeclReasons m = OnIncoherentDeclReasons + { onConstructorAlias :: Name -> Name -> Name -> m (), + onMissingConstructorName :: Name -> m (), + onNestedDeclAlias :: Name -> Name -> m (), + onStrayConstructor :: Name -> m () + } + +checkDeclCoherencyWith :: + forall m. + Monad m => + (TypeReferenceId -> m Int) -> + OnIncoherentDeclReasons m -> + Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> + m DeclNameLookup +checkDeclCoherencyWith loadDeclNumConstructors callbacks = + fmap (view #declNameLookup) . (`State.execStateT` DeclCoherencyCheckState Map.empty (DeclNameLookup Map.empty Map.empty)) . go [] where go :: [NameSegment] -> (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> - StateT DeclCoherencyCheckState (ExceptT IncoherentDeclReason m) () + StateT DeclCoherencyCheckState m () go prefix (Nametree defns children) = do - for_ (Map.toList defns.terms) \case - (_, Referent.Ref _) -> pure () - (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure () - (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do - DeclCoherencyCheckState {expectedConstructors} <- State.get - expectedConstructors1 <- lift (Except.except (Map.upsertF f typeRef expectedConstructors)) - #expectedConstructors .= expectedConstructors1 - where - f :: - Maybe (Name, ConstructorNames) -> - Either IncoherentDeclReason (Name, ConstructorNames) - f = \case - Nothing -> Left (IncoherentDeclReason'StrayConstructor name1) - Just (typeName, expected) -> - case recordConstructorName conId name1 expected of - Left existingName -> Left (IncoherentDeclReason'ConstructorAlias typeName existingName name1) - Right expected1 -> Right (typeName, expected1) - where - name1 = fullName name - + for_ (Map.toList defns.terms) (checkDeclCoherency_terms callbacks prefix) childrenWeWentInto <- - forMaybe (Map.toList defns.types) \case - (_, ReferenceBuiltin _) -> pure Nothing - (name, ReferenceDerived typeRef) -> do - DeclCoherencyCheckState {expectedConstructors} <- State.get - whatHappened <- do - let recordNewDecl :: - Maybe (Name, ConstructorNames) -> - Compose (ExceptT IncoherentDeclReason m) WhatHappened (Name, ConstructorNames) - recordNewDecl = - Compose . \case - Just (shorterTypeName, _) -> Except.throwError (IncoherentDeclReason'NestedDeclAlias shorterTypeName typeName) - Nothing -> - lift (loadDeclNumConstructors typeRef) <&> \case - 0 -> UninhabitedDecl - n -> InhabitedDecl (typeName, emptyConstructorNames n) - lift (getCompose (Map.upsertF recordNewDecl typeRef expectedConstructors)) - case whatHappened of - UninhabitedDecl -> do - #declNameLookup . #declToConstructors %= Map.insert typeName [] - pure Nothing - InhabitedDecl expectedConstructors1 -> do - child <- - Map.lookup name children & onNothing do - Except.throwError (IncoherentDeclReason'MissingConstructorName typeName) - #expectedConstructors .= expectedConstructors1 - go (name : prefix) child - DeclCoherencyCheckState {expectedConstructors} <- State.get - -- fromJust is safe here because we upserted `typeRef` key above - let (fromJust -> (_typeName, maybeConstructorNames), expectedConstructors1) = - Map.deleteLookup typeRef expectedConstructors - constructorNames <- - sequence (IntMap.elems maybeConstructorNames) & onNothing do - Except.throwError (IncoherentDeclReason'MissingConstructorName typeName) - #expectedConstructors .= expectedConstructors1 + forMaybe + (Map.toList defns.types) + (checkDeclCoherency_types loadDeclNumConstructors callbacks go prefix children) + let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto + for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child + +checkDeclCoherency_terms :: + forall m. + Monad m => + OnIncoherentDeclReasons m -> + [NameSegment] -> + (NameSegment, Referent) -> + StateT DeclCoherencyCheckState m () +checkDeclCoherency_terms callbacks prefix = \case + (_, Referent.Ref _) -> pure () + (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure () + (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do + state <- State.get + whenJustM (lift (runMaybeT (Map.upsertF f typeRef state.expectedConstructors))) \expectedConstructors1 -> + #expectedConstructors .= expectedConstructors1 + where + f :: Maybe (Name, ConstructorNames) -> MaybeT m (Name, ConstructorNames) + f = \case + Nothing -> do + lift (callbacks.onStrayConstructor name1) + MaybeT (pure Nothing) + Just (typeName, expected) -> + case recordConstructorName conId name1 expected of + Left existingName -> do + lift (callbacks.onConstructorAlias typeName existingName name1) + MaybeT (pure Nothing) + Right expected1 -> pure (typeName, expected1) + where + name1 = + Name.fromReverseSegments (name :| prefix) + +checkDeclCoherency_types :: + forall m. + Monad m => + (TypeReferenceId -> m Int) -> + OnIncoherentDeclReasons m -> + ( [NameSegment] -> + (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + StateT DeclCoherencyCheckState m () + ) -> + [NameSegment] -> + Map NameSegment (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + (NameSegment, TypeReference) -> + StateT DeclCoherencyCheckState m (Maybe NameSegment) +checkDeclCoherency_types loadDeclNumConstructors callbacks go prefix children = \case + (_, ReferenceBuiltin _) -> pure Nothing + (name, ReferenceDerived typeRef) -> do + state <- State.get + maybeWhatHappened <- do + let recordNewDecl :: + Maybe (Name, ConstructorNames) -> + Compose (MaybeT m) WhatHappened (Name, ConstructorNames) + recordNewDecl = + Compose . \case + Just (shorterTypeName, _) -> do + lift (callbacks.onNestedDeclAlias shorterTypeName typeName) + MaybeT (pure Nothing) + Nothing -> + lift (loadDeclNumConstructors typeRef) <&> \case + 0 -> UninhabitedDecl + n -> InhabitedDecl (typeName, emptyConstructorNames n) + lift (runMaybeT (getCompose (Map.upsertF recordNewDecl typeRef state.expectedConstructors))) + case maybeWhatHappened of + Nothing -> pure Nothing + Just UninhabitedDecl -> do + #declNameLookup . #declToConstructors %= Map.insert typeName [] + pure Nothing + Just (InhabitedDecl expectedConstructors1) -> do + case Map.lookup name children of + Nothing -> do + lift (callbacks.onMissingConstructorName typeName) + pure Nothing + Just child -> do + #expectedConstructors .= expectedConstructors1 + go (name : prefix) child + state <- State.get + -- fromJust is safe here because we upserted `typeRef` key above + let (fromJust -> (_typeName, maybeConstructorNames), expectedConstructors1) = + Map.deleteLookup typeRef state.expectedConstructors + #expectedConstructors .= expectedConstructors1 + case sequence (IntMap.elems maybeConstructorNames) of + Nothing -> lift (callbacks.onMissingConstructorName typeName) + Just constructorNames -> do #declNameLookup . #constructorToDecl %= \constructorToDecl -> List.foldl' (\acc constructorName -> Map.insert constructorName typeName acc) constructorToDecl constructorNames #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames - pure (Just name) - where - typeName = fullName name - - let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto - for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child - where - fullName name = - Name.fromReverseSegments (name :| prefix) + pure (Just name) + where + typeName = + Name.fromReverseSegments (name :| prefix) -- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns partial decl name lookup, -- which doesn't require a name for every constructor, and allows a constructor with a nameless decl. From e9f2aa3ec5bee0442f258d86a77c28b8ec5633f9 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 2 Jul 2024 14:42:07 -0700 Subject: [PATCH 365/631] Un-ignore transcript-parser-commands.md and fix it. --- .gitignore | 1 - unison-src/transcripts/transcript-parser-commands.md | 8 ++++---- .../transcripts/transcript-parser-commands.output.md | 6 +++--- 3 files changed, 7 insertions(+), 8 deletions(-) diff --git a/.gitignore b/.gitignore index e02fc7f2b2..1c9b75d999 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,6 @@ # Unison .unison* test-output -transcript-* scratch.u unisonLocal.zip diff --git a/unison-src/transcripts/transcript-parser-commands.md b/unison-src/transcripts/transcript-parser-commands.md index e39fd10885..afd90011ea 100644 --- a/unison-src/transcripts/transcript-parser-commands.md +++ b/unison-src/transcripts/transcript-parser-commands.md @@ -1,7 +1,7 @@ ### Transcript parser operations ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge ``` The transcript parser is meant to parse `ucm` and `unison` blocks. @@ -11,7 +11,7 @@ x = 1 ``` ```ucm -.> add +scratch/main> add ``` ```unison:hide:error:scratch.u @@ -19,11 +19,11 @@ z ``` ```ucm:error -.> delete foo +scratch/main> delete foo ``` ```ucm :error -.> delete lineToken.call +scratch/main> delete lineToken.call ``` However handling of blocks of other languages should be supported. diff --git a/unison-src/transcripts/transcript-parser-commands.output.md b/unison-src/transcripts/transcript-parser-commands.output.md index 15b72bc3b1..990d176110 100644 --- a/unison-src/transcripts/transcript-parser-commands.output.md +++ b/unison-src/transcripts/transcript-parser-commands.output.md @@ -20,7 +20,7 @@ x = 1 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -37,7 +37,7 @@ z ```ucm -.> delete foo +scratch/main> delete foo ⚠️ @@ -46,7 +46,7 @@ z ``` ```ucm -.> delete lineToken.call +scratch/main> delete lineToken.call ⚠️ From 2331c16770c3b8fdcc3c421a5b77c507cc516830 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 2 Jul 2024 14:54:15 -0700 Subject: [PATCH 366/631] Mostly Fix up deleting the branch you're on --- .../U/Codebase/Sqlite/Queries.hs | 2 +- .../Editor/HandleInput/DeleteBranch.hs | 28 +++++++++++-------- .../Editor/HandleInput/DeleteProject.hs | 15 +++++----- .../transcripts/delete-project-branch.md | 6 ++++ .../transcripts/delete-project.output.md | 4 +-- 5 files changed, 32 insertions(+), 23 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index c4e1e2c013..deabc0a91d 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3871,7 +3871,7 @@ deleteProject projectId = do -- After deleting `topic`: -- -- main <- topic2 -deleteProjectBranch :: ProjectId -> ProjectBranchId -> Transaction () +deleteProjectBranch :: (HasCallStack) => ProjectId -> ProjectBranchId -> Transaction () deleteProjectBranch projectId branchId = do maybeParentBranchId :: Maybe ProjectBranchId <- queryMaybeCol diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs index 0926417587..d1c14434c5 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs @@ -5,6 +5,7 @@ module Unison.Codebase.Editor.HandleInput.DeleteBranch ) where +import Data.List qualified as List import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite @@ -41,11 +42,13 @@ handleDeleteBranch projectAndBranchNamesToDelete = do Cli.runTransaction . runMaybeT $ asum [ parentBranch (branchToDelete ^. #projectId) (branchToDelete ^. #parentBranchId), - findMainBranchInProject (currentProject ^. #projectId), - findAnyBranchInProject (currentProject ^. #projectId), - findAnyBranchInCodebase, + findMainBranchInProjectExcept (currentProject ^. #projectId) (branchToDelete ^. #branchId), + -- Any branch in the codebase except the one we're deleting + findAnyBranchInProjectExcept (branchToDelete ^. #projectId) (branchToDelete ^. #branchId), + findAnyBranchInCodebaseExcept (branchToDelete ^. #projectId) (branchToDelete ^. #branchId), createDummyProject ] + nextLoc <- mayNextLocation `whenNothing` projectCreate False Nothing Cli.switchProject nextLoc doDeleteProjectBranch projectAndBranchToDelete @@ -54,23 +57,24 @@ handleDeleteBranch projectAndBranchNamesToDelete = do parentBranch projectId mayParentBranchId = do parentBranchId <- hoistMaybe mayParentBranchId pure (ProjectAndBranch projectId parentBranchId) - findMainBranchInProject :: ProjectId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) - findMainBranchInProject projectId = do + findMainBranchInProjectExcept :: ProjectId -> ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + findMainBranchInProjectExcept projectId exceptBranchId = do branch <- MaybeT $ Queries.loadProjectBranchByName projectId (unsafeFrom @Text "main") + guard (branch ^. #branchId /= exceptBranchId) pure (ProjectAndBranch projectId (branch ^. #branchId)) - findAnyBranchInProject :: ProjectId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) - findAnyBranchInProject projectId = do - (someBranchId, _) <- MaybeT . fmap listToMaybe $ Queries.loadAllProjectBranchesBeginningWith projectId Nothing + findAnyBranchInProjectExcept :: ProjectId -> ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + findAnyBranchInProjectExcept projectId exceptBranchId = do + (someBranchId, _) <- MaybeT . fmap (List.find (\(branchId, _) -> branchId /= exceptBranchId)) $ Queries.loadAllProjectBranchesBeginningWith projectId Nothing pure (ProjectAndBranch projectId someBranchId) - findAnyBranchInCodebase :: MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) - findAnyBranchInCodebase = do - (_, pbIds) <- MaybeT . fmap listToMaybe $ Queries.loadAllProjectBranchNamePairs + findAnyBranchInCodebaseExcept :: ProjectId -> ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId) + findAnyBranchInCodebaseExcept exceptProjectId exceptBranchId = do + (_, pbIds) <- MaybeT . fmap (List.find (\(_, ids) -> ids /= ProjectAndBranch exceptProjectId exceptBranchId)) $ Queries.loadAllProjectBranchNamePairs pure pbIds createDummyProject = error "TODO: create new branch or project if we delete the last branch you're on." -- | Delete a project branch and record an entry in the reflog. -doDeleteProjectBranch :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> Cli () +doDeleteProjectBranch :: (HasCallStack) => ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> Cli () doDeleteProjectBranch projectAndBranch = do Cli.runTransaction do Queries.deleteProjectBranch projectAndBranch.project.projectId projectAndBranch.branch.branchId diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs index e50c06e593..b843123c68 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs @@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.DeleteProject ) where -import Data.Function (on) import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -20,16 +19,16 @@ handleDeleteProject :: ProjectName -> Cli () handleDeleteProject projectName = do ProjectPath currentProject _ _ <- Cli.getCurrentProjectPath - deletedProject <- + projectToDelete <- Cli.runTransactionWithRollback \rollback -> do - project <- - Queries.loadProjectByName projectName & onNothingM do - rollback (Output.LocalProjectDoesntExist projectName) - Queries.deleteProject (project ^. #projectId) - pure project + Queries.loadProjectByName projectName & onNothingM do + rollback (Output.LocalProjectDoesntExist projectName) -- If the user is on the project that they're deleting, we create a new project to switch -- to. - when (((==) `on` (view #projectId)) deletedProject currentProject) do + when ((projectToDelete ^. #projectId) == (currentProject ^. #projectId)) do nextLoc <- projectCreate False Nothing Cli.switchProject nextLoc + + Cli.runTransaction do + Queries.deleteProject (projectToDelete ^. #projectId) diff --git a/unison-src/transcripts/delete-project-branch.md b/unison-src/transcripts/delete-project-branch.md index 091e9fa71c..41f1085292 100644 --- a/unison-src/transcripts/delete-project-branch.md +++ b/unison-src/transcripts/delete-project-branch.md @@ -25,3 +25,9 @@ You can delete the only branch in a project. ```ucm foo/main> delete.branch /main ``` + +You can delete the last branch in the codebase + +```ucm +scratch/main> delete.branch scratch/main +``` diff --git a/unison-src/transcripts/delete-project.output.md b/unison-src/transcripts/delete-project.output.md index 9f479983da..49b1a96a38 100644 --- a/unison-src/transcripts/delete-project.output.md +++ b/unison-src/transcripts/delete-project.output.md @@ -43,7 +43,7 @@ scratch/main> projects foo/main> delete.project foo 🎉 I've created the project with the randomly-chosen name - helpful-ladybug (use `project.rename ` to change + outstanding-rhino (use `project.rename ` to change it). 🎨 Type `ui` to explore this project's code in your browser. @@ -61,7 +61,7 @@ foo/main> delete.project foo scratch/main> projects 1. bar - 2. helpful-ladybug + 2. outstanding-rhino 3. scratch ``` From 1d5ae816de65c1a693f8e298c8a987b233661963 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 2 Jul 2024 15:38:14 -0700 Subject: [PATCH 367/631] Include trailing '!' in identifier names for hover --- unison-cli/src/Unison/LSP/VFS.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/LSP/VFS.hs b/unison-cli/src/Unison/LSP/VFS.hs index 4be5573a45..171b0fc870 100644 --- a/unison-cli/src/Unison/LSP/VFS.hs +++ b/unison-cli/src/Unison/LSP/VFS.hs @@ -81,7 +81,9 @@ identifierSplitAtPosition uri pos = do vf <- getVirtualFile uri PosPrefixInfo {fullLine, cursorPos} <- MaybeT (VFS.getCompletionPrefix pos vf) let (before, after) = Text.splitAt (cursorPos ^. character . to fromIntegral) fullLine - pure (Text.takeWhileEnd isIdentifierChar before, Text.takeWhile isIdentifierChar after) + pure (Text.takeWhileEnd isIdentifierChar before, + -- names can end with '!', and it's not a force, so we include it in the identifier if it's at the end. + Text.takeWhile (\c -> isIdentifierChar c || c == '!') after) where isIdentifierChar c = -- Manually exclude '!' and apostrophe, since those are usually just forces and From 92a74df8f837de3c131defb8947d7b09cc059ffd Mon Sep 17 00:00:00 2001 From: ChrisPenner Date: Tue, 2 Jul 2024 22:50:40 +0000 Subject: [PATCH 368/631] automatically run ormolu --- unison-cli/src/Unison/LSP/VFS.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/unison-cli/src/Unison/LSP/VFS.hs b/unison-cli/src/Unison/LSP/VFS.hs index 171b0fc870..8244d64615 100644 --- a/unison-cli/src/Unison/LSP/VFS.hs +++ b/unison-cli/src/Unison/LSP/VFS.hs @@ -81,9 +81,11 @@ identifierSplitAtPosition uri pos = do vf <- getVirtualFile uri PosPrefixInfo {fullLine, cursorPos} <- MaybeT (VFS.getCompletionPrefix pos vf) let (before, after) = Text.splitAt (cursorPos ^. character . to fromIntegral) fullLine - pure (Text.takeWhileEnd isIdentifierChar before, - -- names can end with '!', and it's not a force, so we include it in the identifier if it's at the end. - Text.takeWhile (\c -> isIdentifierChar c || c == '!') after) + pure + ( Text.takeWhileEnd isIdentifierChar before, + -- names can end with '!', and it's not a force, so we include it in the identifier if it's at the end. + Text.takeWhile (\c -> isIdentifierChar c || c == '!') after + ) where isIdentifierChar c = -- Manually exclude '!' and apostrophe, since those are usually just forces and From 06b731b7749c5a1aa8223d2fd15bbe13a68ebd5b Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 3 Jul 2024 11:19:18 -0400 Subject: [PATCH 369/631] report constructor aliases in `todo` --- .../Codebase/Editor/HandleInput/Todo.hs | 17 +++-- .../src/Unison/Codebase/Editor/Output.hs | 5 +- .../src/Unison/CommandLine/OutputMessages.hs | 31 ++++++++- .../src/Unison/Merge/DeclCoherencyCheck.hs | 63 +++++++++++++++++-- unison-src/transcripts/todo.md | 22 +++++++ unison-src/transcripts/todo.output.md | 41 ++++++++++++ 6 files changed, 167 insertions(+), 12 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index ef58f044b1..108ceee2a4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -4,6 +4,7 @@ module Unison.Codebase.Editor.HandleInput.Todo ) where +import Data.Either qualified as Either import Data.Set qualified as Set import U.Codebase.HashTags (BranchHash (..)) import U.Codebase.Sqlite.Operations qualified as Operations @@ -19,6 +20,7 @@ import Unison.Codebase.Causal qualified as Causal import Unison.Codebase.Editor.HandleInput.Merge2 (hasDefnsInLib) import Unison.Codebase.Editor.Output import Unison.Hash (HashFor (..)) +import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..), checkAllDeclCoherency) import Unison.Names qualified as Names import Unison.Prelude import Unison.Reference (TermReference) @@ -34,7 +36,7 @@ handleTodo = do let currentNamespace = Branch.head currentCausal let currentNamespaceWithoutLibdeps = Branch.deleteLibdeps currentNamespace - (defnsInLib, dependentsOfTodo, directDependencies, hashLen) <- + (defnsInLib, dependentsOfTodo, directDependencies, hashLen, incoherentDeclReasons) <- Cli.runTransaction do -- We call a shared `hasDefnsLib` helper even though we could easily duplicate the logic with the branch in hand defnsInLib <- do @@ -66,21 +68,28 @@ handleTodo = do hashLen <- Codebase.hashLength - pure (defnsInLib, dependentsOfTodo.terms, directDependencies, hashLen) + incoherentDeclReasons <- + fmap (Either.fromLeft (IncoherentDeclReasons [] [] [] [])) $ + checkAllDeclCoherency + Operations.expectDeclNumConstructors + (Names.lenientToNametree (Branch.toNames currentNamespaceWithoutLibdeps)) + + pure (defnsInLib, dependentsOfTodo.terms, directDependencies, hashLen, incoherentDeclReasons) ppe <- Cli.currentPrettyPrintEnvDecl Cli.respondNumbered $ Output'Todo TodoOutput - { hashLen, - defnsInLib, + { defnsInLib, dependentsOfTodo, directDependenciesWithoutNames = Defns { terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace), types = Set.difference directDependencies.types (Branch.deepTypeReferences currentNamespace) }, + hashLen, + incoherentDeclReasons, nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps), ppe } diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 7ee842a073..c85f884100 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -53,9 +53,11 @@ import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' import Unison.LabeledDependency (LabeledDependency) +import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..)) import Unison.Name (Name) import Unison.NameSegment (NameSegment) import Unison.Names (Names) +import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) @@ -82,7 +84,6 @@ import Unison.Util.Defns (DefnsF, defnsAreEmpty) import Unison.Util.Pretty qualified as P import Unison.Util.Relation (Relation) import Unison.WatchKind qualified as WK -import qualified Unison.Names as Names type ListDetailed = Bool @@ -157,6 +158,7 @@ data TodoOutput = TodoOutput dependentsOfTodo :: !(Set TermReferenceId), directDependenciesWithoutNames :: !(DefnsF Set TermReference TypeReference), hashLen :: !Int, + incoherentDeclReasons :: !IncoherentDeclReasons, nameConflicts :: !Names, ppe :: !PrettyPrintEnvDecl } @@ -167,6 +169,7 @@ todoOutputIsEmpty todo = && defnsAreEmpty todo.directDependenciesWithoutNames && Names.isEmpty todo.nameConflicts && not todo.defnsInLib + && todo.incoherentDeclReasons == IncoherentDeclReasons [] [] [] [] data AmbiguousReset'Argument = AmbiguousReset'Hash diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 0e3b93e5cb..470d6f88ad 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -87,6 +87,7 @@ import Unison.Hash32 (Hash32) import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' import Unison.LabeledDependency as LD +import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..)) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment @@ -1405,6 +1406,7 @@ notifyUser dir = \case pure . P.lines $ [ P.wrap "Sorry, I wasn't able to perform the merge:", "", + -- Note [ConstructorAliasMessage] If you change this, also change the other similar one P.wrap $ "On" <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") @@ -2728,12 +2730,39 @@ handleTodoOutput todo <> "subnamespaces representing library dependencies. Please move or remove it." else mempty + prettyConstructorAliases <- + if null todo.incoherentDeclReasons.constructorAliases + then pure mempty + else do + things <- + for todo.incoherentDeclReasons.constructorAliases \(typeName, conName1, conName2) -> do + n1 <- addNumberedArg (SA.Name conName1) + n2 <- addNumberedArg (SA.Name conName2) + pure (typeName, formatNum n1 <> prettyName conName1, formatNum n2 <> prettyName conName2) + pure $ + things + & map + ( \(typeName, prettyCon1, prettyCon2) -> + -- Note [ConstructorAliasMessage] If you change this, also change the other similar one + P.wrap + ( "The type" + <> prettyName typeName + <> "has a constructor with multiple names. Please delete all but one name for each" + <> "constructor." + ) + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines [prettyCon1, prettyCon2]) + ) + & P.sep "\n\n" + (pure . P.sep "\n\n" . P.nonEmpty) [ prettyDependentsOfTodo, prettyDirectTermDependenciesWithoutNames, prettyDirectTypeDependenciesWithoutNames, prettyConflicts, - prettyDefnsInLib + prettyDefnsInLib, + prettyConstructorAliases ] listOfDefinitions :: diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 907c453e20..302e46a298 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -83,6 +83,10 @@ module Unison.Merge.DeclCoherencyCheck ( IncoherentDeclReason (..), checkDeclCoherency, lenientCheckDeclCoherency, + + -- * Getting all failures rather than just the first + IncoherentDeclReasons (..), + checkAllDeclCoherency, ) where @@ -147,6 +151,53 @@ checkDeclCoherency loadDeclNumConstructors nametree = nametree ) +data IncoherentDeclReasons = IncoherentDeclReasons + { constructorAliases :: ![(Name, Name, Name)], + missingConstructorNames :: ![Name], + nestedDeclAliases :: ![(Name, Name)], + strayConstructors :: ![Name] + } + deriving stock (Eq, Generic) + +-- | Like 'checkDeclCoherency', but returns info about all of the incoherent decls found, not just the first. +checkAllDeclCoherency :: + forall m. + Monad m => + (TypeReferenceId -> m Int) -> + Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> + m (Either IncoherentDeclReasons DeclNameLookup) +checkAllDeclCoherency loadDeclNumConstructors nametree = do + State.runStateT doCheck emptyReasons <&> \(declNameLookup, reasons) -> + if reasons == emptyReasons + then Right declNameLookup + else Left (reverseReasons reasons) + where + doCheck :: StateT IncoherentDeclReasons m DeclNameLookup + doCheck = + checkDeclCoherencyWith + (lift . loadDeclNumConstructors) + ( OnIncoherentDeclReasons + { onConstructorAlias = \x y z -> #constructorAliases %= ((x, y, z) :), + onMissingConstructorName = \x -> #missingConstructorNames %= (x :), + onNestedDeclAlias = \x y -> #nestedDeclAliases %= ((x, y) :), + onStrayConstructor = \x -> #strayConstructors %= (x :) + } + ) + nametree + + emptyReasons :: IncoherentDeclReasons + emptyReasons = + IncoherentDeclReasons [] [] [] [] + + reverseReasons :: IncoherentDeclReasons -> IncoherentDeclReasons + reverseReasons reasons = + IncoherentDeclReasons + { constructorAliases = reverse reasons.constructorAliases, + missingConstructorNames = reverse reasons.missingConstructorNames, + nestedDeclAliases = reverse reasons.nestedDeclAliases, + strayConstructors = reverse reasons.strayConstructors + } + data OnIncoherentDeclReasons m = OnIncoherentDeclReasons { onConstructorAlias :: Name -> Name -> Name -> m (), onMissingConstructorName :: Name -> m (), @@ -171,22 +222,22 @@ checkDeclCoherencyWith loadDeclNumConstructors callbacks = (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> StateT DeclCoherencyCheckState m () go prefix (Nametree defns children) = do - for_ (Map.toList defns.terms) (checkDeclCoherency_terms callbacks prefix) + for_ (Map.toList defns.terms) (checkDeclCoherencyWith_DoTerms callbacks prefix) childrenWeWentInto <- forMaybe (Map.toList defns.types) - (checkDeclCoherency_types loadDeclNumConstructors callbacks go prefix children) + (checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix children) let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child -checkDeclCoherency_terms :: +checkDeclCoherencyWith_DoTerms :: forall m. Monad m => OnIncoherentDeclReasons m -> [NameSegment] -> (NameSegment, Referent) -> StateT DeclCoherencyCheckState m () -checkDeclCoherency_terms callbacks prefix = \case +checkDeclCoherencyWith_DoTerms callbacks prefix = \case (_, Referent.Ref _) -> pure () (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure () (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do @@ -209,7 +260,7 @@ checkDeclCoherency_terms callbacks prefix = \case name1 = Name.fromReverseSegments (name :| prefix) -checkDeclCoherency_types :: +checkDeclCoherencyWith_DoTypes :: forall m. Monad m => (TypeReferenceId -> m Int) -> @@ -222,7 +273,7 @@ checkDeclCoherency_types :: Map NameSegment (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> (NameSegment, TypeReference) -> StateT DeclCoherencyCheckState m (Maybe NameSegment) -checkDeclCoherency_types loadDeclNumConstructors callbacks go prefix children = \case +checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix children = \case (_, ReferenceBuiltin _) -> pure Nothing (name, ReferenceDerived typeRef) -> do state <- State.get diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md index 25f99aa401..5b4a40dec9 100644 --- a/unison-src/transcripts/todo.md +++ b/unison-src/transcripts/todo.md @@ -98,3 +98,25 @@ scratch/main> todo ```ucm:hide scratch/main> delete.project scratch ``` + +# Constructor aliases + +The `todo` command complains about constructor aliases. + +```ucm:hide +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +type Foo = One +``` + +```ucm +scratch/main> add +scratch/main> alias.term Foo.One Foo.Two +scratch/main> todo +``` + +```ucm:hide +scratch/main> delete.project scratch +``` diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index 07f0b03c33..0de57bd2cc 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -181,3 +181,44 @@ scratch/main> todo representing library dependencies. Please move or remove it. ``` +# Constructor aliases + +The `todo` command complains about constructor aliases. + +```unison +type Foo = One +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type Foo + +``` +```ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + +scratch/main> alias.term Foo.One Foo.Two + + Done. + +scratch/main> todo + + The type Foo has a constructor with multiple names. Please + delete all but one name for each constructor. + + 1. Foo.One + 2. Foo.Two + +``` From 052fd5194817140b8525d1e6f4c145b1afec937f Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 3 Jul 2024 11:38:33 -0400 Subject: [PATCH 370/631] report missing constructor names in `todo` --- .../src/Unison/CommandLine/OutputMessages.hs | 32 +++++++++++---- unison-src/transcripts/todo.md | 22 +++++++++++ unison-src/transcripts/todo.output.md | 39 +++++++++++++++++++ 3 files changed, 86 insertions(+), 7 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 470d6f88ad..0095974c1d 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1402,11 +1402,11 @@ notifyUser dir = \case <> "the same on both branches, or making neither of them a builtin, and then try the merge again." ) ] + -- Note [ConstructorAliasMessage] If you change this, also change the other similar one MergeConstructorAlias aliceOrBob typeName conName1 conName2 -> pure . P.lines $ [ P.wrap "Sorry, I wasn't able to perform the merge:", "", - -- Note [ConstructorAliasMessage] If you change this, also change the other similar one P.wrap $ "On" <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") @@ -1418,6 +1418,7 @@ notifyUser dir = \case "", P.wrap "Please delete all but one name for each constructor, and then try merging again." ] + -- Note [DefnsInLibMessage] If you change this, also change the other similar one MergeDefnsInLib aliceOrBob -> pure . P.lines $ [ P.wrap "Sorry, I wasn't able to perform the merge:", @@ -1425,12 +1426,12 @@ notifyUser dir = \case P.wrap $ "On" <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") - -- Note [DefnsInLibMessage] If you change this, also change the other similar one <> "there's a type or term at the top level of the `lib` namespace, where I only expect to find" <> "subnamespaces representing library dependencies.", "", P.wrap "Please move or remove it and then try merging again." ] + -- Note [MissingConstructorNameMessage] If you change this, also change the other similar one MergeMissingConstructorName aliceOrBob name -> pure . P.lines $ [ P.wrap "Sorry, I wasn't able to perform the merge:", @@ -2731,11 +2732,11 @@ handleTodoOutput todo else mempty prettyConstructorAliases <- - if null todo.incoherentDeclReasons.constructorAliases - then pure mempty - else do + case todo.incoherentDeclReasons.constructorAliases of + [] -> pure mempty + aliases -> do things <- - for todo.incoherentDeclReasons.constructorAliases \(typeName, conName1, conName2) -> do + for aliases \(typeName, conName1, conName2) -> do n1 <- addNumberedArg (SA.Name conName1) n2 <- addNumberedArg (SA.Name conName2) pure (typeName, formatNum n1 <> prettyName conName1, formatNum n2 <> prettyName conName2) @@ -2756,13 +2757,30 @@ handleTodoOutput todo ) & P.sep "\n\n" + prettyMissingConstructorNames <- + case todo.incoherentDeclReasons.missingConstructorNames of + [] -> pure mempty + types0 -> do + types1 <- + for types0 \typ -> do + n <- addNumberedArg (SA.Name typ) + pure (formatNum n <> prettyName typ) + -- Note [MissingConstructorNameMessage] If you change this, also change the other similar one + pure $ + P.wrap + "These types have some constructors with missing names:" + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines types1) + (pure . P.sep "\n\n" . P.nonEmpty) [ prettyDependentsOfTodo, prettyDirectTermDependenciesWithoutNames, prettyDirectTypeDependenciesWithoutNames, prettyConflicts, prettyDefnsInLib, - prettyConstructorAliases + prettyConstructorAliases, + prettyMissingConstructorNames ] listOfDefinitions :: diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md index 5b4a40dec9..20ed371465 100644 --- a/unison-src/transcripts/todo.md +++ b/unison-src/transcripts/todo.md @@ -120,3 +120,25 @@ scratch/main> todo ```ucm:hide scratch/main> delete.project scratch ``` + +# Missing constructor names + +The `todo` command complains about missing constructor names. + +```ucm:hide +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +type Foo = Bar +``` + +```ucm +scratch/main> add +scratch/main> delete.term Foo.Bar +scratch/main> todo +``` + +```ucm:hide +scratch/main> delete.project scratch +``` diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index 0de57bd2cc..0e8e23332a 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -222,3 +222,42 @@ scratch/main> todo 2. Foo.Two ``` +# Missing constructor names + +The `todo` command complains about missing constructor names. + +```unison +type Foo = Bar +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type Foo + +``` +```ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + +scratch/main> delete.term Foo.Bar + + Done. + +scratch/main> todo + + These types have some constructors with missing names: + + 1. Foo + +``` From 1857640da47272948bbe8b5eda2589b4cf6ba4d1 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 3 Jul 2024 11:53:45 -0400 Subject: [PATCH 371/631] report nested decl aliases in `todo` --- .../src/Unison/CommandLine/OutputMessages.hs | 94 ++++++++++++++----- unison-src/transcripts/todo.md | 22 +++++ unison-src/transcripts/todo.output.md | 40 ++++++++ 3 files changed, 131 insertions(+), 25 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 0095974c1d..0e315216db 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1450,6 +1450,7 @@ notifyUser dir = \case <> IP.makeExample IP.aliasTerm ["", prettyName name <> "."] <> "to give names to each unnamed constructor, and then try the merge again." ] + -- Note [NestedDeclAliasMessage] If you change this, also change the other similar one MergeNestedDeclAlias aliceOrBob shorterName longerName -> pure . P.wrap $ "On" @@ -2732,30 +2733,48 @@ handleTodoOutput todo else mempty prettyConstructorAliases <- - case todo.incoherentDeclReasons.constructorAliases of - [] -> pure mempty - aliases -> do - things <- - for aliases \(typeName, conName1, conName2) -> do - n1 <- addNumberedArg (SA.Name conName1) - n2 <- addNumberedArg (SA.Name conName2) - pure (typeName, formatNum n1 <> prettyName conName1, formatNum n2 <> prettyName conName2) - pure $ - things - & map - ( \(typeName, prettyCon1, prettyCon2) -> - -- Note [ConstructorAliasMessage] If you change this, also change the other similar one - P.wrap - ( "The type" - <> prettyName typeName - <> "has a constructor with multiple names. Please delete all but one name for each" - <> "constructor." - ) - <> P.newline - <> P.newline - <> P.indentN 2 (P.lines [prettyCon1, prettyCon2]) - ) - & P.sep "\n\n" + let -- We want to filter out constructor aliases whose types are part of a "nested decl alias" problem, because + -- otherwise we'd essentially be reporting those issues twice. + -- + -- That is, if we have two nested aliases like + -- + -- Foo = #XYZ + -- Foo.Bar = #XYZ#0 + -- + -- Foo.inner.Alias = #XYZ + -- Foo.inner.Alias.Constructor = #XYZ#0 + -- + -- then we'd prefer to say "oh no Foo and Foo.inner.Alias are aliases" but *not* additionally say "oh no + -- Foo.Bar and Foo.inner.Alias.Constructor are aliases". + notNestedDeclAlias (typeName, _, _) = + foldr + (\(short, long) acc -> typeName /= short && typeName /= long && acc) + True + todo.incoherentDeclReasons.nestedDeclAliases + in case filter notNestedDeclAlias todo.incoherentDeclReasons.constructorAliases of + [] -> pure mempty + aliases -> do + things <- + for aliases \(typeName, conName1, conName2) -> do + n1 <- addNumberedArg (SA.Name conName1) + n2 <- addNumberedArg (SA.Name conName2) + pure (typeName, formatNum n1 <> prettyName conName1, formatNum n2 <> prettyName conName2) + pure $ + things + & map + ( \(typeName, prettyCon1, prettyCon2) -> + -- Note [ConstructorAliasMessage] If you change this, also change the other similar one + P.wrap + ( "The type" + <> prettyName typeName + <> "has a constructor with multiple names. Please delete all but one name for each" + <> "constructor." + ) + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines [prettyCon1, prettyCon2]) + ) + & P.sep "\n\n" prettyMissingConstructorNames <- case todo.incoherentDeclReasons.missingConstructorNames of @@ -2773,6 +2792,30 @@ handleTodoOutput todo <> P.newline <> P.indentN 2 (P.lines types1) + prettyNestedDeclAliases <- + case todo.incoherentDeclReasons.nestedDeclAliases of + [] -> pure mempty + aliases0 -> do + aliases1 <- + for aliases0 \(short, long) -> do + n1 <- addNumberedArg (SA.Name short) + n2 <- addNumberedArg (SA.Name long) + pure (formatNum n1 <> prettyName short, formatNum n2 <> prettyName long) + -- Note [NestedDeclAliasMessage] If you change this, also change the other similar one + pure $ + aliases1 + & map + ( \(short, long) -> + P.wrap + ( "These types are aliases, but one is nested under the other. Please separate them or delete" + <> "one copy." + ) + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines [short, long]) + ) + & P.sep "\n\n" + (pure . P.sep "\n\n" . P.nonEmpty) [ prettyDependentsOfTodo, prettyDirectTermDependenciesWithoutNames, @@ -2780,7 +2823,8 @@ handleTodoOutput todo prettyConflicts, prettyDefnsInLib, prettyConstructorAliases, - prettyMissingConstructorNames + prettyMissingConstructorNames, + prettyNestedDeclAliases ] listOfDefinitions :: diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md index 20ed371465..d3cf81166c 100644 --- a/unison-src/transcripts/todo.md +++ b/unison-src/transcripts/todo.md @@ -142,3 +142,25 @@ scratch/main> todo ```ucm:hide scratch/main> delete.project scratch ``` + +# Nested decl aliases + +The `todo` command complains about nested decl aliases. + +```ucm:hide +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +structural type Foo a = One a | Two a a +structural type Foo.inner.Bar a = Uno a | Dos a a +``` + +```ucm +scratch/main> add +scratch/main> todo +``` + +```ucm:hide +scratch/main> delete.project scratch +``` diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index 0e8e23332a..32b35c50ba 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -261,3 +261,43 @@ scratch/main> todo 1. Foo ``` +# Nested decl aliases + +The `todo` command complains about nested decl aliases. + +```unison +structural type Foo a = One a | Two a a +structural type Foo.inner.Bar a = Uno a | Dos a a +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + structural type Foo a + structural type Foo.inner.Bar a + +``` +```ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type Foo a + structural type Foo.inner.Bar a + +scratch/main> todo + + These types are aliases, but one is nested under the other. + Please separate them or delete one copy. + + 1. Foo + 2. Foo.inner.Bar + +``` From 05d34024bd219b6870f4bc394954e330a7971f20 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 3 Jul 2024 11:59:17 -0400 Subject: [PATCH 372/631] report stray constructors in `todo` --- .../src/Unison/CommandLine/OutputMessages.hs | 30 ++++++++++-- unison-src/transcripts/todo.md | 22 +++++++++ unison-src/transcripts/todo.output.md | 46 +++++++++++++++++-- 3 files changed, 90 insertions(+), 8 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 0e315216db..d2684f1906 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1461,6 +1461,7 @@ notifyUser dir = \case <> P.group (prettyName shorterName <> ".") <> "I'm not able to perform a merge when a type exists nested under an alias of itself. Please separate them or" <> "delete one copy, and then try merging again." + -- Note [StrayConstructorMessage] If you change this, also change the other similar one MergeStrayConstructor aliceOrBob name -> pure . P.lines $ [ P.wrap $ @@ -2685,7 +2686,7 @@ handleTodoOutput todo & P.syntaxToColor pure (formatNum n <> name) pure $ - P.wrap "These terms call `todo`:" + P.wrap "These terms call `todo`." <> P.newline <> P.newline <> P.indentN 2 (P.lines terms) @@ -2699,7 +2700,7 @@ handleTodoOutput todo n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term))) pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen term)) pure $ - P.wrap "These terms do not have any names in the current namespace:" + P.wrap "These terms do not have any names in the current namespace." <> P.newline <> P.newline <> P.indentN 2 (P.lines terms) @@ -2713,7 +2714,7 @@ handleTodoOutput todo n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ))) pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen typ)) pure $ - P.wrap "These types do not have any names in the current namespace:" + P.wrap "These types do not have any names in the current namespace." <> P.newline <> P.newline <> P.indentN 2 (P.lines types) @@ -2787,7 +2788,7 @@ handleTodoOutput todo -- Note [MissingConstructorNameMessage] If you change this, also change the other similar one pure $ P.wrap - "These types have some constructors with missing names:" + "These types have some constructors with missing names." <> P.newline <> P.newline <> P.indentN 2 (P.lines types1) @@ -2816,6 +2817,24 @@ handleTodoOutput todo ) & P.sep "\n\n" + prettyStrayConstructors <- + case todo.incoherentDeclReasons.strayConstructors of + [] -> pure mempty + constructors0 -> do + constructors1 <- + for constructors0 \constructor -> do + n <- addNumberedArg (SA.Name constructor) + pure (formatNum n <> prettyName constructor) + -- Note [StrayConstructorMessage] If you change this, also change the other similar one + pure $ + P.wrap + ( "These constructors are not nested beneath their corresponding type names. Please either move or" + <> "delete them." + ) + <> P.newline + <> P.newline + <> P.indentN 2 (P.lines constructors1) + (pure . P.sep "\n\n" . P.nonEmpty) [ prettyDependentsOfTodo, prettyDirectTermDependenciesWithoutNames, @@ -2824,7 +2843,8 @@ handleTodoOutput todo prettyDefnsInLib, prettyConstructorAliases, prettyMissingConstructorNames, - prettyNestedDeclAliases + prettyNestedDeclAliases, + prettyStrayConstructors ] listOfDefinitions :: diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md index d3cf81166c..46e1eb6165 100644 --- a/unison-src/transcripts/todo.md +++ b/unison-src/transcripts/todo.md @@ -164,3 +164,25 @@ scratch/main> todo ```ucm:hide scratch/main> delete.project scratch ``` + +# Stray constructors + +The `todo` command complains about stray constructors. + +```ucm:hide +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +type Foo = Bar +``` + +```ucm +scratch/main> add +scratch/main> alias.term Foo.Bar Baz +scratch/main> todo +``` + +```ucm:hide +scratch/main> delete.project scratch +``` diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index 32b35c50ba..38c6cdb560 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -44,7 +44,7 @@ scratch/main> add scratch/main> todo - These terms call `todo`: + These terms call `todo`. 1. foo @@ -95,7 +95,7 @@ scratch/main> delete.namespace.force foo scratch/main> todo - These terms do not have any names in the current namespace: + These terms do not have any names in the current namespace. 1. #1jujb8oelv @@ -256,7 +256,7 @@ scratch/main> delete.term Foo.Bar scratch/main> todo - These types have some constructors with missing names: + These types have some constructors with missing names. 1. Foo @@ -301,3 +301,43 @@ scratch/main> todo 2. Foo.inner.Bar ``` +# Stray constructors + +The `todo` command complains about stray constructors. + +```unison +type Foo = Bar +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type Foo + +``` +```ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + +scratch/main> alias.term Foo.Bar Baz + + Done. + +scratch/main> todo + + These constructors are not nested beneath their corresponding + type names. Please either move or delete them. + + 1. Baz + +``` From a7820feeacfdb096d422d98718a39f0165b53799 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 3 Jul 2024 11:22:09 -0700 Subject: [PATCH 373/631] Deprecate root reflog behaviour in favour of project/branch reflogs --- .../U/Codebase/Sqlite/Operations.hs | 14 ++--- .../U/Codebase/Sqlite/Queries.hs | 15 +---- parser-typechecker/src/Unison/Codebase.hs | 2 +- .../Migrations/MigrateSchema5To6.hs | 16 ++++- .../src/Unison/Codebase/Editor/HandleInput.hs | 15 ++++- .../src/Unison/Codebase/Editor/Input.hs | 4 +- .../src/Unison/CommandLine/InputPatterns.hs | 59 ++++++++++++++++--- .../src/Unison/CommandLine/OutputMessages.hs | 12 ++-- unison-src/transcripts/reflog.md | 14 ++--- unison-src/transcripts/reflog.output.md | 48 ++++++--------- 10 files changed, 119 insertions(+), 80 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index 6373d5100e..e23e48d080 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -101,8 +101,7 @@ module U.Codebase.Sqlite.Operations expectProjectBranchHead, -- * reflog - getReflog, - appendReflog, + getDeprecatedRootReflog, getProjectReflog, appendProjectReflog, @@ -1486,16 +1485,11 @@ namespaceStatsForDbBranch = \case expectNamespaceStatsByHashId bhId -- | Gets the specified number of reflog entries in chronological order, most recent first. -getReflog :: Int -> Transaction [Reflog.Entry CausalHash Text] -getReflog numEntries = do - entries <- Q.getReflog numEntries +getDeprecatedRootReflog :: Int -> Transaction [Reflog.Entry CausalHash Text] +getDeprecatedRootReflog numEntries = do + entries <- Q.getDeprecatedRootReflog numEntries traverse (bitraverse Q.expectCausalHash pure) entries -appendReflog :: Reflog.Entry CausalHash Text -> Transaction () -appendReflog entry = do - dbEntry <- (bitraverse Q.saveCausalHash pure) entry - Q.appendReflog dbEntry - -- | Gets the specified number of reflog entries in chronological order, most recent first. getProjectReflog :: Int -> Transaction [ProjectReflog.Entry CausalHash] getProjectReflog numEntries = do diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index deabc0a91d..7912f9e4cd 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -211,8 +211,7 @@ module U.Codebase.Sqlite.Queries fuzzySearchTypes, -- * Reflog - appendReflog, - getReflog, + getDeprecatedRootReflog, appendProjectReflog, getProjectReflog, @@ -3472,16 +3471,8 @@ loadNamespaceStatsByHashId bhId = do WHERE namespace_hash_id = :bhId |] -appendReflog :: Reflog.Entry CausalHashId Text -> Transaction () -appendReflog entry = - execute - [sql| - INSERT INTO reflog (time, from_root_causal_id, to_root_causal_id, reason) - VALUES (@entry, @, @, @) - |] - -getReflog :: Int -> Transaction [Reflog.Entry CausalHashId Text] -getReflog numEntries = +getDeprecatedRootReflog :: Int -> Transaction [Reflog.Entry CausalHashId Text] +getDeprecatedRootReflog numEntries = queryListRow [sql| SELECT time, from_root_causal_id, to_root_causal_id, reason diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index b0bbdbfb9c..72f38578e5 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -75,7 +75,7 @@ module Unison.Codebase Queries.clearWatches, -- * Reflog - Operations.getReflog, + Operations.getDeprecatedRootReflog, -- * Unambiguous hash length SqliteCodebase.Operations.hashLength, diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema5To6.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema5To6.hs index 9395c3919d..2fa0205484 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema5To6.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema5To6.hs @@ -1,11 +1,14 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema5To6 (migrateSchema5To6) where +import Data.Bitraversable import Data.Text qualified as Text import Data.Time (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime) import System.FilePath (()) import U.Codebase.HashTags (CausalHash (CausalHash)) import U.Codebase.Reflog qualified as Reflog -import U.Codebase.Sqlite.Operations qualified as Ops import U.Codebase.Sqlite.Queries qualified as Q import Unison.Codebase (CodebasePath) import Unison.Hash qualified as Hash @@ -30,12 +33,21 @@ migrateCurrentReflog codebasePath = do -- so we check first to avoid triggering a bad foreign key constraint. haveFrom <- isJust <$> Q.loadCausalByCausalHash (Reflog.fromRootCausalHash oldEntry) haveTo <- isJust <$> Q.loadCausalByCausalHash (Reflog.toRootCausalHash oldEntry) - when (haveFrom && haveTo) $ Ops.appendReflog oldEntry + when (haveFrom && haveTo) $ appendReflog oldEntry Sqlite.unsafeIO . putStrLn $ "I migrated old reflog entries from " <> reflogPath <> " into the codebase; you may delete that file now if you like." where reflogPath :: FilePath reflogPath = codebasePath "reflog" + appendReflog :: Reflog.Entry CausalHash Text -> Sqlite.Transaction () + appendReflog entry = do + dbEntry <- (bitraverse Q.saveCausalHash pure) entry + Sqlite.execute + [Sqlite.sql| + INSERT INTO reflog (time, from_root_causal_id, to_root_causal_id, reason) + VALUES (@dbEntry, @, @, @) + |] + oldReflogEntries :: CodebasePath -> UTCTime -> IO [Reflog.Entry CausalHash Text] oldReflogEntries reflogPath now = ( do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index ec8ed7cb44..01f50dd901 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -210,11 +210,11 @@ loop e = do ] CreateMessage pretty -> Cli.respond $ PrintMessage pretty - ShowReflogI -> do + ShowRootReflogI -> do let numEntriesToShow = 500 (schLength, entries) <- Cli.runTransaction $ - (,) <$> Codebase.branchHashLength <*> Codebase.getReflog numEntriesToShow + (,) <$> Codebase.branchHashLength <*> Codebase.getDeprecatedRootReflog numEntriesToShow let moreEntriesToLoad = length entries == numEntriesToShow let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad) let (shortEntries, numberedEntries) = @@ -1044,7 +1044,16 @@ inputDescription input = ShowDefinitionI {} -> wat EditNamespaceI paths -> pure $ Text.unwords ("edit.namespace" : (Path.toText <$> paths)) - ShowReflogI {} -> wat + ShowRootReflogI {} -> pure "deprecated.root-reflog" + ShowProjectReflog mayProjName -> do + case mayProjName of + Nothing -> pure "project.reflog" + Just projName -> pure $ "project.reflog" <> into @Text projName + ShowProjectBranchReflog mayProjBranch -> do + case mayProjBranch of + Nothing -> pure "branch.reflog" + Just (PP.ProjectAndBranch Nothing branchName) -> pure $ "branch.reflog" <> into @Text branchName + Just (PP.ProjectAndBranch (Just projName) branchName) -> pure $ "branch.reflog" <> into @Text (PP.ProjectAndBranch projName branchName) SwitchBranchI {} -> wat TestI {} -> wat TodoI {} -> wat diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 739482c84f..346b27ccfa 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -191,7 +191,9 @@ data Input | StructuredFindReplaceI (HQ.HashQualified Name) -- sfind.replace rewriteQuery | -- Show provided definitions. ShowDefinitionI OutputLocation ShowDefinitionScope (NonEmpty (HQ.HashQualified Name)) - | ShowReflogI + | ShowRootReflogI {- Deprecated -} + | ShowProjectReflog (Maybe ProjectName) + | ShowProjectBranchReflog (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)) | UpdateBuiltinsI | MergeBuiltinsI (Maybe Path) | MergeIOBuiltinsI (Maybe Path) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index d93fac27fd..ab9eb5b65a 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -121,7 +121,9 @@ module Unison.CommandLine.InputPatterns upgradeCommitInputPattern, view, viewGlobal, - viewReflog, + deprecatedViewRootReflog, + branchReflog, + projectReflog, -- * Misc formatStructuredArgument, @@ -2246,19 +2248,58 @@ mergeOldPreviewInputPattern = branchInclusion = AllBranches } -viewReflog :: InputPattern -viewReflog = +deprecatedViewRootReflog :: InputPattern +deprecatedViewRootReflog = InputPattern - "reflog" + "deprecated.root-reflog" [] I.Visible [] - "`reflog` lists the changes that have affected the root namespace" + ( "`deprecated.root-reflog` lists the changes that have affected the root namespace. This has been deprecated in favor of " + <> makeExample branchReflog [] + <> " which shows the reflog for the current project." + ) ( \case - [] -> pure Input.ShowReflogI + [] -> pure Input.ShowRootReflogI _ -> Left . warn . P.string $ - I.patternName viewReflog ++ " doesn't take any arguments." + I.patternName deprecatedViewRootReflog ++ " doesn't take any arguments." + ) + +branchReflog :: InputPattern +branchReflog = + InputPattern + "branch.reflog" + ["reflog.branch", "reflog"] + I.Visible + [] + ( P.lines + [ "`branch.reflog` lists all the changes that have affected the current branch.", + "`branch.reflog /mybranch` lists all the changes that have affected /mybranch." + ] + ) + ( \case + [] -> pure $ Input.ShowProjectBranchReflog Nothing + [branchRef] -> Input.ShowProjectBranchReflog <$> (Just <$> handleMaybeProjectBranchArg branchRef) + _ -> Left (I.help branchReflog) + ) + +projectReflog :: InputPattern +projectReflog = + InputPattern + "project.reflog" + ["reflog.project"] + I.Visible + [] + ( P.lines + [ "`project.reflog` lists all the changes that have affected any branches in the current project.", + "`project.reflog myproject` lists all the changes that have affected any branches in myproject." + ] + ) + ( \case + [] -> pure $ Input.ShowProjectReflog Nothing + [projectRef] -> Input.ShowProjectReflog <$> (Just <$> handleProjectArg projectRef) + _ -> Left (I.help projectReflog) ) edit :: InputPattern @@ -3421,7 +3462,9 @@ validInputs = upgradeCommitInputPattern, view, viewGlobal, - viewReflog + deprecatedViewRootReflog, + branchReflog, + projectReflog ] -- | A map of all command patterns by pattern name or alias. diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 421dcfc43c..d5884bd83b 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -222,8 +222,8 @@ notifyNumbered = \case <> "to run the tests." <> "Or you can use" <> IP.makeExample' IP.undo - <> " or" - <> IP.makeExample' IP.viewReflog + <> " or use a hash from " + <> IP.makeExample' IP.branchReflog <> " to undo the results of this merge." ] ) @@ -249,8 +249,8 @@ notifyNumbered = \case <> "to run the tests." <> "Or you can use" <> IP.makeExample' IP.undo - <> " or" - <> IP.makeExample' IP.viewReflog + <> " or use a hash from " + <> IP.makeExample' IP.branchReflog <> " to undo the results of this merge." ] ) @@ -561,8 +561,8 @@ undoTip = tip $ "You can use" <> IP.makeExample' IP.undo - <> "or" - <> IP.makeExample' IP.viewReflog + <> " or use a hash from " + <> IP.makeExample' IP.branchReflog <> "to undo this change." notifyUser :: FilePath -> Output -> IO Pretty diff --git a/unison-src/transcripts/reflog.md b/unison-src/transcripts/reflog.md index 202dc50820..0c1a33fba1 100644 --- a/unison-src/transcripts/reflog.md +++ b/unison-src/transcripts/reflog.md @@ -1,5 +1,5 @@ ```ucm:hide -.> builtins.merge +scratch/main> builtins.merge lib.builtins ``` First we make two changes to the codebase, so that there's more than one line @@ -9,23 +9,23 @@ for the `reflog` command to display: x = 1 ``` ```ucm -.> add +scratch/main> add ``` ```unison y = 2 ``` ```ucm -.> add -.> view y +scratch/main> add +scratch/main> view y ``` ```ucm -.> reflog +scratch/main> reflog ``` If we `reset-root` to its previous value, `y` disappears. ```ucm -.> reset-root 2 +scratch/main> reset-root 2 ``` ```ucm:error -.> view y +scratch/main> view y ``` diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index 96e68114ff..54ea828006 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -19,7 +19,7 @@ x = 1 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -44,55 +44,43 @@ y = 2 ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: y : Nat -.> view y +scratch/main> view y y : Nat y = 2 ``` ```ucm -.> reflog +scratch/main> reflog - Here is a log of the root namespace hashes, starting with the - most recent, along with the command that got us there. Try: - - `fork 2 .old` - `fork #p611n6o5ve .old` to make an old namespace - accessible again, - - `reset-root #p611n6o5ve` to reset the root namespace and - its history to that of the - specified namespace. - - When Root Hash Action - 1. now #rmu2vgm86a add - 2. now #p611n6o5ve add - 3. now #4bigcpnl7t builtins.merge - 4. #sg60bvjo91 history starts here + ⚠️ - Tip: Use `diff.namespace 1 7` to compare namespaces between - two points in history. + The reflog is empty ``` If we `reset-root` to its previous value, `y` disappears. ```ucm -.> reset-root 2 - - Done. +scratch/main> reset-root 2 ``` ```ucm -.> view y +scratch/main> view y - ⚠️ - - The following names were not found in the codebase. Check your spelling. - y + y : Nat + y = 2 + +``` ``` + + + +🛑 + +The transcript was expecting an error in the stanza above, but did not encounter one. From 71486859514f0c86dcd0d297726da2fa2bfd5e3f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 3 Jul 2024 11:52:52 -0700 Subject: [PATCH 374/631] Implement DB combinators for project and branch reflogs --- .../U/Codebase/Sqlite/Operations.hs | 22 ++++- .../U/Codebase/Sqlite/Queries.hs | 41 +++++++-- .../Codebase/Editor/HandleInput/Reflogs.hs | 85 +++++++++++++++++++ unison-cli/unison-cli.cabal | 1 + 4 files changed, 138 insertions(+), 11 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index e23e48d080..6e76550bf4 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -103,6 +103,8 @@ module U.Codebase.Sqlite.Operations -- * reflog getDeprecatedRootReflog, getProjectReflog, + getProjectBranchReflog, + getGlobalReflog, appendProjectReflog, -- * low-level stuff @@ -1490,16 +1492,28 @@ getDeprecatedRootReflog numEntries = do entries <- Q.getDeprecatedRootReflog numEntries traverse (bitraverse Q.expectCausalHash pure) entries +-- | Gets the specified number of reflog entries for the given project in chronological order, most recent first. +getProjectReflog :: Int -> Db.ProjectId -> Transaction [ProjectReflog.Entry CausalHash] +getProjectReflog numEntries projectId = do + entries <- Q.getProjectReflog numEntries projectId + (traverse . traverse) Q.expectCausalHash entries + +-- | Gets the specified number of reflog entries for the specified ProjectBranch in chronological order, most recent first. +getProjectBranchReflog :: Int -> Db.ProjectBranchId -> Transaction [ProjectReflog.Entry CausalHash] +getProjectBranchReflog numEntries projectBranchId = do + entries <- Q.getProjectBranchReflog numEntries projectBranchId + (traverse . traverse) Q.expectCausalHash entries + -- | Gets the specified number of reflog entries in chronological order, most recent first. -getProjectReflog :: Int -> Transaction [ProjectReflog.Entry CausalHash] -getProjectReflog numEntries = do - entries <- Q.getProjectReflog numEntries +getGlobalReflog :: Int -> Transaction [ProjectReflog.Entry CausalHash] +getGlobalReflog numEntries = do + entries <- Q.getGlobalReflog numEntries (traverse . traverse) Q.expectCausalHash entries appendProjectReflog :: ProjectReflog.Entry CausalHash -> Transaction () appendProjectReflog entry = do dbEntry <- traverse Q.saveCausalHash entry - Q.appendProjectReflog dbEntry + Q.appendProjectBranchReflog dbEntry -- | Delete any name lookup that's not in the provided list. -- diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 7912f9e4cd..a52c448a67 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -212,8 +212,10 @@ module U.Codebase.Sqlite.Queries -- * Reflog getDeprecatedRootReflog, - appendProjectReflog, + appendProjectBranchReflog, getProjectReflog, + getProjectBranchReflog, + getGlobalReflog, -- * garbage collection garbageCollectObjectsWithoutHashes, @@ -3481,16 +3483,41 @@ getDeprecatedRootReflog numEntries = LIMIT :numEntries |] -appendProjectReflog :: ProjectReflog.Entry CausalHashId -> Transaction () -appendProjectReflog entry = +appendProjectBranchReflog :: ProjectReflog.Entry CausalHashId -> Transaction () +appendProjectBranchReflog entry = execute [sql| INSERT INTO project_branch_reflog (project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason) VALUES (@entry, @, @, @, @, @) |] -getProjectReflog :: Int -> Transaction [ProjectReflog.Entry CausalHashId] -getProjectReflog numEntries = +-- | Get x number of entries from the project reflog for the provided project +getProjectReflog :: Int -> ProjectId -> Transaction [ProjectReflog.Entry CausalHashId] +getProjectReflog numEntries projectId = + queryListRow + [sql| + SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason + FROM project_branch_reflog + ORDER BY time DESC + WHERE project_id = :projectId + LIMIT :numEntries + |] + +-- | Get x number of entries from the project reflog for the provided branch. +getProjectBranchReflog :: Int -> ProjectBranchId -> Transaction [ProjectReflog.Entry CausalHashId] +getProjectBranchReflog numEntries projectBranchId = + queryListRow + [sql| + SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason + FROM project_branch_reflog + ORDER BY time DESC + WHERE project_branch_id = :projectBranchId + LIMIT :numEntries + |] + +-- | Get x number of entries from the global reflog spanning all projects +getGlobalReflog :: Int -> Transaction [ProjectReflog.Entry CausalHashId] +getGlobalReflog numEntries = queryListRow [sql| SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason @@ -3805,7 +3832,7 @@ insertProjectBranch description causalHashId (ProjectBranch projectId branchId b VALUES (:projectId, :parentBranchId, :branchId) |] time <- Sqlite.unsafeIO $ Time.getCurrentTime - appendProjectReflog $ + appendProjectBranchReflog $ ProjectReflog.Entry { project = projectId, branch = branchId, @@ -3899,7 +3926,7 @@ setProjectBranchHead description projectId branchId causalHashId = do WHERE project_id = :projectId AND branch_id = :branchId |] time <- Sqlite.unsafeIO $ Time.getCurrentTime - appendProjectReflog $ + appendProjectBranchReflog $ ProjectReflog.Entry { project = projectId, branch = branchId, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs new file mode 100644 index 0000000000..39098d7eb0 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs @@ -0,0 +1,85 @@ +-- | Helpers for working with various kinds of reflogs. +module Unison.Codebase.Editor.HandleInput.Reflogs (showProjectBranchReflog) where + +import Control.Arrow ((&&&)) +import Data.List qualified as List +import Data.Time (UTCTime) +import U.Codebase.HashTags (CausalHash) +import U.Codebase.Reflog qualified as Reflog +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Editor.Output (Output (..)) +import Unison.Codebase.Editor.StructuredArgument qualified as SA +import Unison.Prelude +import Unison.Codebase.ShortCausalHash qualified as SCH + +showRootReflog :: Cli () +showRootReflog = do + let numEntriesToShow = 500 + (schLength, entries) <- + Cli.runTransaction $ + (,) <$> Codebase.branchHashLength <*> Codebase.getDeprecatedRootReflog numEntriesToShow + let moreEntriesToLoad = length entries == numEntriesToShow + let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad) + let (shortEntries, numberedEntries) = + unzip $ + expandedEntries <&> \(time, hash, reason) -> + let (exp, sa) = (SCH.fromHash schLength &&& SA.Namespace) hash + in ((time, exp, reason), sa) + Cli.setNumberedArgs numberedEntries + Cli.respond $ ShowReflog shortEntries + where + expandEntries :: + ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool) -> + Maybe ((Maybe UTCTime, CausalHash, Text), ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool)) + expandEntries ([], Just expectedHash, moreEntriesToLoad) = + if moreEntriesToLoad + then Nothing + else Just ((Nothing, expectedHash, "history starts here"), ([], Nothing, moreEntriesToLoad)) + expandEntries ([], Nothing, _moreEntriesToLoad) = Nothing + expandEntries (entries@(Reflog.Entry {time, fromRootCausalHash, toRootCausalHash, reason} : rest), mayExpectedHash, moreEntriesToLoad) = + Just $ + case mayExpectedHash of + Just expectedHash + | expectedHash == toRootCausalHash -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) + -- Historical discontinuity, insert a synthetic entry + | otherwise -> ((Nothing, toRootCausalHash, "(external change)"), (entries, Nothing, moreEntriesToLoad)) + -- No expectation, either because this is the most recent entry or + -- because we're recovering from a discontinuity + Nothing -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) + +showProjectBranchReflog :: Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) -> Cli () +showProjectBranchReflog = do + let numEntriesToShow = 500 + (schLength, entries) <- + Cli.runTransaction $ + (,) <$> Codebase.branchHashLength <*> Codebase.getDeprecatedRootReflog numEntriesToShow + let moreEntriesToLoad = length entries == numEntriesToShow + let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad) + let (shortEntries, numberedEntries) = + unzip $ + expandedEntries <&> \(time, hash, reason) -> + let (exp, sa) = (SCH.fromHash schLength &&& SA.Namespace) hash + in ((time, exp, reason), sa) + Cli.setNumberedArgs numberedEntries + Cli.respond $ ShowReflog shortEntries + where + expandEntries :: + ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool) -> + Maybe ((Maybe UTCTime, CausalHash, Text), ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool)) + expandEntries ([], Just expectedHash, moreEntriesToLoad) = + if moreEntriesToLoad + then Nothing + else Just ((Nothing, expectedHash, "history starts here"), ([], Nothing, moreEntriesToLoad)) + expandEntries ([], Nothing, _moreEntriesToLoad) = Nothing + expandEntries (entries@(Reflog.Entry {time, fromRootCausalHash, toRootCausalHash, reason} : rest), mayExpectedHash, moreEntriesToLoad) = + Just $ + case mayExpectedHash of + Just expectedHash + | expectedHash == toRootCausalHash -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) + -- Historical discontinuity, insert a synthetic entry + | otherwise -> ((Nothing, toRootCausalHash, "(external change)"), (entries, Nothing, moreEntriesToLoad)) + -- No expectation, either because this is the most recent entry or + -- because we're recovering from a discontinuity + Nothing -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index e44ca70810..6e36c0ae61 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -80,6 +80,7 @@ library Unison.Codebase.Editor.HandleInput.ProjectSwitch Unison.Codebase.Editor.HandleInput.Pull Unison.Codebase.Editor.HandleInput.Push + Unison.Codebase.Editor.HandleInput.Reflogs Unison.Codebase.Editor.HandleInput.ReleaseDraft Unison.Codebase.Editor.HandleInput.Run Unison.Codebase.Editor.HandleInput.RuntimeUtils From 7f57612f90961329e4843bdf262d8370d9ad7a68 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 3 Jul 2024 12:05:45 -0700 Subject: [PATCH 375/631] More WIP on reflog commands --- .../U/Codebase/Sqlite/Operations.hs | 26 ++-- .../U/Codebase/Sqlite/ProjectReflog.hs | 31 ++++- .../U/Codebase/Sqlite/Queries.hs | 8 +- parser-typechecker/src/Unison/Codebase.hs | 3 + .../src/Unison/Codebase/Editor/HandleInput.hs | 13 +- .../Codebase/Editor/HandleInput/Reflogs.hs | 128 ++++++++---------- .../src/Unison/Codebase/Editor/Input.hs | 5 +- .../src/Unison/Codebase/Editor/Output.hs | 27 ++-- .../src/Unison/CommandLine/InputPatterns.hs | 8 +- .../src/Unison/CommandLine/OutputMessages.hs | 36 +++++ 10 files changed, 179 insertions(+), 106 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs index 6e76550bf4..5c4e083616 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs @@ -1493,24 +1493,34 @@ getDeprecatedRootReflog numEntries = do traverse (bitraverse Q.expectCausalHash pure) entries -- | Gets the specified number of reflog entries for the given project in chronological order, most recent first. -getProjectReflog :: Int -> Db.ProjectId -> Transaction [ProjectReflog.Entry CausalHash] +getProjectReflog :: Int -> Db.ProjectId -> Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash] getProjectReflog numEntries projectId = do entries <- Q.getProjectReflog numEntries projectId - (traverse . traverse) Q.expectCausalHash entries + traverse hydrateProjectReflogEntry entries -- | Gets the specified number of reflog entries for the specified ProjectBranch in chronological order, most recent first. -getProjectBranchReflog :: Int -> Db.ProjectBranchId -> Transaction [ProjectReflog.Entry CausalHash] +getProjectBranchReflog :: Int -> Db.ProjectBranchId -> Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash] getProjectBranchReflog numEntries projectBranchId = do entries <- Q.getProjectBranchReflog numEntries projectBranchId - (traverse . traverse) Q.expectCausalHash entries + traverse hydrateProjectReflogEntry entries -- | Gets the specified number of reflog entries in chronological order, most recent first. -getGlobalReflog :: Int -> Transaction [ProjectReflog.Entry CausalHash] +getGlobalReflog :: Int -> Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash] getGlobalReflog numEntries = do entries <- Q.getGlobalReflog numEntries - (traverse . traverse) Q.expectCausalHash entries - -appendProjectReflog :: ProjectReflog.Entry CausalHash -> Transaction () + traverse hydrateProjectReflogEntry entries + +hydrateProjectReflogEntry :: ProjectReflog.Entry Db.ProjectId Db.ProjectBranchId Db.CausalHashId -> Transaction (ProjectReflog.Entry Project ProjectBranch CausalHash) +hydrateProjectReflogEntry entry = do + traverse Q.expectCausalHash entry + >>= ProjectReflog.projectAndBranch_ + %%~ ( \(projId, branchId) -> do + proj <- Q.expectProject projId + branch <- Q.expectProjectBranch projId branchId + pure (proj, branch) + ) + +appendProjectReflog :: ProjectReflog.Entry Db.ProjectId Db.ProjectBranchId CausalHash -> Transaction () appendProjectReflog entry = do dbEntry <- traverse Q.saveCausalHash entry Q.appendProjectBranchReflog dbEntry diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs index 4b7ff67a05..b759df2586 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/ProjectReflog.hs @@ -1,28 +1,45 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} -module U.Codebase.Sqlite.ProjectReflog where +module U.Codebase.Sqlite.ProjectReflog + ( Entry (..), + project_, + branch_, + projectAndBranch_, + ) +where +import Control.Lens import Data.Text (Text) import Data.Time (UTCTime) import U.Codebase.Sqlite.DbId (CausalHashId, ProjectBranchId, ProjectId) import Unison.Sqlite (FromRow (..), ToRow (..), field) -data Entry causal = Entry - { project :: ProjectId, - branch :: ProjectBranchId, +data Entry project branch causal = Entry + { project :: project, + branch :: branch, time :: UTCTime, fromRootCausalHash :: Maybe causal, toRootCausalHash :: causal, reason :: Text } - deriving stock (Show, Functor, Foldable, Traversable) + deriving stock (Eq, Show, Functor, Foldable, Traversable) -instance ToRow (Entry CausalHashId) where +project_ :: Lens (Entry project branch causal) (Entry project' branch causal) project project' +project_ = lens project (\e p -> e {project = p}) + +branch_ :: Lens (Entry project branch causal) (Entry project branch' causal) branch branch' +branch_ = lens branch (\e b -> e {branch = b}) + +-- | Both Project and Branch Ids are required to load a branch, so this is often more useful. +projectAndBranch_ :: Lens (Entry project branch causal) (Entry project' branch' causal) (project, branch) (project', branch') +projectAndBranch_ = lens (\Entry {..} -> (project, branch)) (\e (project, branch) -> e {project = project, branch = branch}) + +instance ToRow (Entry ProjectId ProjectBranchId CausalHashId) where toRow (Entry proj branch time fromRootCausalHash toRootCausalHash reason) = toRow (proj, branch, time, fromRootCausalHash, toRootCausalHash, reason) -instance FromRow (Entry CausalHashId) where +instance FromRow (Entry ProjectId ProjectBranchId CausalHashId) where fromRow = do project <- field branch <- field diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index a52c448a67..f77bfbbf41 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3483,7 +3483,7 @@ getDeprecatedRootReflog numEntries = LIMIT :numEntries |] -appendProjectBranchReflog :: ProjectReflog.Entry CausalHashId -> Transaction () +appendProjectBranchReflog :: ProjectReflog.Entry ProjectId ProjectBranchId CausalHashId -> Transaction () appendProjectBranchReflog entry = execute [sql| @@ -3492,7 +3492,7 @@ appendProjectBranchReflog entry = |] -- | Get x number of entries from the project reflog for the provided project -getProjectReflog :: Int -> ProjectId -> Transaction [ProjectReflog.Entry CausalHashId] +getProjectReflog :: Int -> ProjectId -> Transaction [ProjectReflog.Entry ProjectId ProjectBranchId CausalHashId] getProjectReflog numEntries projectId = queryListRow [sql| @@ -3504,7 +3504,7 @@ getProjectReflog numEntries projectId = |] -- | Get x number of entries from the project reflog for the provided branch. -getProjectBranchReflog :: Int -> ProjectBranchId -> Transaction [ProjectReflog.Entry CausalHashId] +getProjectBranchReflog :: Int -> ProjectBranchId -> Transaction [ProjectReflog.Entry ProjectId ProjectBranchId CausalHashId] getProjectBranchReflog numEntries projectBranchId = queryListRow [sql| @@ -3516,7 +3516,7 @@ getProjectBranchReflog numEntries projectBranchId = |] -- | Get x number of entries from the global reflog spanning all projects -getGlobalReflog :: Int -> Transaction [ProjectReflog.Entry CausalHashId] +getGlobalReflog :: Int -> Transaction [ProjectReflog.Entry ProjectId ProjectBranchId CausalHashId] getGlobalReflog numEntries = queryListRow [sql| diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 72f38578e5..2271ff62d0 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -76,6 +76,9 @@ module Unison.Codebase -- * Reflog Operations.getDeprecatedRootReflog, + Operations.getProjectBranchReflog, + Operations.getProjectReflog, + Operations.getGlobalReflog, -- * Unambiguous hash length SqliteCodebase.Operations.hashLength, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 01f50dd901..b1350a3bf5 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -79,6 +79,7 @@ import Unison.Codebase.Editor.HandleInput.ProjectSwitch (projectSwitch) import Unison.Codebase.Editor.HandleInput.Projects (handleProjects) import Unison.Codebase.Editor.HandleInput.Pull (handlePull, mergeBranchAndPropagateDefaultPatch) import Unison.Codebase.Editor.HandleInput.Push (handlePushRemoteBranch) +import Unison.Codebase.Editor.HandleInput.Reflogs qualified as Reflogs import Unison.Codebase.Editor.HandleInput.ReleaseDraft (handleReleaseDraft) import Unison.Codebase.Editor.HandleInput.Run (handleRun) import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils @@ -243,6 +244,14 @@ loop e = do -- No expectation, either because this is the most recent entry or -- because we're recovering from a discontinuity Nothing -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) + ShowProjectBranchReflogI mayProjBranch -> do + Reflogs.showProjectBranchReflog mayProjBranch + ShowGlobalReflogI -> do + Reflogs.showGlobalReflog + ShowProjectReflogI mayProj -> do + Reflogs.showProjectReflog mayProj + ShowProjectReflogI mayProj -> do + Reflogs.showProjectReflog mayProj ResetI newRoot mtarget -> do newRoot <- case newRoot of @@ -1045,11 +1054,11 @@ inputDescription input = EditNamespaceI paths -> pure $ Text.unwords ("edit.namespace" : (Path.toText <$> paths)) ShowRootReflogI {} -> pure "deprecated.root-reflog" - ShowProjectReflog mayProjName -> do + ShowProjectReflogI mayProjName -> do case mayProjName of Nothing -> pure "project.reflog" Just projName -> pure $ "project.reflog" <> into @Text projName - ShowProjectBranchReflog mayProjBranch -> do + ShowProjectBranchReflogI mayProjBranch -> do case mayProjBranch of Nothing -> pure "branch.reflog" Just (PP.ProjectAndBranch Nothing branchName) -> pure $ "branch.reflog" <> into @Text branchName diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs index 39098d7eb0..acc7fce3f6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs @@ -1,85 +1,75 @@ -- | Helpers for working with various kinds of reflogs. -module Unison.Codebase.Editor.HandleInput.Reflogs (showProjectBranchReflog) where +module Unison.Codebase.Editor.HandleInput.Reflogs + ( showProjectBranchReflog, + ) +where import Control.Arrow ((&&&)) -import Data.List qualified as List import Data.Time (UTCTime) import U.Codebase.HashTags (CausalHash) import U.Codebase.Reflog qualified as Reflog 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.Codebase qualified as Codebase import Unison.Codebase.Editor.Output (Output (..)) +import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Editor.StructuredArgument qualified as SA -import Unison.Prelude import Unison.Codebase.ShortCausalHash qualified as SCH +import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) +import Unison.Prelude -showRootReflog :: Cli () -showRootReflog = do - let numEntriesToShow = 500 - (schLength, entries) <- - Cli.runTransaction $ - (,) <$> Codebase.branchHashLength <*> Codebase.getDeprecatedRootReflog numEntriesToShow - let moreEntriesToLoad = length entries == numEntriesToShow - let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad) - let (shortEntries, numberedEntries) = - unzip $ - expandedEntries <&> \(time, hash, reason) -> - let (exp, sa) = (SCH.fromHash schLength &&& SA.Namespace) hash - in ((time, exp, reason), sa) - Cli.setNumberedArgs numberedEntries - Cli.respond $ ShowReflog shortEntries - where - expandEntries :: - ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool) -> - Maybe ((Maybe UTCTime, CausalHash, Text), ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool)) - expandEntries ([], Just expectedHash, moreEntriesToLoad) = - if moreEntriesToLoad - then Nothing - else Just ((Nothing, expectedHash, "history starts here"), ([], Nothing, moreEntriesToLoad)) - expandEntries ([], Nothing, _moreEntriesToLoad) = Nothing - expandEntries (entries@(Reflog.Entry {time, fromRootCausalHash, toRootCausalHash, reason} : rest), mayExpectedHash, moreEntriesToLoad) = - Just $ - case mayExpectedHash of - Just expectedHash - | expectedHash == toRootCausalHash -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) - -- Historical discontinuity, insert a synthetic entry - | otherwise -> ((Nothing, toRootCausalHash, "(external change)"), (entries, Nothing, moreEntriesToLoad)) - -- No expectation, either because this is the most recent entry or - -- because we're recovering from a discontinuity - Nothing -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) +-- showRootReflog :: Cli () +-- showRootReflog = do +-- let numEntriesToShow = 500 +-- (schLength, entries) <- +-- Cli.runTransaction $ +-- (,) <$> Codebase.branchHashLength <*> Codebase.getDeprecatedRootReflog numEntriesToShow +-- let moreEntriesToLoad = length entries == numEntriesToShow +-- let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad) +-- let (shortEntries, numberedEntries) = +-- unzip $ +-- expandedEntries <&> \(time, hash, reason) -> +-- let (exp, sa) = (SCH.fromHash schLength &&& SA.Namespace) hash +-- in ((time, exp, reason), sa) +-- Cli.setNumberedArgs numberedEntries +-- Cli.respond $ ShowReflog shortEntries +-- where +-- expandEntries :: +-- ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool) -> +-- Maybe ((Maybe UTCTime, CausalHash, Text), ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool)) +-- expandEntries ([], Just expectedHash, moreEntriesToLoad) = +-- if moreEntriesToLoad +-- then Nothing +-- else Just ((Nothing, expectedHash, "history starts here"), ([], Nothing, moreEntriesToLoad)) +-- expandEntries ([], Nothing, _moreEntriesToLoad) = Nothing +-- expandEntries (entries@(Reflog.Entry {time, fromRootCausalHash, toRootCausalHash, reason} : rest), mayExpectedHash, moreEntriesToLoad) = +-- Just $ +-- case mayExpectedHash of +-- Just expectedHash +-- | expectedHash == toRootCausalHash -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) +-- -- Historical discontinuity, insert a synthetic entry +-- | otherwise -> ((Nothing, toRootCausalHash, "(external change)"), (entries, Nothing, moreEntriesToLoad)) +-- -- No expectation, either because this is the most recent entry or +-- -- because we're recovering from a discontinuity +-- Nothing -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) showProjectBranchReflog :: Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) -> Cli () -showProjectBranchReflog = do +showProjectBranchReflog mayProjectAndBranch = do + ProjectAndBranch project branch <- case mayProjectAndBranch of + Nothing -> Cli.getCurrentProjectAndBranch + Just pab -> ProjectUtils.resolveProjectBranch (second Just pab) let numEntriesToShow = 500 - (schLength, entries) <- - Cli.runTransaction $ - (,) <$> Codebase.branchHashLength <*> Codebase.getDeprecatedRootReflog numEntriesToShow - let moreEntriesToLoad = length entries == numEntriesToShow - let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad) - let (shortEntries, numberedEntries) = - unzip $ - expandedEntries <&> \(time, hash, reason) -> - let (exp, sa) = (SCH.fromHash schLength &&& SA.Namespace) hash - in ((time, exp, reason), sa) - Cli.setNumberedArgs numberedEntries - Cli.respond $ ShowReflog shortEntries - where - expandEntries :: - ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool) -> - Maybe ((Maybe UTCTime, CausalHash, Text), ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool)) - expandEntries ([], Just expectedHash, moreEntriesToLoad) = - if moreEntriesToLoad - then Nothing - else Just ((Nothing, expectedHash, "history starts here"), ([], Nothing, moreEntriesToLoad)) - expandEntries ([], Nothing, _moreEntriesToLoad) = Nothing - expandEntries (entries@(Reflog.Entry {time, fromRootCausalHash, toRootCausalHash, reason} : rest), mayExpectedHash, moreEntriesToLoad) = - Just $ - case mayExpectedHash of - Just expectedHash - | expectedHash == toRootCausalHash -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) - -- Historical discontinuity, insert a synthetic entry - | otherwise -> ((Nothing, toRootCausalHash, "(external change)"), (entries, Nothing, moreEntriesToLoad)) - -- No expectation, either because this is the most recent entry or - -- because we're recovering from a discontinuity - Nothing -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) + entries <- + Cli.runTransaction $ do + schLength <- Codebase.branchHashLength + entries <- Codebase.getProjectBranchReflog numEntriesToShow branch.branchId + entries + & (fmap . fmap) SCH.fromHash schLength + & pure + let moreEntriesToLoad = + if length entries == numEntriesToShow + then Output.MoreEntriesThanShown + else Output.AllEntriesShown + Cli.respondNumbered $ ShowProjectBranchReflog moreEntriesToLoad shortEntries diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 346b27ccfa..f9ad1ad34b 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -192,8 +192,9 @@ data Input | -- Show provided definitions. ShowDefinitionI OutputLocation ShowDefinitionScope (NonEmpty (HQ.HashQualified Name)) | ShowRootReflogI {- Deprecated -} - | ShowProjectReflog (Maybe ProjectName) - | ShowProjectBranchReflog (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)) + | ShowGlobalReflogI + | ShowProjectReflogI (Maybe ProjectName) + | ShowProjectBranchReflogI (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)) | UpdateBuiltinsI | MergeBuiltinsI (Maybe Path) | MergeIOBuiltinsI (Maybe Path) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 47f6acb311..9477ce4197 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -10,6 +10,7 @@ module Unison.Codebase.Editor.Output TestReportStats (..), TodoOutput (..), todoOutputIsEmpty, + MoreEntriesThanShown (..), UndoFailureReason (..), ShareError (..), UpdateOrUpgrade (..), @@ -29,6 +30,7 @@ import U.Codebase.Branch.Diff (NameChanges) import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite +import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog import Unison.Auth.Types (CredentialFailure) import Unison.Cli.MergeTypes (MergeSourceAndTarget, MergeSourceOrTarget) import Unison.Cli.Share.Projects.Types qualified as Share @@ -43,7 +45,7 @@ import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) import Unison.Codebase.IntegrityCheck (IntegrityResult (..)) import Unison.Codebase.Path (Path') import Unison.Codebase.Path qualified as Path -import Unison.Codebase.ProjectPath (ProjectPath) +import Unison.Codebase.ProjectPath (Project, ProjectBranch, ProjectPath) import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH @@ -57,6 +59,7 @@ import Unison.LabeledDependency (LabeledDependency) import Unison.Name (Name) import Unison.NameSegment (NameSegment) import Unison.Names (Names) +import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) @@ -83,7 +86,6 @@ import Unison.Util.Defns (DefnsF, defnsAreEmpty) import Unison.Util.Pretty qualified as P import Unison.Util.Relation (Relation) import Unison.WatchKind qualified as WK -import qualified Unison.Names as Names type ListDetailed = Bool @@ -152,6 +154,7 @@ data NumberedOutput PPE.PrettyPrintEnv -- PPE containing names for everything from the root namespace. ProjectPath -- The namespace we're checking dependencies for. (Map LabeledDependency (Set Name)) -- Mapping of external dependencies to their local dependents. + | ShowProjectBranchReflog UTCTime {- current time -} MoreEntriesThanShown [ProjectReflog.Entry Project ProjectBranch (CausalHash, SCH.ShortCausalHash)] data TodoOutput = TodoOutput { dependentsOfTodo :: !(Set TermReferenceId), @@ -187,15 +190,15 @@ data Output | -- | Function found, but has improper type -- Note: the constructor name is misleading here; we weren't necessarily looking for a "main". BadMainFunction + -- | what we were trying to do (e.g. "run", "io.test") Text - -- ^ what we were trying to do (e.g. "run", "io.test") + -- | name of function (HQ.HashQualified Name) - -- ^ name of function + -- | bad type of function (Type Symbol Ann) - -- ^ bad type of function PPE.PrettyPrintEnv + -- | acceptable type(s) of function [Type Symbol Ann] - -- ^ acceptable type(s) of function | BranchEmpty WhichBranchEmpty | LoadPullRequest (ReadRemoteNamespace Void) (ReadRemoteNamespace Void) Path' Path' Path' Path' | CreatedNewBranch Path.Absolute @@ -232,12 +235,12 @@ data Output -- for terms. This additional info is used to provide an enhanced -- error message. SearchTermsNotFoundDetailed + -- | @True@ if we are searching for a term, @False@ if we are searching for a type Bool - -- ^ @True@ if we are searching for a term, @False@ if we are searching for a type + -- | Misses (search terms that returned no hits for terms or types) [HQ.HashQualified Name] - -- ^ Misses (search terms that returned no hits for terms or types) + -- | Hits for types if we are searching for terms or terms if we are searching for types [HQ.HashQualified Name] - -- ^ Hits for types if we are searching for terms or terms if we are searching for types | -- ask confirmation before deleting the last branch that contains some defns -- `Path` is one of the paths the user has requested to delete, and is paired -- with whatever named definitions would not have any remaining names if @@ -379,8 +382,8 @@ data Output | CalculatingDiff | -- | The `local` in a `clone remote local` is ambiguous AmbiguousCloneLocal + -- | Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) - -- ^ Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) | -- | The `remote` in a `clone remote local` is ambiguous AmbiguousCloneRemote ProjectName (ProjectAndBranch ProjectName ProjectBranchName) @@ -420,6 +423,9 @@ data Output | PullIntoMissingBranch !(ReadRemoteNamespace Share.RemoteProjectBranch) !(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) | NoMergeInProgress +data MoreEntriesThanShown = MoreEntriesThanShown | AllEntriesShown + deriving (Eq, Show) + data UpdateOrUpgrade = UOUUpdate | UOUUpgrade -- | What did we create a project branch from? @@ -677,3 +683,4 @@ isNumberedFailure = \case ListNamespaceDependencies {} -> False TestResults _ _ _ _ _ fails -> not (null fails) Output'Todo {} -> False + ShowProjectBranchReflog {} -> False diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index ab9eb5b65a..132f27b6f4 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2279,8 +2279,8 @@ branchReflog = ] ) ( \case - [] -> pure $ Input.ShowProjectBranchReflog Nothing - [branchRef] -> Input.ShowProjectBranchReflog <$> (Just <$> handleMaybeProjectBranchArg branchRef) + [] -> pure $ Input.ShowProjectBranchReflogI Nothing + [branchRef] -> Input.ShowProjectBranchReflogI <$> (Just <$> handleMaybeProjectBranchArg branchRef) _ -> Left (I.help branchReflog) ) @@ -2297,8 +2297,8 @@ projectReflog = ] ) ( \case - [] -> pure $ Input.ShowProjectReflog Nothing - [projectRef] -> Input.ShowProjectReflog <$> (Just <$> handleProjectArg projectRef) + [] -> pure $ Input.ShowProjectReflogI Nothing + [projectRef] -> Input.ShowProjectReflogI <$> (Just <$> handleProjectArg projectRef) _ -> Left (I.help projectReflog) ) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index d5884bd83b..8b450c00d2 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -37,6 +37,7 @@ import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Reference qualified as Reference import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) +import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog import Unison.ABT qualified as ABT import Unison.Auth.Types qualified as Auth import Unison.Builtin.Decls qualified as DD @@ -553,6 +554,7 @@ notifyNumbered = \case & Set.toList & fmap (\name -> formatNum (getNameNumber name) <> prettyName name) & P.lines + ShowProjectBranchReflog now moreToShow entries -> displayProjectBranchReflogEntries now moreToShow entries where absPathToBranchId = BranchAtPath @@ -3375,3 +3377,37 @@ listDependentsOrDependencies ppe labelStart label lds types terms = P.indentN 2 . P.numberedListFrom (length types) $ c . prettyHashQualified <$> terms ] c = P.syntaxToColor + +displayProjectBranchReflogEntries :: + UTCTime -> + E.MoreEntriesThanShown -> + [ProjectReflog.Entry Project ProjectBranch (CausalHash, ShortCausalHash)] -> + (Pretty, NumberedArgs) +displayProjectBranchReflogEntries _ _ [] = + (P.warnCallout "The reflog is empty", mempty) +displayProjectBranchReflogEntries now _ entries = + let (entryRows, numberedArgs) = foldMap renderEntry entries + rendered = + P.lines + [ header, + "", + P.numberedColumnNHeader ["Branch", "When", "Hash", "Description"] entryRows + ] + in (rendered, numberedArgs) + where + header = + P.lines + [ P.wrap $ + "Below is a record of recent changes, you can use " + <> IP.makeExample IP.reset ["#abcdef"] + <> " to reset the current branch to a previous state.", + "", + tip $ "Use " <> IP.makeExample IP.diffNamespace ["1", "7"] <> " to compare between points in history." + ] + renderEntry :: ProjectReflog.Entry Project ProjectBranch (CausalHash, SCH.ShortCausalHash) -> ([[Pretty]], NumberedArgs) + renderEntry ProjectReflog.Entry {time, project, branch, toRootCausalHash = (toCH, toSCH), reason} = + ([[prettyProjectAndBranchName $ ProjectAndBranch project.name branch.name, prettyHumanReadableTime now time, P.blue (prettySCH toSCH), P.text $ truncateReason reason]], [SA.Namespace toCH]) + truncateReason :: Text -> Text + truncateReason txt = case Text.splitAt 60 txt of + (short, "") -> short + (short, _) -> short <> "..." From 2db50ad848c1fcdc1e9956bcc7c68f980f11add5 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 3 Jul 2024 15:54:48 -0700 Subject: [PATCH 376/631] Specialize 'fromHash' to CausalHash --- parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs b/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs index 7e8b40e75b..c23babd330 100644 --- a/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs +++ b/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs @@ -10,6 +10,7 @@ where import Data.Set qualified as Set import Data.Text qualified as Text +import U.Codebase.HashTags (CausalHash (unCausalHash)) import U.Util.Base32Hex qualified as Base32Hex import Unison.Hash qualified as Hash import Unison.Prelude @@ -24,9 +25,9 @@ toString = Text.unpack . toText toHash :: (Coercible Hash.Hash h) => ShortCausalHash -> Maybe h toHash = fmap coerce . Hash.fromBase32HexText . toText -fromHash :: (Coercible h Hash.Hash) => Int -> h -> ShortCausalHash +fromHash :: Int -> CausalHash -> ShortCausalHash fromHash len = - ShortCausalHash . Text.take len . Hash.toBase32HexText . coerce + ShortCausalHash . Text.take len . Hash.toBase32HexText . unCausalHash -- | This allows a full hash to be preserved as a `ShortCausalHash`. -- From 31874bd199a28dc9ffa51bb6817529a7e75f30f7 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 3 Jul 2024 15:54:48 -0700 Subject: [PATCH 377/631] Add reflog.global command --- .../src/Unison/Codebase/Editor/HandleInput.hs | 4 +- .../Codebase/Editor/HandleInput/Reflogs.hs | 69 +++++++------------ .../src/Unison/CommandLine/InputPatterns.hs | 17 +++++ 3 files changed, 43 insertions(+), 47 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index b1350a3bf5..4c3731aba5 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -114,7 +114,6 @@ import Unison.CommandLine.InputPatterns qualified as IP import Unison.CommandLine.InputPatterns qualified as InputPatterns import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration qualified as DD -import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' import Unison.LabeledDependency (LabeledDependency) @@ -250,8 +249,6 @@ loop e = do Reflogs.showGlobalReflog ShowProjectReflogI mayProj -> do Reflogs.showProjectReflog mayProj - ShowProjectReflogI mayProj -> do - Reflogs.showProjectReflog mayProj ResetI newRoot mtarget -> do newRoot <- case newRoot of @@ -1054,6 +1051,7 @@ inputDescription input = EditNamespaceI paths -> pure $ Text.unwords ("edit.namespace" : (Path.toText <$> paths)) ShowRootReflogI {} -> pure "deprecated.root-reflog" + ShowGlobalReflogI {} -> pure "reflog.global" ShowProjectReflogI mayProjName -> do case mayProjName of Nothing -> pure "project.reflog" diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs index acc7fce3f6..23c0841d39 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs @@ -1,75 +1,56 @@ -- | Helpers for working with various kinds of reflogs. module Unison.Codebase.Editor.HandleInput.Reflogs ( showProjectBranchReflog, + showProjectReflog, + showGlobalReflog, ) where -import Control.Arrow ((&&&)) -import Data.Time (UTCTime) +import Data.Time (getCurrentTime) import U.Codebase.HashTags (CausalHash) -import U.Codebase.Reflog qualified as Reflog +import U.Codebase.Sqlite.Project (Project) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch) +import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog 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.Codebase qualified as Codebase -import Unison.Codebase.Editor.Output (Output (..)) import Unison.Codebase.Editor.Output qualified as Output -import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Prelude - --- showRootReflog :: Cli () --- showRootReflog = do --- let numEntriesToShow = 500 --- (schLength, entries) <- --- Cli.runTransaction $ --- (,) <$> Codebase.branchHashLength <*> Codebase.getDeprecatedRootReflog numEntriesToShow --- let moreEntriesToLoad = length entries == numEntriesToShow --- let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad) --- let (shortEntries, numberedEntries) = --- unzip $ --- expandedEntries <&> \(time, hash, reason) -> --- let (exp, sa) = (SCH.fromHash schLength &&& SA.Namespace) hash --- in ((time, exp, reason), sa) --- Cli.setNumberedArgs numberedEntries --- Cli.respond $ ShowReflog shortEntries --- where --- expandEntries :: --- ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool) -> --- Maybe ((Maybe UTCTime, CausalHash, Text), ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool)) --- expandEntries ([], Just expectedHash, moreEntriesToLoad) = --- if moreEntriesToLoad --- then Nothing --- else Just ((Nothing, expectedHash, "history starts here"), ([], Nothing, moreEntriesToLoad)) --- expandEntries ([], Nothing, _moreEntriesToLoad) = Nothing --- expandEntries (entries@(Reflog.Entry {time, fromRootCausalHash, toRootCausalHash, reason} : rest), mayExpectedHash, moreEntriesToLoad) = --- Just $ --- case mayExpectedHash of --- Just expectedHash --- | expectedHash == toRootCausalHash -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) --- -- Historical discontinuity, insert a synthetic entry --- | otherwise -> ((Nothing, toRootCausalHash, "(external change)"), (entries, Nothing, moreEntriesToLoad)) --- -- No expectation, either because this is the most recent entry or --- -- because we're recovering from a discontinuity --- Nothing -> ((Just time, toRootCausalHash, reason), (rest, Just fromRootCausalHash, moreEntriesToLoad)) +import Unison.Sqlite qualified as Sqlite showProjectBranchReflog :: Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) -> Cli () showProjectBranchReflog mayProjectAndBranch = do - ProjectAndBranch project branch <- case mayProjectAndBranch of + ProjectAndBranch _project branch <- case mayProjectAndBranch of Nothing -> Cli.getCurrentProjectAndBranch Just pab -> ProjectUtils.resolveProjectBranch (second Just pab) + reflogHelper (\n -> Codebase.getProjectBranchReflog n (branch ^. #branchId)) + +showProjectReflog :: Maybe ProjectName -> Cli () +showProjectReflog mayProject = do + ProjectAndBranch project _ <- ProjectUtils.resolveProjectBranch (ProjectAndBranch mayProject Nothing) + reflogHelper (\n -> Codebase.getProjectReflog n (project ^. #projectId)) + +showGlobalReflog :: Cli () +showGlobalReflog = do + reflogHelper Codebase.getGlobalReflog + +reflogHelper :: (Int -> Sqlite.Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash]) -> Cli () +reflogHelper getEntries = do let numEntriesToShow = 500 entries <- Cli.runTransaction $ do schLength <- Codebase.branchHashLength - entries <- Codebase.getProjectBranchReflog numEntriesToShow branch.branchId + entries <- getEntries numEntriesToShow entries - & (fmap . fmap) SCH.fromHash schLength + & (fmap . fmap) (\ch -> (ch, SCH.fromHash schLength ch)) & pure let moreEntriesToLoad = if length entries == numEntriesToShow then Output.MoreEntriesThanShown else Output.AllEntriesShown - Cli.respondNumbered $ ShowProjectBranchReflog moreEntriesToLoad shortEntries + now <- liftIO getCurrentTime + Cli.respondNumbered $ Output.ShowProjectBranchReflog now moreEntriesToLoad entries diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 132f27b6f4..21519482a6 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -124,6 +124,7 @@ module Unison.CommandLine.InputPatterns deprecatedViewRootReflog, branchReflog, projectReflog, + globalReflog, -- * Misc formatStructuredArgument, @@ -2302,6 +2303,22 @@ projectReflog = _ -> Left (I.help projectReflog) ) +globalReflog :: InputPattern +globalReflog = + InputPattern + "reflog.global" + [] + I.Visible + [] + ( P.lines + [ "`reflog.global` lists all recent changes across all projects and branches." + ] + ) + ( \case + [] -> pure $ Input.ShowGlobalReflogI + _ -> Left (I.help globalReflog) + ) + edit :: InputPattern edit = InputPattern From 8a405e02d2b2f3c001554cf072a3f5493ccd6853 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 3 Jul 2024 16:10:35 -0700 Subject: [PATCH 378/631] Update reflog command WIP --- .../U/Codebase/Sqlite/Queries.hs | 4 +- .../013-add-project-branch-reflog-table.sql | 6 ++ .../src/Unison/Codebase/ShortCausalHash.hs | 3 + .../src/Unison/Codebase/Editor/HandleInput.hs | 6 +- .../src/Unison/CommandLine/InputPatterns.hs | 3 +- unison-src/transcripts/reflog.md | 24 +++-- unison-src/transcripts/reflog.output.md | 87 +++++++++++++++---- 7 files changed, 101 insertions(+), 32 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index f77bfbbf41..927021ecec 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3498,8 +3498,8 @@ getProjectReflog numEntries projectId = [sql| SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason FROM project_branch_reflog - ORDER BY time DESC WHERE project_id = :projectId + ORDER BY time DESC LIMIT :numEntries |] @@ -3510,8 +3510,8 @@ getProjectBranchReflog numEntries projectBranchId = [sql| SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason FROM project_branch_reflog - ORDER BY time DESC WHERE project_branch_id = :projectBranchId + ORDER BY time DESC LIMIT :numEntries |] diff --git a/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql b/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql index 589ed1812f..5142051033 100644 --- a/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql +++ b/codebase2/codebase-sqlite/sql/013-add-project-branch-reflog-table.sql @@ -1,3 +1,4 @@ +-- A reflog which is tied to the project/branch CREATE TABLE project_branch_reflog ( project_id INTEGER NOT NULL, project_branch_id INTEGER NOT NULL, @@ -24,3 +25,8 @@ CREATE INDEX project_reflog_by_time ON project_branch_reflog ( project_id, time DESC ); +CREATE INDEX global_reflog_by_time ON project_branch_reflog ( + time DESC +); + + diff --git a/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs b/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs index c23babd330..2872ec53d2 100644 --- a/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs +++ b/parser-typechecker/src/Unison/Codebase/ShortCausalHash.hs @@ -48,3 +48,6 @@ fromText _ = Nothing instance Show ShortCausalHash where show (ShortCausalHash h) = '#' : Text.unpack h + +instance From ShortCausalHash Text where + from = toText diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 4c3731aba5..9af1e4860a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -1071,11 +1071,11 @@ inputDescription input = VersionI -> wat where hp' :: Either SCH.ShortCausalHash Path' -> Cli Text - hp' = either (pure . Text.pack . show) p' + hp' = either (pure . into @Text) p' p :: Path -> Cli Text - p = fmap tShow . Cli.resolvePath + p = fmap (into @Text) . Cli.resolvePath p' :: Path' -> Cli Text - p' = fmap tShow . Cli.resolvePath' + p' = fmap (into @Text) . Cli.resolvePath' brp :: BranchRelativePath -> Cli Text brp = fmap (into @Text) . ProjectUtils.resolveBranchRelativePath ops :: Maybe Path.Split -> Cli Text diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 21519482a6..fc87143306 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -3481,7 +3481,8 @@ validInputs = viewGlobal, deprecatedViewRootReflog, branchReflog, - projectReflog + projectReflog, + globalReflog ] -- | A map of all command patterns by pattern name or alias. diff --git a/unison-src/transcripts/reflog.md b/unison-src/transcripts/reflog.md index 0c1a33fba1..0bbb4f57df 100644 --- a/unison-src/transcripts/reflog.md +++ b/unison-src/transcripts/reflog.md @@ -2,8 +2,7 @@ scratch/main> builtins.merge lib.builtins ``` -First we make two changes to the codebase, so that there's more than one line -for the `reflog` command to display: +First we make some changes to the codebase so there's data in the reflog. ```unison x = 1 @@ -16,16 +15,27 @@ y = 2 ``` ```ucm scratch/main> add -scratch/main> view y +scratch/main> branch /other +scratch/other> alias.term y z +newproject/main> builtins.merge lib.builtins +newproject/main> alias.type lib.builtins.Nat MyNat ``` + +Should see reflog entries from the current branch + ```ucm scratch/main> reflog ``` -If we `reset-root` to its previous value, `y` disappears. +Should see reflog entries from the current project + ```ucm -scratch/main> reset-root 2 +scratch/main> project.reflog ``` -```ucm:error -scratch/main> view y + + +Should see reflog entries from all projects + +```ucm +scratch/main> reflog.global ``` diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index 54ea828006..22e359c0f6 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -1,5 +1,4 @@ -First we make two changes to the codebase, so that there's more than one line -for the `reflog` command to display: +First we make some changes to the codebase so there's data in the reflog. ```unison x = 1 @@ -50,37 +49,87 @@ scratch/main> add y : Nat -scratch/main> view y +scratch/main> branch /other - y : Nat - y = 2 + Done. I've created the other branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /other`. + +scratch/other> alias.term y z + + Done. + +newproject/main> builtins.merge lib.builtins + + Done. + +newproject/main> alias.type lib.builtins.Nat MyNat + + Done. ``` +Should see reflog entries from the current branch + ```ucm scratch/main> reflog - ⚠️ + Below is a record of recent changes, you can use + `reset #abcdef` to reset the current branch to a previous + state. - The reflog is empty + Tip: Use `diff.namespace 1 7` to compare between points in + history. + + Branch When Hash Description + 1. scratch/main now #6mdl5gruh5 add + 2. scratch/main now #3rqf1hbev7 add + 3. scratch/main now #ms9lggs2rg builtins.merge scratch/main:.lib.builtins + 4. scratch/main now #sg60bvjo91 Project Created ``` -If we `reset-root` to its previous value, `y` disappears. -```ucm -scratch/main> reset-root 2 +Should see reflog entries from the current project -``` ```ucm -scratch/main> view y - - y : Nat - y = 2 +scratch/main> project.reflog -``` + Below is a record of recent changes, you can use + `reset #abcdef` to reset the current branch to a previous + state. + + Tip: Use `diff.namespace 1 7` to compare between points in + history. + + Branch When Hash Description + 1. scratch/other now #148flqs4b1 alias.term scratch/other:..y scratch/other:.z + 2. scratch/other now #6mdl5gruh5 Branch created from scratch/main + 3. scratch/main now #6mdl5gruh5 add + 4. scratch/main now #3rqf1hbev7 add + 5. scratch/main now #ms9lggs2rg builtins.merge scratch/main:.lib.builtins + 6. scratch/main now #sg60bvjo91 Project Created ``` +Should see reflog entries from all projects +```ucm +scratch/main> reflog.global + Below is a record of recent changes, you can use + `reset #abcdef` to reset the current branch to a previous + state. + + Tip: Use `diff.namespace 1 7` to compare between points in + history. + + Branch When Hash Description + 1. newproject/main now #2rjhs2vq43 alias.term newproject/main:.lib.builtins.Nat newproject/main... + 2. newproject/main now #ms9lggs2rg builtins.merge newproject/main:.lib.builtins + 3. newproject/main now #sg60bvjo91 Branch Created + 4. scratch/other now #148flqs4b1 alias.term scratch/other:..y scratch/other:.z + 5. scratch/other now #6mdl5gruh5 Branch created from scratch/main + 6. scratch/main now #6mdl5gruh5 add + 7. scratch/main now #3rqf1hbev7 add + 8. scratch/main now #ms9lggs2rg builtins.merge scratch/main:.lib.builtins + 9. scratch/main now #sg60bvjo91 Project Created -🛑 - -The transcript was expecting an error in the stanza above, but did not encounter one. +``` From 38a73da600d797aec4dd5542f3bd67d29a8cf668 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 5 Jul 2024 11:33:11 -0400 Subject: [PATCH 379/631] switch `Left` to `Right` on help outputs; add draft transcripts --- .../src/Unison/CommandLine/InputPatterns.hs | 12 +- .../transcripts-manual/docs.to-html.output.md | 2 +- unison-src/transcripts/help.md | 14 + unison-src/transcripts/help.output.md | 963 ++++++++++++++++++ unison-src/transcripts/input-parse-errors.md | 173 ++++ .../transcripts/input-parse-errors.output.md | 202 ++++ unison-src/transcripts/merge.output.md | 30 +- unison-src/transcripts/pull-errors.output.md | 16 +- 8 files changed, 1384 insertions(+), 28 deletions(-) create mode 100644 unison-src/transcripts/help.md create mode 100644 unison-src/transcripts/help.output.md create mode 100644 unison-src/transcripts/input-parse-errors.md create mode 100644 unison-src/transcripts/input-parse-errors.output.md diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 0e86f15c8c..da684d80c9 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2312,12 +2312,12 @@ helpTopics = [("topic", Optional, topicNameArg)] ("`help-topics` lists all topics and `help-topics ` shows an explanation of that topic.") ( \case - [] -> Left topics + [] -> Right $ Input.CreateMessage topics [topic] -> do topic <- unsupportedStructuredArgument "help-topics" "a help topic" topic case Map.lookup topic helpTopicsMap of Nothing -> Left . warn $ "I don't know of that topic. Try `help-topics`." - Just t -> Left t + Just t -> Right $ Input.CreateMessage t _ -> Left $ warn "Use `help-topics ` or `help-topics`." ) where @@ -2497,7 +2497,7 @@ help = "`help` shows general help and `help ` shows help for one command." $ \case [] -> - Left $ + Right . Input.CreateMessage $ intercalateMap "\n\n" showPatternHelp @@ -2505,13 +2505,13 @@ help = [cmd] -> do cmd <- unsupportedStructuredArgument "help" "a command" cmd case (Map.lookup cmd commandsByName, isHelp cmd) of - (Nothing, Just msg) -> Left msg + (Nothing, Just msg) -> Right $ Input.CreateMessage msg (Nothing, Nothing) -> Left . warn $ "I don't know of that command. Try `help`." - (Just pat, Nothing) -> Left $ showPatternHelp pat + (Just pat, Nothing) -> Right . Input.CreateMessage $ showPatternHelp pat -- If we have a command and a help topic with the same name (like "projects"), then append a tip to the -- command's help that suggests running `help-topic command` (Just pat, Just _) -> - Left $ + Right . Input.CreateMessage $ showPatternHelp pat <> P.newline <> P.newline diff --git a/unison-src/transcripts-manual/docs.to-html.output.md b/unison-src/transcripts-manual/docs.to-html.output.md index bdfc5fa4a6..fbd51a4eaf 100644 --- a/unison-src/transcripts-manual/docs.to-html.output.md +++ b/unison-src/transcripts-manual/docs.to-html.output.md @@ -6,7 +6,7 @@ I'll now fetch the latest version of the base Unison library... - Downloaded 14053 entities. + Downloaded 12886 entities. 🎨 Type `ui` to explore this project's code in your browser. 🔭 Discover libraries at https://share.unison-lang.org diff --git a/unison-src/transcripts/help.md b/unison-src/transcripts/help.md new file mode 100644 index 0000000000..7a2ffa2906 --- /dev/null +++ b/unison-src/transcripts/help.md @@ -0,0 +1,14 @@ +# Shows `help` output + +```ucm:error +scratch/main> help +scratch/main> help-topics +scratch/main> help-topic filestatus +scratch/main> help-topic messages.disallowedAbsolute +scratch/main> help-topic namespaces +scratch/main> help-topic projects +scratch/main> help-topic remotes +scratch/main> help-topic testcache +``` + +We should add a command to show help for hidden commands also. diff --git a/unison-src/transcripts/help.output.md b/unison-src/transcripts/help.output.md new file mode 100644 index 0000000000..2044217df0 --- /dev/null +++ b/unison-src/transcripts/help.output.md @@ -0,0 +1,963 @@ +# Shows `help` output + +```ucm +scratch/main> help + + add + `add` adds to the codebase all the definitions from the most recently typechecked file. + + add.preview + `add.preview` previews additions to the codebase from the most recently typechecked file. This command only displays cached typechecking results. Use `load` to reparse & typecheck the file if the context has changed. + + add.run + `add.run name` adds to the codebase the result of the most recent `run` command as `name`. + + alias.many (or copy) + `alias.many [relative2...] ` creates + aliases `relative1`, `relative2`, ... in the namespace + `namespace`. + `alias.many foo.foo bar.bar .quux` creates aliases + `.quux.foo.foo` and `.quux.bar.bar`. + + alias.term + `alias.term foo bar` introduces `bar` with the same definition as `foo`. + + alias.type + `alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`. + + api + `api` provides details about the API. + + auth.login + Obtain an authentication session with Unison Share. + `auth.login`authenticates ucm with Unison Share. + + back (or popd) + `back` undoes the last `switch` command. + + branch (or branch.create, create.branch) + `branch foo` forks the current project branch to a new + branch `foo` + `branch /bar foo` forks the branch `bar` of the current + project to a new branch `foo` + `branch .bar foo` forks the path `.bar` of the current + project to a new branch `foo` + + branch.empty (or branch.create-empty, create.empty-branch) + Create a new empty branch. + + branch.rename (or rename.branch) + `branch.rename foo` renames the current branch to `foo` + + branches (or list.branch, ls.branch, branch.list) + `branches` lists all branches in the current project + `branches foo` lists all branches in the project `foo` + + clear + `clear` Clears the screen. + + clone + `clone @unison/json/topic json/my-topic` creates + `json/my-topic` from + the remote branch + `@unison/json/topic` + `clone @unison/base base/` creates `base/main` + from the remote + branch + `@unison/base/main` + `clone @unison/base /main2` creates the branch + `main2` in the + current project from + the remote branch + `@unison/base/main` + `clone /main /main2` creates the branch + `main2` in the + current project from + the remote branch + `main` of the + current project's + associated remote + (see + `help-topics remotes`) + `clone /main my-fork/` creates + `my-fork/main` from + the branch `main` of + the current + project's associated + remote (see + `help-topics remotes`) + + compile (or compile.output) + `compile main file` Outputs a stand alone file that can be + directly loaded and executed by unison. + Said execution will have the effect of + running `!main`. + + create.author + `create.author alicecoder "Alice McGee"` creates `alicecoder` + values in `metadata.authors` and `metadata.copyrightHolders.` + + debug.clear-cache + Clear the watch expression cache + + debug.doc-to-markdown + `debug.doc-to-markdown term.doc` Render a doc to markdown. + + debug.doctor + Analyze your codebase for errors and inconsistencies. + + debug.dump-namespace + Dump the namespace to a text file + + debug.dump-namespace-simple + Dump the namespace to a text file + + debug.file + View details about the most recent successfully typechecked file. + + debug.numberedArgs + Dump the contents of the numbered args state. + + delete + `delete foo` removes the term or type name `foo` from the namespace. + `delete foo bar` removes the term or type name `foo` and `bar` from the namespace. + + delete.branch (or branch.delete) + `delete.branch foo/bar` deletes the branch `bar` in the + project `foo` + `delete.branch /bar` deletes the branch `bar` in the + current project + + delete.namespace + `delete.namespace ` deletes the namespace `foo` + + delete.namespace.force + `delete.namespace.force ` deletes the namespace `foo`,deletion will proceed even if other code depends on definitions in foo. + + delete.project (or project.delete) + `delete.project foo` deletes the local project `foo` + + delete.term + `delete.term foo` removes the term name `foo` from the namespace. + `delete.term foo bar` removes the term name `foo` and `bar` from the namespace. + + delete.term.verbose + `delete.term.verbose foo` removes the term name `foo` from the namespace. + `delete.term.verbose foo bar` removes the term name `foo` and `bar` from the namespace. + + delete.type + `delete.type foo` removes the type name `foo` from the namespace. + `delete.type foo bar` removes the type name `foo` and `bar` from the namespace. + + delete.type.verbose + `delete.type.verbose foo` removes the type name `foo` from the namespace. + `delete.type.verbose foo bar` removes the type name `foo` and `bar` from the namespace. + + delete.verbose + `delete.verbose foo` removes the term or type name `foo` from the namespace. + `delete.verbose foo bar` removes the term or type name `foo` and `bar` from the namespace. + + dependencies + List the dependencies of the specified definition. + + dependents + List the named dependents of the specified definition. + + deprecated.cd (or deprecated.namespace) + Moves your perspective to a different namespace. Deprecated for now because too many important things depend on your perspective selection. + + `deprecated.cd foo.bar` descends into foo.bar from the + current namespace. + `deprecated.cd .cat.dog` sets the current namespace to the + absolute namespace .cat.dog. + `deprecated.cd ..` moves to the parent of the current + namespace. E.g. moves from + '.cat.dog' to '.cat' + `deprecated.cd` invokes a search to select which + namespace to move to, which requires + that `fzf` can be found within your + PATH. + + diff.namespace + `diff.namespace before after` shows how the namespace `after` + differs from the namespace + `before` + `diff.namespace before` shows how the current namespace + differs from the namespace + `before` + + display + `display foo` prints a rendered version of the term `foo`. + `display` without arguments invokes a search to select a definition to display, which requires that `fzf` can be found within your PATH. + + display.to + `display.to foo` prints a rendered version of the + term `foo` to the given file. + + docs + `docs foo` shows documentation for the definition `foo`. + `docs` without arguments invokes a search to select which definition to view documentation for, which requires that `fzf` can be found within your PATH. + + docs.to-html + `docs.to-html .path.to.ns doc-dir` Render + all docs + contained + within + the + namespace + `.path.to.ns`, + no matter + how deep, + to html + files in + `doc-dir` + in the + directory + UCM was + run from. + `docs.to-html project0/branch0:a.path /tmp/doc-dir` Renders + all docs + anywhere + in the + namespace + `a.path` + from + `branch0` + of + `project0` + to html + in + `/tmp/doc-dir`. + + edit + `edit foo` prepends the definition of `foo` to the top of the most recently saved file. + `edit` without arguments invokes a search to select a definition for editing, which requires that `fzf` can be found within your PATH. + + edit.namespace + `edit.namespace` will load all terms and types contained within the current namespace into your scratch file. This includes definitions in namespaces, but excludes libraries. + `edit.namespace ns1 ns2 ...` loads the terms and types contained within the provided namespaces. + + find + `find` lists all definitions in the + current namespace. + `find foo` lists all definitions with a + name similar to 'foo' in the + current namespace (excluding + those under 'lib'). + `find foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the current + namespace (excluding those + under 'lib'). + `find-in namespace` lists all definitions in the + specified subnamespace. + `find-in namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace. + find.all foo lists all definitions with a + name similar to 'foo' in the + current namespace (including + one level of 'lib'). + `find-in.all namespace` lists all definitions in the + specified subnamespace + (including one level of its + 'lib'). + `find-in.all namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace (including one + level of its 'lib'). + find.global foo lists all definitions with a + name similar to 'foo' in any + namespace + + find-in + `find` lists all definitions in the + current namespace. + `find foo` lists all definitions with a + name similar to 'foo' in the + current namespace (excluding + those under 'lib'). + `find foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the current + namespace (excluding those + under 'lib'). + `find-in namespace` lists all definitions in the + specified subnamespace. + `find-in namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace. + find.all foo lists all definitions with a + name similar to 'foo' in the + current namespace (including + one level of 'lib'). + `find-in.all namespace` lists all definitions in the + specified subnamespace + (including one level of its + 'lib'). + `find-in.all namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace (including one + level of its 'lib'). + find.global foo lists all definitions with a + name similar to 'foo' in any + namespace + + find-in.all + `find` lists all definitions in the + current namespace. + `find foo` lists all definitions with a + name similar to 'foo' in the + current namespace (excluding + those under 'lib'). + `find foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the current + namespace (excluding those + under 'lib'). + `find-in namespace` lists all definitions in the + specified subnamespace. + `find-in namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace. + find.all foo lists all definitions with a + name similar to 'foo' in the + current namespace (including + one level of 'lib'). + `find-in.all namespace` lists all definitions in the + specified subnamespace + (including one level of its + 'lib'). + `find-in.all namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace (including one + level of its 'lib'). + find.global foo lists all definitions with a + name similar to 'foo' in any + namespace + + find.all + `find` lists all definitions in the + current namespace. + `find foo` lists all definitions with a + name similar to 'foo' in the + current namespace (excluding + those under 'lib'). + `find foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the current + namespace (excluding those + under 'lib'). + `find-in namespace` lists all definitions in the + specified subnamespace. + `find-in namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace. + find.all foo lists all definitions with a + name similar to 'foo' in the + current namespace (including + one level of 'lib'). + `find-in.all namespace` lists all definitions in the + specified subnamespace + (including one level of its + 'lib'). + `find-in.all namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace (including one + level of its 'lib'). + find.global foo lists all definitions with a + name similar to 'foo' in any + namespace + + find.all.verbose + `find.all.verbose` searches for definitions like `find.all`, but includes hashes and aliases in the results. + + find.global + `find` lists all definitions in the + current namespace. + `find foo` lists all definitions with a + name similar to 'foo' in the + current namespace (excluding + those under 'lib'). + `find foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the current + namespace (excluding those + under 'lib'). + `find-in namespace` lists all definitions in the + specified subnamespace. + `find-in namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace. + find.all foo lists all definitions with a + name similar to 'foo' in the + current namespace (including + one level of 'lib'). + `find-in.all namespace` lists all definitions in the + specified subnamespace + (including one level of its + 'lib'). + `find-in.all namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace (including one + level of its 'lib'). + find.global foo lists all definitions with a + name similar to 'foo' in any + namespace + + find.verbose + `find.verbose` searches for definitions like `find`, but includes hashes and aliases in the results. + + fork (or copy.namespace) + `fork src dest` creates + the + namespace + `dest` as + a copy of + `src`. + `fork project0/branch0:a.path project1/branch1:foo` creates + the + namespace + `foo` in + `branch1` + of + `project1` + as a copy + of + `a.path` + in + `project0/branch0`. + `fork srcproject/srcbranch dest` creates + the + namespace + `dest` as + a copy of + the + branch + `srcbranch` + of + `srcproject`. + + help (or ?) + `help` shows general help and `help ` shows help for one command. + + help-topics (or help-topic) + `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. + + history + `history` Shows the history of the current + path. + `history .foo` Shows history of the path .foo. + `history #9dndk3kbsk13nbpeu` Shows the history of the + namespace with the given hash. + The full hash must be provided. + + io.test (or test.io) + `io.test mytest` Runs `!mytest`, where `mytest` is a delayed + test that can use the `IO` and `Exception` + abilities. + + io.test.all (or test.io.all) + `io.test.all` runs unit tests for the current branch that use + IO + + lib.install (or install.lib) + The `lib.install` command installs a dependency into the `lib` + namespace. + + `lib.install @unison/base/releases/latest` installs the + latest release of + `@unison/base` + `lib.install @unison/base/releases/3.0.0` installs version + 3.0.0 of + `@unison/base` + `lib.install @unison/base/topic` installs the + `topic` branch of + `@unison/base` + + list (or ls, dir) + `list` lists definitions and namespaces at the current + level of the current namespace. + `list foo` lists the 'foo' namespace. + `list .foo` lists the '.foo' namespace. + + load + `load` parses, typechecks, and evaluates the + most recent scratch file. + `load ` parses, typechecks, and evaluates the + given scratch file. + + merge + `merge /branch` merges `branch` into the current branch + + merge.commit (or commit.merge) + `merge.commit` merges a temporary branch created by the + `merge` command back into its parent branch, and removes the + temporary branch. + + For example, if you've done `merge topic` from main, then + `merge.commit` is equivalent to doing + + * switch /main + * merge /merge-topic-into-main + * delete.branch /merge-topic-into-main + + move (or rename) + `move foo bar` renames the term, type, and namespace foo to bar. + + move.namespace (or rename.namespace) + `move.namespace foo bar` renames the path `foo` to `bar`. + + move.term (or rename.term) + `move.term foo bar` renames `foo` to `bar`. + + move.type (or rename.type) + `move.type foo bar` renames `foo` to `bar`. + + names + `names foo` shows the hash and all known names for `foo`. + + names.global + `names.global foo` shows the hash and all known names for + `foo`. + + namespace.dependencies + List the external dependencies of the specified namespace. + + project.create (or create.project) + `project.create` creates a project with a random name + `project.create foo` creates a project named `foo` + + project.rename (or rename.project) + `project.rename foo` renames the current project to `foo` + + projects (or list.project, ls.project, project.list) + List projects. + + pull + The `pull` command merges a remote namespace into a local + branch + + `pull @unison/base/main` merges the branch + `main` of the Unison + Share hosted project + `@unison/base` into + the current branch + `pull @unison/base/main my-base/topic` merges the branch + `main` of the Unison + Share hosted project + `@unison/base` into + the branch `topic` of + the local `my-base` + project + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + Project Release `@unison/base/releases/1.0.0` + + pull.without-history + The `pull.without-history` command merges a remote namespace + into a local branch without including the remote's history. + This usually results in smaller codebase sizes. + + `pull.without-history @unison/base/main` merges + the + branch + `main` + of the + Unison + Share + hosted + project + `@unison/base` + into + the + current + branch + `pull.without-history @unison/base/main my-base/topic` merges + the + branch + `main` + of the + Unison + Share + hosted + project + `@unison/base` + into + the + branch + `topic` + of the + local + `my-base` + project + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + Project Release `@unison/base/releases/1.0.0` + + push + The `push` command merges a local project or namespace into a + remote project or namespace. + + `push ` publishes the contents of a local + namespace or branch into a remote + namespace or branch. + `push ` publishes the current namespace or + branch into a remote namespace or + branch + `push` publishes the current namespace or + branch. Remote mappings for + namespaces are configured in your + `.unisonConfig` at the key + `RemoteMappings.` where + `` is the current + namespace. Remote mappings for + branches default to the branch that + you cloned from or pushed to + initially. Otherwise, it is pushed to + @/ + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + + push.create + The `push.create` command pushes a local namespace to an empty + remote namespace. + + `push.create remote local` pushes the contents of the local + namespace `local` into the empty + remote namespace `remote`. + `push.create remote` publishes the current namespace + into the empty remote namespace + `remote` + `push.create` publishes the current namespace + into the remote namespace + configured in your `.unisonConfig` + at the key + `RemoteMappings.` where + `` is the current + namespace, then publishes the + current namespace to that + location. + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + + quit (or exit, :q) + Exits the Unison command line interface. + + reflog + `reflog` lists the changes that have affected the root namespace + + release.draft (or draft.release) + Draft a release. + + reset + `reset #pvfd222s8n` reset the current namespace to the + causal `#pvfd222s8n` + `reset foo` reset the current namespace to + that of the `foo` namespace. + `reset foo bar` reset the namespace `bar` to that + of the `foo` namespace. + `reset #pvfd222s8n /topic` reset the branch `topic` of the + current project to the causal + `#pvfd222s8n`. + + rewrite (or sfind.replace) + `rewrite rule1` rewrites definitions in the latest scratch file. + + The argument `rule1` must refer to a `@rewrite` block or a + function that immediately returns a `@rewrite` block. It can + be in the codebase or scratch file. An example: + + rule1 x = @rewrite term x + 1 ==> Nat.increment x + + Here, `x` will stand in for any expression wherever this + rewrite is applied, so this rule will match `(42+10+11) + 1` + and replace it with `Nat.increment (42+10+11)`. + + See https://unison-lang.org/learn/structured-find to learn more. + + Also see the related command `rewrite.find` + + rewrite.find (or sfind) + `rewrite.find rule1` finds definitions that match any of the + left side(s) of `rule` in the current namespace. + + The argument `rule1` must refer to a `@rewrite` block or a + function that immediately returns a `@rewrite` block. It can + be in the codebase or scratch file. An example: + + -- right of ==> is ignored by this command + rule1 x = @rewrite term x + 1 ==> () + + Here, `x` will stand in for any expression, so this rule will + match `(42+10+11) + 1`. + + See https://unison-lang.org/learn/structured-find to learn more. + + Also see the related command `rewrite` + + run + `run mymain args...` Runs `!mymain`, where `mymain` is + searched for in the most recent + typechecked file, or in the codebase. + Any provided arguments will be passed as + program arguments as though they were + provided at the command line when + running mymain as an executable. + + run.native + `run.native main args` Executes !main using native + compilation via scheme. + + switch + `switch` opens an interactive selector to pick a + project and branch + `switch foo/bar` switches to the branch `bar` in the project + `foo` + `switch foo/` switches to the last branch you visited in + the project `foo` + `switch /bar` switches to the branch `bar` in the current + project + + test + `test` runs unit tests for the current branch + `test foo` runs unit tests for the current branch defined in + namespace `foo` + + test.all + `test.all` runs unit tests for the current branch (including the `lib` namespace). + + todo + `todo` lists the current namespace's outstanding issues, + including conflicted names, dependencies with missing names, + and merge precondition violations. + + ui + `ui` opens the Local UI in the default browser. + + undo + `undo` reverts the most recent change to the codebase. + + update + Adds everything in the most recently typechecked file to the + namespace, replacing existing definitions having the same + name, and attempts to update all the existing dependents + accordingly. If the process can't be completed automatically, + the dependents will be added back to the scratch file for your + review. + + update.old + `update.old` works like `add`, except that if a definition in + the file has the same name as an existing definition, the name + gets updated to point to the new definition. If the old + definition has any dependents, `update` will add those + dependents to a refactoring session, specified by an optional + patch.`update.old` adds all definitions in + the .u file, noting replacements + in the default patch for the + current namespace. + `update.old ` adds all definitions in the .u + file, noting replacements in the + specified patch. + `update.old foo bar` adds `foo`, `bar`, and their + dependents from the .u file, + noting any replacements into the + specified patch. + + update.old.nopatch + `update.old.nopatch` works like `update.old`, except it + doesn't add a patch entry for any updates. Use this when you + want to make changes to definitions without pushing those + changes to dependents beyond your codebase. An example is when + updating docs, or when updating a term you just added.`update.old.nopatch` updates + all definitions in the .u file. + `update.old.nopatch foo bar` updates `foo`, `bar`, and their + dependents from the .u file. + + update.old.preview + `update.old.preview` previews updates to the codebase from the most recently typechecked file. This command only displays cached typechecking results. Use `load` to reparse & typecheck the file if the context has changed. + + upgrade + `upgrade old new` upgrades library dependency `lib.old` to + `lib.new`, and, if successful, deletes `lib.old`. + + upgrade.commit (or commit.upgrade) + `upgrade.commit` merges a temporary branch created by the + `upgrade` command back into its parent branch, and removes the + temporary branch. + + For example, if you've done `upgrade foo bar` from main, then + `upgrade.commit` is equivalent to doing + + * switch /main + * merge /upgrade-foo-to-bar + * delete.branch /upgrade-foo-to-bar + + version + Print the version of unison you're running + + view + `view foo` shows definitions named `foo` within your current + namespace. + `view` without arguments invokes a search to select + definitions to view, which requires that `fzf` can be found + within your PATH. + + Supports glob syntax, where ? acts a wildcard, so + `view List.?` will show `List.map`, `List.filter`, etc, but + not `List.map.doc` (since ? only matches 1 name segment). + + view.global + `view.global foo` prints definitions of `foo` within your codebase. + `view.global` without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH. + +scratch/main> help-topics + + 🌻 + + Here's a list of topics I can tell you more about: + + filestatus + messages.disallowedAbsolute + namespaces + projects + remotes + testcache + + Example: use `help filestatus` to learn more about that topic. + +scratch/main> help-topic filestatus + + Sorry, I wasn’t sure how to process your request. 📓 + Here's a list of possible status messages you might see for + definitions in a .u file. + needs update A definition with the same name as an + existing definition. Doing `update` + instead of `add` will turn this failure + into a successful update. + + term/ctor collision A definition with the same name as an + existing constructor for some data type. + Rename your definition or the data type + before trying again to `add` or `update`. + + ctor/term collision A type defined in the file has a + constructor that's named the same as an + existing term. Rename that term or your + constructor before trying again to `add` + or `update`. + blocked This definition was blocked because it + dependended on a definition with a failed + status. + extra dependency This definition was added because it was + a dependency of a definition explicitly + selected. + + You can run `help help-topic` for more information on using `help-topic` + `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. + +scratch/main> help-topic messages.disallowedAbsolute + + Sorry, I wasn’t sure how to process your request. 🤖 + Although I can understand absolute (ex: .foo.bar) or relative + (ex: util.math.sqrt) references to existing definitions + (help namespaces to learn more), I can't yet handle giving new + definitions with absolute names in a .u file. + As a workaround, you can give definitions with a relative name + temporarily (like `exports.blah.foo`) and then use `move.*`. + + You can run `help help-topic` for more information on using `help-topic` + `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. + +scratch/main> help-topic namespaces + + Sorry, I wasn’t sure how to process your request. 🧐 + There are two kinds of namespaces, absolute, such as (.foo.bar + or .base.math.+) and relative, such as (math.sqrt or + util.List.++). + Relative names are converted to absolute names by prepending + the current namespace. For example, if your Unison prompt + reads: .foo.bar> and your .u file looks like: x = 41 + then doing an add will create the definition with the absolute + name .foo.bar.x = 41 + and you can refer to x by its absolute name .foo.bar.x + elsewhere in your code. For instance: + answerToLifeTheUniverseAndEverything = .foo.bar.x + 1 + + You can run `help help-topic` for more information on using `help-topic` + `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. + +scratch/main> help-topic projects + + Sorry, I wasn’t sure how to process your request. + A project is a versioned collection of code that can be + edited, published, and depended on other projects. Unison + projects are analogous to Git repositories. + project.create create a new project + projects list all your projects + branch create a new workstream + branches list all your branches + merge merge one branch into another + switch switch to a project or branch + push upload your changes to Unison Share + pull download code(/changes/updates) from Unison Share + clone download a Unison Share project or branch for contribution + Tip: Use `help project.create` to learn more. + For full documentation, see + https://unison-lang.org/learn/projects + + You can run `help help-topic` for more information on using `help-topic` + `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. + +scratch/main> help-topic remotes + + Sorry, I wasn’t sure how to process your request. 🤖 + Local projects may be associated with at most one remote + project on Unison Share. When this relationship is + established, it becomes the default argument for a number of + share commands. For example, running `push` or `pull` in a + project with no arguments will push to or pull from the + associated remote, if it exists. + This association is created automatically on when a project is + created by `clone`. If the project was created locally then + the relationship will be established on the first `push`. + + You can run `help help-topic` for more information on using `help-topic` + `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. + +scratch/main> help-topic testcache + + Sorry, I wasn’t sure how to process your request. 🎈 + Unison caches the results of test> watch expressions. Since + these expressions are pure and always yield the same result + when evaluated, there's no need to run them more than once! + A test is rerun only if it has changed, or if one of the + definitions it depends on has changed. + + You can run `help help-topic` for more information on using `help-topic` + `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. + +``` +We should add a command to show help for hidden commands also. diff --git a/unison-src/transcripts/input-parse-errors.md b/unison-src/transcripts/input-parse-errors.md new file mode 100644 index 0000000000..fe67a06cd9 --- /dev/null +++ b/unison-src/transcripts/input-parse-errors.md @@ -0,0 +1,173 @@ +# demonstrating our new input parsing errors + +```ucm:hide +scratch/main> builtins.merge lib.builtin +``` + +```unison:hide +x = 55 +``` +```ucm:hide +scratch/main> add +``` + +`handleNameArg` parse error in `add` +```ucm:error +scratch/main> add . +scratch/main> ls +scratch/main> add 1 +scratch/main> ls +scratch/main> add 2 +``` + +todo: +```haskell + SA.Name name -> pure name + SA.NameWithBranchPrefix (Left _) name -> pure name + SA.NameWithBranchPrefix (Right prefix) name -> pure $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name + SA.HashQualified hqname -> maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + pure . Path.prefixNameIfRel (Path.AbsolutePath' prefix) $ HQ'.toName hqname + SA.ShallowListEntry prefix entry -> + pure . HQ'.toName . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry + SA.SearchResult mpath result -> + maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result + otherNumArg -> Left . I.Formatted $ wrongStructuredArgument "a name" otherNumArg +``` + +aliasMany: skipped -- similar to `add` + +```ucm:error +scratch/main> update arg +``` + +aliasTerm +``` +scratch/main> alias.term ##Nat.+ Nat.+ +``` + +aliasTermForce, +aliasType, + + +todo: +``` + +aliasMany, +api, +authLogin, +back, +branchEmptyInputPattern, +branchInputPattern, +branchRenameInputPattern, +branchesInputPattern, +cd, +clear, +clone, +compileScheme, +createAuthor, +debugClearWatchCache, +debugDoctor, +debugDumpNamespace, +debugDumpNamespaceSimple, +debugTerm, +debugTermVerbose, +debugType, +debugLSPFoldRanges, +debugFileHashes, +debugNameDiff, +debugNumberedArgs, +debugTabCompletion, +debugFuzzyOptions, +debugFormat, +delete, +deleteBranch, +deleteProject, +deleteNamespace, +deleteNamespaceForce, +deleteTerm, +deleteTermVerbose, +deleteType, +deleteTypeVerbose, +deleteVerbose, +dependencies, +dependents, +diffNamespace, +display, +displayTo, +docToMarkdown, +docs, +docsToHtml, +edit, +editNamespace, +execute, +find, +findIn, +findAll, +findInAll, +findGlobal, +findShallow, +findVerbose, +findVerboseAll, +sfind, +sfindReplace, +forkLocal, +help, +helpTopics, +history, +ioTest, +ioTestAll, +libInstallInputPattern, +load, +makeStandalone, +mergeBuiltins, +mergeIOBuiltins, +mergeOldInputPattern, +mergeOldPreviewInputPattern, +mergeOldSquashInputPattern, +mergeInputPattern, +mergeCommitInputPattern, +names False, -- names +names True, -- names.global +namespaceDependencies, +previewAdd, +previewUpdate, +printVersion, +projectCreate, +projectCreateEmptyInputPattern, +projectRenameInputPattern, +projectSwitch, +projectsInputPattern, +pull, +pullWithoutHistory, +push, +pushCreate, +pushExhaustive, +pushForce, +quit, +releaseDraft, +renameBranch, +renameTerm, +renameType, +moveAll, +reset, +resetRoot, +runScheme, +saveExecuteResult, +test, +testAll, +todo, +ui, +undo, +up, +update, +updateBuiltins, +updateOld, +updateOldNoPatch, +upgrade, +upgradeCommitInputPattern, +view, +viewGlobal, +viewReflog +``` diff --git a/unison-src/transcripts/input-parse-errors.output.md b/unison-src/transcripts/input-parse-errors.output.md new file mode 100644 index 0000000000..35718aea33 --- /dev/null +++ b/unison-src/transcripts/input-parse-errors.output.md @@ -0,0 +1,202 @@ +# demonstrating our new input parsing errors + +```unison +x = 55 +``` + +`handleNameArg` parse error in `add` +```ucm +scratch/main> add . + + Sorry, I wasn’t sure how to process your request. 1:2: | 1 | . + | ^ unexpected end of input expecting '`' or operator (valid + characters: !$%&*+-/:<=>\^|~) + + You can run `help add` for more information on using `add` + `add` adds to the codebase all the definitions from the most recently typechecked file. + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/main> add 1 + + + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/main> add 2 + + ⊡ Ignored previously added definitions: x + +``` +todo: +```haskell + + SA.Name name -> pure name + SA.NameWithBranchPrefix (Left _) name -> pure name + SA.NameWithBranchPrefix (Right prefix) name -> pure $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name + SA.HashQualified hqname -> maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname + SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname + SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> + pure . Path.prefixNameIfRel (Path.AbsolutePath' prefix) $ HQ'.toName hqname + SA.ShallowListEntry prefix entry -> + pure . HQ'.toName . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry + SA.SearchResult mpath result -> + maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result + otherNumArg -> Left . I.Formatted $ wrongStructuredArgument "a name" otherNumArg + +``` + +aliasMany: skipped -- similar to `add` + +```ucm +scratch/main> update arg + + Sorry, I wasn’t sure how to process your request. I expected + no arguments, but received 1. + + You can run `help update` for more information on using `update` + Adds everything in the most recently typechecked file to the + namespace, replacing existing definitions having the same + name, and attempts to update all the existing dependents + accordingly. If the process can't be completed + automatically, the dependents will be added back to the + scratch file for your review. + +``` +aliasTerm +```scratch +/main> alias.term ##Nat.+ Nat.+ + +``` + +aliasTermForce, +aliasType, + + +todo: +```alias +Many, +api, +authLogin, +back, +branchEmptyInputPattern, +branchInputPattern, +branchRenameInputPattern, +branchesInputPattern, +cd, +clear, +clone, +compileScheme, +createAuthor, +debugClearWatchCache, +debugDoctor, +debugDumpNamespace, +debugDumpNamespaceSimple, +debugTerm, +debugTermVerbose, +debugType, +debugLSPFoldRanges, +debugFileHashes, +debugNameDiff, +debugNumberedArgs, +debugTabCompletion, +debugFuzzyOptions, +debugFormat, +delete, +deleteBranch, +deleteProject, +deleteNamespace, +deleteNamespaceForce, +deleteTerm, +deleteTermVerbose, +deleteType, +deleteTypeVerbose, +deleteVerbose, +dependencies, +dependents, +diffNamespace, +display, +displayTo, +docToMarkdown, +docs, +docsToHtml, +edit, +editNamespace, +execute, +find, +findIn, +findAll, +findInAll, +findGlobal, +findShallow, +findVerbose, +findVerboseAll, +sfind, +sfindReplace, +forkLocal, +help, +helpTopics, +history, +ioTest, +ioTestAll, +libInstallInputPattern, +load, +makeStandalone, +mergeBuiltins, +mergeIOBuiltins, +mergeOldInputPattern, +mergeOldPreviewInputPattern, +mergeOldSquashInputPattern, +mergeInputPattern, +mergeCommitInputPattern, +names False, -- names +names True, -- names.global +namespaceDependencies, +previewAdd, +previewUpdate, +printVersion, +projectCreate, +projectCreateEmptyInputPattern, +projectRenameInputPattern, +projectSwitch, +projectsInputPattern, +pull, +pullWithoutHistory, +push, +pushCreate, +pushExhaustive, +pushForce, +quit, +releaseDraft, +renameBranch, +renameTerm, +renameType, +moveAll, +reset, +resetRoot, +runScheme, +saveExecuteResult, +test, +testAll, +todo, +ui, +undo, +up, +update, +updateBuiltins, +updateOld, +updateOldNoPatch, +upgrade, +upgradeCommitInputPattern, +view, +viewGlobal, +viewReflog + +``` + diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 258413502d..46280da177 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -6,22 +6,26 @@ branch. For example, to merge `topic` into `main`, switch to `main` and run `mer ```ucm .> help merge -merge -`merge /branch` merges `branch` into the current branch + Sorry, I wasn’t sure how to process your request. merge + `merge /branch` merges `branch` into the current branch + + You can run `help help` for more information on using `help` + `help` shows general help and `help ` shows help for one command. .> help merge.commit -merge.commit (or commit.merge) -`merge.commit` merges a temporary branch created by the `merge` -command back into its parent branch, and removes the temporary -branch. - -For example, if you've done `merge topic` from main, then -`merge.commit` is equivalent to doing - - * switch /main - * merge /merge-topic-into-main - * delete.branch /merge-topic-into-main + Sorry, I wasn’t sure how to process your request. merge.commit + (or commit.merge) + `merge.commit` merges a temporary branch created by the + `merge` command back into its parent branch, and removes the + temporary branch. + For example, if you've done `merge topic` from main, then + `merge.commit` is equivalent to doing * switch /main * + merge /merge-topic-into-main * + delete.branch /merge-topic-into-main + + You can run `help help` for more information on using `help` + `help` shows general help and `help ` shows help for one command. ``` Let's see a simple unconflicted merge in action: Alice (us) and Bob (them) add different terms. The merged result diff --git a/unison-src/transcripts/pull-errors.output.md b/unison-src/transcripts/pull-errors.output.md index 4890a5c1d1..13731c20f5 100644 --- a/unison-src/transcripts/pull-errors.output.md +++ b/unison-src/transcripts/pull-errors.output.md @@ -12,10 +12,10 @@ test/main> pull @aryairani/test-almost-empty/main lib.base_latest test/main> pull @aryairani/test-almost-empty/main a.b - Sorry, I wasn’t sure how to process your request. I think - you're wanting to merge @aryairani/test-almost-empty/main into - the a.b namespace, but the `pull` command only supports - merging into the top level of a local project branch. + Sorry, I wasn’t sure how to process your request. I think you + want to merge @aryairani/test-almost-empty/main into the a.b + namespace, but the `pull` command only supports merging into + the top level of a local project branch. You can run `help pull` for more information on using `pull` The `pull` command merges a remote namespace into a local @@ -49,10 +49,10 @@ test/main> pull @aryairani/test-almost-empty/main a test/main> pull @aryairani/test-almost-empty/main .a - Sorry, I wasn’t sure how to process your request. I think - you're wanting to merge @aryairani/test-almost-empty/main into - the .a namespace, but the `pull` command only supports merging - into the top level of a local project branch. + Sorry, I wasn’t sure how to process your request. I think you + want to merge @aryairani/test-almost-empty/main into the .a + namespace, but the `pull` command only supports merging into + the top level of a local project branch. You can run `help pull` for more information on using `pull` The `pull` command merges a remote namespace into a local From 4bbbc8ce6095a9e3e1fee5b847ae292d17c57b88 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 5 Jul 2024 10:33:44 -0400 Subject: [PATCH 380/631] move pretty-print helpers out of CommandLine.hs to avoid a potential cycle between CommandLine.hs and InputPatterns.hs that otherwise came up on another branch. InputPatterns.hs also has formatting helpers that could be used in CommandLine.hs. Maybe they should be moved too, but I haven't thought about it. --- unison-cli/src/Unison/CommandLine.hs | 60 +---------------- unison-cli/src/Unison/CommandLine/Helpers.hs | 66 +++++++++++++++++++ .../src/Unison/CommandLine/InputPatterns.hs | 2 +- .../src/Unison/CommandLine/OutputMessages.hs | 2 +- unison-cli/src/Unison/Main.hs | 3 +- unison-cli/unison-cli.cabal | 1 + 6 files changed, 73 insertions(+), 61 deletions(-) create mode 100644 unison-cli/src/Unison/CommandLine/Helpers.hs diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 2c8be9bf43..69dfcfe0a5 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -3,21 +3,7 @@ {-# LANGUAGE ViewPatterns #-} module Unison.CommandLine - ( -- * Pretty Printing - allow, - backtick, - aside, - bigproblem, - note, - nothingTodo, - plural, - plural', - problem, - tip, - warn, - warnNote, - - -- * Other + ( allow, parseInput, prompt, watchConfig, @@ -32,7 +18,6 @@ import Data.Configurator (autoConfig, autoReload) import Data.Configurator qualified as Config import Data.Configurator.Types (Config, Worth (..)) import Data.List (isPrefixOf, isSuffixOf) -import Data.ListLike (ListLike) import Data.Map qualified as Map import Data.Semialign qualified as Align import Data.Text qualified as Text @@ -51,6 +36,7 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.Watch qualified as Watch import Unison.CommandLine.FZFResolvers qualified as FZFResolvers import Unison.CommandLine.FuzzySelect qualified as Fuzzy +import Unison.CommandLine.Helpers (warn) import Unison.CommandLine.InputPattern (InputPattern (..)) import Unison.CommandLine.InputPattern qualified as InputPattern import Unison.Parser.Ann (Ann) @@ -89,36 +75,6 @@ watchFileSystem q dir = do atomically . Q.enqueue q $ UnisonFileChanged (Text.pack filePath) text pure (cancel >> killThread t) -warnNote :: String -> String -warnNote s = "⚠️ " <> s - -backtick :: (IsString s) => P.Pretty s -> P.Pretty s -backtick s = P.group ("`" <> s <> "`") - -tip :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -tip s = P.column2 [("Tip:", P.wrap s)] - -note :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -note s = P.column2 [("Note:", P.wrap s)] - -aside :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -> P.Pretty s -aside a b = P.column2 [(a <> ":", b)] - -warn :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -warn = emojiNote "⚠️" - -problem :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -problem = emojiNote "❗️" - -bigproblem :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -bigproblem = emojiNote "‼️" - -emojiNote :: (ListLike s Char, IsString s) => String -> P.Pretty s -> P.Pretty s -emojiNote lead s = P.group (fromString lead) <> "\n" <> P.wrap s - -nothingTodo :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -nothingTodo = emojiNote "😶" - parseInput :: Codebase IO Symbol Ann -> -- | Current path from root @@ -235,15 +191,3 @@ fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do prompt :: String prompt = "> " - --- `plural [] "cat" "cats" = "cats"` --- `plural ["meow"] "cat" "cats" = "cat"` --- `plural ["meow", "meow"] "cat" "cats" = "cats"` -plural :: (Foldable f) => f a -> b -> b -> b -plural items one other = case toList items of - [_] -> one - _ -> other - -plural' :: (Integral a) => a -> b -> b -> b -plural' 1 one _other = one -plural' _ _one other = other diff --git a/unison-cli/src/Unison/CommandLine/Helpers.hs b/unison-cli/src/Unison/CommandLine/Helpers.hs new file mode 100644 index 0000000000..d50258e304 --- /dev/null +++ b/unison-cli/src/Unison/CommandLine/Helpers.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} + +module Unison.CommandLine.Helpers + ( -- * Pretty Printing + backtick, + aside, + bigproblem, + note, + nothingTodo, + plural, + plural', + problem, + tip, + warn, + warnNote, + ) +where + +import Data.ListLike (ListLike) +import Unison.Prelude +import Unison.Util.Pretty qualified as P +import Prelude hiding (readFile, writeFile) + +warnNote :: String -> String +warnNote s = "⚠️ " <> s + +backtick :: (IsString s) => P.Pretty s -> P.Pretty s +backtick s = P.group ("`" <> s <> "`") + +tip :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s +tip s = P.column2 [("Tip:", P.wrap s)] + +note :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s +note s = P.column2 [("Note:", P.wrap s)] + +aside :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s -> P.Pretty s +aside a b = P.column2 [(a <> ":", b)] + +warn :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s +warn = emojiNote "⚠️" + +problem :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s +problem = emojiNote "❗️" + +bigproblem :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s +bigproblem = emojiNote "‼️" + +emojiNote :: (ListLike s Char, IsString s) => String -> P.Pretty s -> P.Pretty s +emojiNote lead s = P.group (fromString lead) <> "\n" <> P.wrap s + +nothingTodo :: (ListLike s Char, IsString s) => P.Pretty s -> P.Pretty s +nothingTodo = emojiNote "😶" + +-- `plural [] "cat" "cats" = "cats"` +-- `plural ["meow"] "cat" "cats" = "cat"` +-- `plural ["meow", "meow"] "cat" "cats" = "cats"` +plural :: (Foldable f) => f a -> b -> b -> b +plural items one other = case toList items of + [_] -> one + _ -> other + +plural' :: (Integral a) => a -> b -> b -> b +plural' 1 one _other = one +plural' _ _one other = other diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 31fcd41ae6..101e124e8e 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -188,11 +188,11 @@ import Unison.Codebase.Path.Parse qualified as Path import Unison.Codebase.PushBehavior qualified as PushBehavior import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH -import Unison.CommandLine import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..), parseBranchRelativePath, parseIncrementalBranchRelativePath) import Unison.CommandLine.BranchRelativePath qualified as BranchRelativePath import Unison.CommandLine.Completion import Unison.CommandLine.FZFResolvers qualified as Resolvers +import Unison.CommandLine.Helpers (aside, backtick, tip, warn) import Unison.CommandLine.InputPattern (ArgumentType (..), InputPattern (InputPattern), IsOptional (..), unionSuggestions) import Unison.CommandLine.InputPattern qualified as I import Unison.Core.Project (ProjectBranchName (..)) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index f17f483adf..a473b9a83f 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -73,8 +73,8 @@ import Unison.Codebase.Runtime qualified as Runtime import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv -import Unison.CommandLine (bigproblem, note, tip) import Unison.CommandLine.FZFResolvers qualified as FZFResolvers +import Unison.CommandLine.Helpers (bigproblem, note, tip) import Unison.CommandLine.InputPattern (InputPattern) import Unison.CommandLine.InputPatterns (makeExample') import Unison.CommandLine.InputPatterns qualified as IP diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index 32e829c0b1..f9b8e02c07 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -74,7 +74,8 @@ import Unison.Codebase.Runtime qualified as Rt import Unison.Codebase.SqliteCodebase qualified as SC import Unison.Codebase.TranscriptParser qualified as TR import Unison.Codebase.Verbosity qualified as Verbosity -import Unison.CommandLine (plural', watchConfig) +import Unison.CommandLine (watchConfig) +import Unison.CommandLine.Helpers (plural') import Unison.CommandLine.Main qualified as CommandLine import Unison.CommandLine.Types qualified as CommandLine import Unison.CommandLine.Welcome (CodebaseInitStatus (..)) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index a8b8202763..6c6181208e 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -112,6 +112,7 @@ library Unison.CommandLine.DisplayValues Unison.CommandLine.FuzzySelect Unison.CommandLine.FZFResolvers + Unison.CommandLine.Helpers Unison.CommandLine.InputPattern Unison.CommandLine.InputPatterns Unison.CommandLine.Main From 111fc5e3f478658c932055e6f0ab0373e3c52171 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 5 Jul 2024 09:38:22 -0600 Subject: [PATCH 381/631] Fix shared CLI error message MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - don’t add an extra indent level to the entire output - do add a `warnCallout` to the message - don’t re-wrap formatted error output - remove the accidentally-included entire `help ` output --- unison-cli/src/Unison/CommandLine.hs | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index c65454d015..32019a4dd3 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -153,19 +153,21 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do except . first ( \msg -> - P.indentN 2 $ - P.wrap (P.text "Sorry, I wasn’t sure how to process your request. " <> msg) + P.warnCallout $ + P.wrap "Sorry, I wasn’t sure how to process your request." <> P.newline <> P.newline - <> P.text - ( "You can run `help " - <> Text.pack command - <> "` for more information on using `" - <> Text.pack command - <> "`" - ) + <> P.indentN 2 msg + <> P.newline <> P.newline - <> P.indentN 2 help + <> P.wrap + ( P.text $ + "You can run `help " + <> Text.pack command + <> "` for more information on using `" + <> Text.pack command + <> "`." + ) ) $ parse resolvedArgs pure $ Just (Left command : resolvedArgs, parsedInput) From 67399e9193d8418c5466961ab44171caba4cecc1 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 5 Jul 2024 09:42:45 -0600 Subject: [PATCH 382/631] Make CLI error messages more consistent - remove `warnCallout` and `warn` from individual messages - make sure no error messages return their `help` content - add some documentation about how to write failure messages --- .../src/Unison/CommandLine/InputPattern.hs | 11 ++++++- .../src/Unison/CommandLine/InputPatterns.hs | 33 +++++++++---------- 2 files changed, 26 insertions(+), 18 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPattern.hs b/unison-cli/src/Unison/CommandLine/InputPattern.hs index 4014bc1dc7..f7d5547073 100644 --- a/unison-cli/src/Unison/CommandLine/InputPattern.hs +++ b/unison-cli/src/Unison/CommandLine/InputPattern.hs @@ -66,7 +66,16 @@ data InputPattern = InputPattern visibility :: Visibility, -- Allow hiding certain commands when debugging or work-in-progress args :: [(ArgumentDescription, IsOptional, ArgumentType)], help :: P.Pretty CT.ColorText, - parse :: Arguments -> Either (P.Pretty CT.ColorText) Input + -- | Parse the arguments and return either an error message or a command `Input`. + -- + -- __NB__: This function should return `Left` only on failure. For commands (like `help`) that simply produce + -- formatted output, use `pure . Input.CreateMessage`. The failure output should be fully formatted (using + -- `wrap`, etc.), but shouldn’t include any general error components like a warninng flag or the full help + -- message, and shouldn’t plan for the context it is being output to (e.g., don’t `P.indentN` the entire + -- message). + parse :: + Arguments -> + Either (P.Pretty CT.ColorText) Input } data ArgumentType = ArgumentType diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index da684d80c9..4cbc21bd63 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -772,7 +772,7 @@ todo = ) \case [] -> Right Input.TodoI - _ -> Left (I.help todo) + args -> wrongArgsLength "no arguments" args load :: InputPattern load = @@ -1257,7 +1257,7 @@ renameTerm = "`move.term foo bar` renames `foo` to `bar`." \case [oldName, newName] -> Input.MoveTermI <$> handleHashQualifiedSplit'Arg oldName <*> handleNewName newName - _ -> Left . P.warnCallout $ P.wrap "`rename.term` takes two arguments, like `rename.term oldname newname`." + _ -> Left $ P.wrap "`rename.term` takes two arguments, like `rename.term oldname newname`." moveAll :: InputPattern moveAll = @@ -1271,7 +1271,7 @@ moveAll = "`move foo bar` renames the term, type, and namespace foo to bar." \case [oldName, newName] -> Input.MoveAllI <$> handlePath'Arg oldName <*> handleNewPath newName - _ -> Left . P.warnCallout $ P.wrap "`move` takes two arguments, like `move oldname newname`." + _ -> Left $ P.wrap "`move` takes two arguments, like `move oldname newname`." renameType :: InputPattern renameType = @@ -1286,7 +1286,7 @@ renameType = \case [oldName, newName] -> Input.MoveTypeI <$> handleHashQualifiedSplit'Arg oldName <*> handleNewName newName _ -> - Left . P.warnCallout $ P.wrap "`rename.type` takes two arguments, like `rename.type oldname newname`." + Left $ P.wrap "`rename.type` takes two arguments, like `rename.type oldname newname`." deleteGen :: Maybe String -> ArgumentType -> String -> ([Path.HQSplit'] -> DeleteTarget) -> InputPattern deleteGen suffix queryCompletionArg target mkTarget = @@ -1312,7 +1312,7 @@ deleteGen suffix queryCompletionArg target mkTarget = "" ) ] - warn = + warning = P.sep " " [ backtick (P.string cmd), @@ -1326,7 +1326,7 @@ deleteGen suffix queryCompletionArg target mkTarget = [("definition to delete", OnePlus, queryCompletionArg)] info \case - [] -> Left . P.warnCallout $ P.wrap warn + [] -> Left $ P.wrap warning queries -> Input.DeleteI . mkTarget <$> traverse handleHashQualifiedSplit'Arg queries delete :: InputPattern @@ -1397,7 +1397,7 @@ aliasTerm = help = "`alias.term foo bar` introduces `bar` with the same definition as `foo`.", parse = \case [oldName, newName] -> Input.AliasTermI False <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName - _ -> Left . warn $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`." + _ -> Left $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`." } aliasTermForce :: InputPattern @@ -1411,7 +1411,7 @@ aliasTermForce = parse = \case [oldName, newName] -> Input.AliasTermI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName _ -> - Left . warn $ + Left $ P.wrap "`debug.alias.term.force` takes two arguments, like `debug.alias.term.force oldname newname`." } @@ -1425,7 +1425,7 @@ aliasType = "`alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`." \case [oldName, newName] -> Input.AliasTypeI <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName - _ -> Left . warn $ P.wrap "`alias.type` takes two arguments, like `alias.type oldname newname`." + _ -> Left $ P.wrap "`alias.type` takes two arguments, like `alias.type oldname newname`." aliasMany :: InputPattern aliasMany = @@ -2253,7 +2253,7 @@ viewReflog = ( \case [] -> pure Input.ShowReflogI _ -> - Left . warn . P.string $ + Left . P.string $ I.patternName viewReflog ++ " doesn't take any arguments." ) @@ -2316,9 +2316,9 @@ helpTopics = [topic] -> do topic <- unsupportedStructuredArgument "help-topics" "a help topic" topic case Map.lookup topic helpTopicsMap of - Nothing -> Left . warn $ "I don't know of that topic. Try `help-topics`." + Nothing -> Left $ "I don't know of that topic. Try `help-topics`." Just t -> Right $ Input.CreateMessage t - _ -> Left $ warn "Use `help-topics ` or `help-topics`." + _ -> Left $ "Use `help-topics ` or `help-topics`." ) where topics = @@ -2328,7 +2328,7 @@ helpTopics = "", P.indentN 2 $ P.sep "\n" (P.string <$> Map.keys helpTopicsMap), "", - aside "Example" "use `help filestatus` to learn more about that topic." + aside "Example" "use `help-topics filestatus` to learn more about that topic." ] helpTopicsMap :: Map String (P.Pretty P.ColorText) @@ -2506,7 +2506,7 @@ help = cmd <- unsupportedStructuredArgument "help" "a command" cmd case (Map.lookup cmd commandsByName, isHelp cmd) of (Nothing, Just msg) -> Right $ Input.CreateMessage msg - (Nothing, Nothing) -> Left . warn $ "I don't know of that command. Try `help`." + (Nothing, Nothing) -> Left $ "I don't know of that command. Try `help`." (Just pat, Nothing) -> Right . Input.CreateMessage $ showPatternHelp pat -- If we have a command and a help topic with the same name (like "projects"), then append a tip to the -- command's help that suggests running `help-topic command` @@ -2521,7 +2521,7 @@ help = <> "use" <> makeExample helpTopics [P.string cmd] ) - _ -> Left $ warn "Use `help ` or `help`." + _ -> Left "Use `help ` or `help`." where commandsByName = Map.fromList $ do @@ -2552,7 +2552,7 @@ names isGlobal = (P.wrap $ makeExample (names isGlobal) ["foo"] <> " shows the hash and all known names for `foo`.") $ \case [thing] -> Input.NamesI isGlobal <$> handleHashQualifiedNameArg thing - _ -> Left (I.help (names isGlobal)) + args -> wrongArgsLength "exactly one argument" args where cmdName = if isGlobal then "names.global" else "names" @@ -4008,7 +4008,6 @@ parseHashQualifiedName :: parseHashQualifiedName s = maybe ( Left - . P.warnCallout . P.wrap $ P.string s <> " is not a well-formed name, hash, or hash-qualified name. " From 41a0da8477259ca03340d04dbd618b2463361baa Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 5 Jul 2024 10:52:27 -0600 Subject: [PATCH 383/631] Fix formatting of an error message It was leaving out spaces between literal text and generated text. --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 10 +++++----- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 4cbc21bd63..bfe9d51b4c 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1773,8 +1773,8 @@ pullImpl name aliases pullMode addendum = do These sourceProject sourceBranch -> Right (Input.LibInstallI True (ProjectAndBranch sourceProject (Just sourceBranch))) (Right source, Left _, Right path) -> - Left $ - "I think you want to merge" + Left . P.wrap $ + "I think you want to merge " <> case source of RemoteRepo.ReadShare'LooseCode _sourcePath -> "some non-project code" RemoteRepo.ReadShare'ProjectBranch (This sourceProject) -> @@ -1787,11 +1787,11 @@ pullImpl name aliases pullMode addendum = do "the latest release of" <> prettyProjectName sourceProject RemoteRepo.ReadShare'ProjectBranch (These sourceProject (ProjectBranchNameOrLatestRelease'Name sourceBranch)) -> prettyProjectAndBranchName (ProjectAndBranch sourceProject sourceBranch) - <> "into the" + <> " into the " <> prettyPath' path - <> "namespace, but the" + <> " namespace, but the " <> makeExample' pull - <> "command only supports merging into the top level of a local project branch." + <> " command only supports merging into the top level of a local project branch." args -> wrongArgsLength "no more than two arguments" args } diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 291fcf6e2e..781b7d4104 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2131,7 +2131,7 @@ notifyUser dir = \case <> P.group (IP.makeExample IP.libInstallInputPattern [prettyProjectAndBranchName libdep] <> ".") PullIntoMissingBranch source (ProjectAndBranch maybeTargetProject targetBranch) -> pure . P.wrap $ - "I think you're wanting to merge" + "I think you want to merge" <> sourcePretty <> "into the" <> targetPretty From a7f1c24b5712afcbd79a7e7e63d8495a0ee18ecd Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 5 Jul 2024 10:54:35 -0600 Subject: [PATCH 384/631] Update transcript outputs --- unison-src/transcripts/help.md | 2 +- unison-src/transcripts/help.output.md | 61 +++++++------- .../transcripts/input-parse-errors.output.md | 35 ++++---- unison-src/transcripts/merge.md | 2 +- unison-src/transcripts/merge.output.md | 18 ++--- unison-src/transcripts/pull-errors.output.md | 79 +++++-------------- 6 files changed, 83 insertions(+), 114 deletions(-) diff --git a/unison-src/transcripts/help.md b/unison-src/transcripts/help.md index 7a2ffa2906..79ffa1846d 100644 --- a/unison-src/transcripts/help.md +++ b/unison-src/transcripts/help.md @@ -1,6 +1,6 @@ # Shows `help` output -```ucm:error +```ucm scratch/main> help scratch/main> help-topics scratch/main> help-topic filestatus diff --git a/unison-src/transcripts/help.output.md b/unison-src/transcripts/help.output.md index 2044217df0..27a6d74897 100644 --- a/unison-src/transcripts/help.output.md +++ b/unison-src/transcripts/help.output.md @@ -846,13 +846,15 @@ scratch/main> help-topics remotes testcache - Example: use `help filestatus` to learn more about that topic. + Example: use `help-topics filestatus` to learn more about that topic. scratch/main> help-topic filestatus - Sorry, I wasn’t sure how to process your request. 📓 + 📓 + Here's a list of possible status messages you might see for definitions in a .u file. + needs update A definition with the same name as an existing definition. Doing `update` instead of `add` will turn this failure @@ -867,54 +869,60 @@ scratch/main> help-topic filestatus constructor that's named the same as an existing term. Rename that term or your constructor before trying again to `add` - or `update`. + or `update`. + blocked This definition was blocked because it dependended on a definition with a failed - status. + status. + extra dependency This definition was added because it was a dependency of a definition explicitly selected. - - You can run `help help-topic` for more information on using `help-topic` - `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. scratch/main> help-topic messages.disallowedAbsolute - Sorry, I wasn’t sure how to process your request. 🤖 + 🤖 + Although I can understand absolute (ex: .foo.bar) or relative (ex: util.math.sqrt) references to existing definitions (help namespaces to learn more), I can't yet handle giving new definitions with absolute names in a .u file. + As a workaround, you can give definitions with a relative name temporarily (like `exports.blah.foo`) and then use `move.*`. - - You can run `help help-topic` for more information on using `help-topic` - `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. scratch/main> help-topic namespaces - Sorry, I wasn’t sure how to process your request. 🧐 + 🧐 + There are two kinds of namespaces, absolute, such as (.foo.bar or .base.math.+) and relative, such as (math.sqrt or util.List.++). + Relative names are converted to absolute names by prepending the current namespace. For example, if your Unison prompt - reads: .foo.bar> and your .u file looks like: x = 41 + reads: + + .foo.bar> + + and your .u file looks like: + + x = 41 + then doing an add will create the definition with the absolute name .foo.bar.x = 41 + and you can refer to x by its absolute name .foo.bar.x elsewhere in your code. For instance: - answerToLifeTheUniverseAndEverything = .foo.bar.x + 1 - You can run `help help-topic` for more information on using `help-topic` - `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. + answerToLifeTheUniverseAndEverything = .foo.bar.x + 1 scratch/main> help-topic projects - Sorry, I wasn’t sure how to process your request. A project is a versioned collection of code that can be edited, published, and depended on other projects. Unison projects are analogous to Git repositories. + project.create create a new project projects list all your projects branch create a new workstream @@ -924,40 +932,37 @@ scratch/main> help-topic projects push upload your changes to Unison Share pull download code(/changes/updates) from Unison Share clone download a Unison Share project or branch for contribution + Tip: Use `help project.create` to learn more. + For full documentation, see https://unison-lang.org/learn/projects - - You can run `help help-topic` for more information on using `help-topic` - `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. scratch/main> help-topic remotes - Sorry, I wasn’t sure how to process your request. 🤖 + 🤖 + Local projects may be associated with at most one remote project on Unison Share. When this relationship is established, it becomes the default argument for a number of share commands. For example, running `push` or `pull` in a project with no arguments will push to or pull from the associated remote, if it exists. + This association is created automatically on when a project is created by `clone`. If the project was created locally then the relationship will be established on the first `push`. - - You can run `help help-topic` for more information on using `help-topic` - `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. scratch/main> help-topic testcache - Sorry, I wasn’t sure how to process your request. 🎈 + 🎈 + Unison caches the results of test> watch expressions. Since these expressions are pure and always yield the same result when evaluated, there's no need to run them more than once! + A test is rerun only if it has changed, or if one of the definitions it depends on has changed. - - You can run `help help-topic` for more information on using `help-topic` - `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. ``` We should add a command to show help for hidden commands also. diff --git a/unison-src/transcripts/input-parse-errors.output.md b/unison-src/transcripts/input-parse-errors.output.md index 35718aea33..ad6efd02d6 100644 --- a/unison-src/transcripts/input-parse-errors.output.md +++ b/unison-src/transcripts/input-parse-errors.output.md @@ -8,12 +8,19 @@ x = 55 ```ucm scratch/main> add . - Sorry, I wasn’t sure how to process your request. 1:2: | 1 | . - | ^ unexpected end of input expecting '`' or operator (valid - characters: !$%&*+-/:<=>\^|~) +⚠️ + +Sorry, I wasn’t sure how to process your request. + + 1:2: + | + 1 | . + | ^ + unexpected end of input + expecting '`' or operator (valid characters: !$%&*+-/:<=>\^|~) - You can run `help add` for more information on using `add` - `add` adds to the codebase all the definitions from the most recently typechecked file. + +You can run `help add` for more information on using `add`. scratch/main> ls @@ -57,16 +64,14 @@ aliasMany: skipped -- similar to `add` ```ucm scratch/main> update arg - Sorry, I wasn’t sure how to process your request. I expected - no arguments, but received 1. - - You can run `help update` for more information on using `update` - Adds everything in the most recently typechecked file to the - namespace, replacing existing definitions having the same - name, and attempts to update all the existing dependents - accordingly. If the process can't be completed - automatically, the dependents will be added back to the - scratch file for your review. +⚠️ + +Sorry, I wasn’t sure how to process your request. + + I expected no arguments, but received 1. + +You can run `help update` for more information on using +`update`. ``` aliasTerm diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index d2f1105a2f..f951756896 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -3,7 +3,7 @@ The `merge` command merges together two branches in the same project: the current branch (unspecificed), and the target branch. For example, to merge `topic` into `main`, switch to `main` and run `merge topic`: -```ucm:error +```ucm .> help merge .> help merge.commit ``` diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 46280da177..63a4f852b7 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -6,26 +6,22 @@ branch. For example, to merge `topic` into `main`, switch to `main` and run `mer ```ucm .> help merge - Sorry, I wasn’t sure how to process your request. merge + merge `merge /branch` merges `branch` into the current branch - - You can run `help help` for more information on using `help` - `help` shows general help and `help ` shows help for one command. .> help merge.commit - Sorry, I wasn’t sure how to process your request. merge.commit - (or commit.merge) + merge.commit (or commit.merge) `merge.commit` merges a temporary branch created by the `merge` command back into its parent branch, and removes the temporary branch. + For example, if you've done `merge topic` from main, then - `merge.commit` is equivalent to doing * switch /main * - merge /merge-topic-into-main * - delete.branch /merge-topic-into-main + `merge.commit` is equivalent to doing - You can run `help help` for more information on using `help` - `help` shows general help and `help ` shows help for one command. + * switch /main + * merge /merge-topic-into-main + * delete.branch /merge-topic-into-main ``` Let's see a simple unconflicted merge in action: Alice (us) and Bob (them) add different terms. The merged result diff --git a/unison-src/transcripts/pull-errors.output.md b/unison-src/transcripts/pull-errors.output.md index 13731c20f5..14ca55ad6a 100644 --- a/unison-src/transcripts/pull-errors.output.md +++ b/unison-src/transcripts/pull-errors.output.md @@ -12,69 +12,32 @@ test/main> pull @aryairani/test-almost-empty/main lib.base_latest test/main> pull @aryairani/test-almost-empty/main a.b - Sorry, I wasn’t sure how to process your request. I think you - want to merge @aryairani/test-almost-empty/main into the a.b - namespace, but the `pull` command only supports merging into - the top level of a local project branch. - - You can run `help pull` for more information on using `pull` - The `pull` command merges a remote namespace into a local - branch - - `pull @unison/base/main` merges the branch - `main` of the Unison - Share hosted project - `@unison/base` into - the current branch - `pull @unison/base/main my-base/topic` merges the branch - `main` of the Unison - Share hosted project - `@unison/base` into - the branch `topic` - of the local - `my-base` project - - where `remote` is a project or project branch, such as: - Project (defaults to the /main branch) `@unison/base` - Project Branch `@unison/base/feature` - Contributor Branch `@unison/base/@johnsmith/feature` - Project Release `@unison/base/releases/1.0.0` +⚠️ + +Sorry, I wasn’t sure how to process your request. + + I think you want to merge @aryairani/test-almost-empty/main + into the a.b namespace, but the `pull` command only supports + merging into the top level of a local project branch. + +You can run `help pull` for more information on using `pull`. test/main> pull @aryairani/test-almost-empty/main a - I think you're wanting to merge - @aryairani/test-almost-empty/main into the a branch, but it - doesn't exist. If you want, you can create it with - `branch.empty a`, and then `pull` again. + I think you want to merge @aryairani/test-almost-empty/main + into the a branch, but it doesn't exist. If you want, you can + create it with `branch.empty a`, and then `pull` again. test/main> pull @aryairani/test-almost-empty/main .a - Sorry, I wasn’t sure how to process your request. I think you - want to merge @aryairani/test-almost-empty/main into the .a - namespace, but the `pull` command only supports merging into - the top level of a local project branch. - - You can run `help pull` for more information on using `pull` - The `pull` command merges a remote namespace into a local - branch - - `pull @unison/base/main` merges the branch - `main` of the Unison - Share hosted project - `@unison/base` into - the current branch - `pull @unison/base/main my-base/topic` merges the branch - `main` of the Unison - Share hosted project - `@unison/base` into - the branch `topic` - of the local - `my-base` project - - where `remote` is a project or project branch, such as: - Project (defaults to the /main branch) `@unison/base` - Project Branch `@unison/base/feature` - Contributor Branch `@unison/base/@johnsmith/feature` - Project Release `@unison/base/releases/1.0.0` +⚠️ + +Sorry, I wasn’t sure how to process your request. + + I think you want to merge @aryairani/test-almost-empty/main + into the .a namespace, but the `pull` command only supports + merging into the top level of a local project branch. + +You can run `help pull` for more information on using `pull`. ``` From 81f9458ba7c8878e3ed198c33907a553ac3b40bd Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 5 Jul 2024 12:14:40 -0600 Subject: [PATCH 385/631] Remove a help message from an error This silpped by in the merge. --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index a453f5f5a3..b3cc59fb35 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2184,7 +2184,7 @@ mergeCommitInputPattern = ), parse = \case [] -> Right Input.MergeCommitI - _ -> Left (I.help mergeCommitInputPattern) + args -> wrongArgsLength "no arguments" args } parseLooseCodeOrProject :: String -> Maybe Input.LooseCodeOrProject From ddbfb35d4bc405fdae3a7c9778b8558b960b5353 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 5 Jul 2024 12:25:32 -0600 Subject: [PATCH 386/631] Remove another warning flag from a message Another one missed in the merge. --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index b3cc59fb35..8b795c6ca2 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1438,7 +1438,7 @@ debugAliasTypeForce = parse = \case [oldName, newName] -> Input.AliasTypeI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName _ -> - Left . warn $ + Left $ P.wrap "`debug.alias.type.force` takes two arguments, like `debug.alias.type.force oldname newname`." } From deaf355f832c7b0ef43a1a44b2fea486bc8df41a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 10:20:49 -0700 Subject: [PATCH 387/631] Improve LSP completion sorting --- .../src/Unison/Codebase/Editor/HandleInput.hs | 4 ++ .../Codebase/Editor/HandleInput/LSPDebug.hs | 15 +++++ .../src/Unison/Codebase/Editor/Input.hs | 1 + .../src/Unison/Codebase/Editor/Output.hs | 20 +++--- .../src/Unison/CommandLine/InputPatterns.hs | 17 +++++ .../src/Unison/CommandLine/OutputMessages.hs | 10 +++ unison-cli/src/Unison/LSP/Completion.hs | 62 +++++++++++++++---- unison-cli/unison-cli.cabal | 1 + unison-src/transcripts/lsp-name-completion.md | 35 +++++++++++ .../transcripts/lsp-name-completion.output.md | 38 ++++++++++++ 10 files changed, 181 insertions(+), 22 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/LSPDebug.hs create mode 100644 unison-src/transcripts/lsp-name-completion.md create mode 100644 unison-src/transcripts/lsp-name-completion.output.md diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 2175ce06a0..09d101923c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -65,6 +65,7 @@ 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.LSPDebug qualified as LSPDebug import Unison.Codebase.Editor.HandleInput.Load (EvalMode (Sandboxed), evalUnisonFile, handleLoad, loadUnisonFile) import Unison.Codebase.Editor.HandleInput.Ls (handleLs) import Unison.Codebase.Editor.HandleInput.Merge2 (handleMerge) @@ -809,6 +810,8 @@ loop e = do let completionFunc = Completion.haskelineTabComplete IP.patternMap codebase authHTTPClient currentPath (_, completions) <- liftIO $ completionFunc (reverse (unwords inputs), "") Cli.respond (DisplayDebugCompletions completions) + DebugLSPNameCompletionI prefix -> do + LSPDebug.debugLspNameCompletion prefix DebugFuzzyOptionsI command args -> do Cli.Env {codebase} <- ask currentPath <- Cli.getCurrentPath @@ -1077,6 +1080,7 @@ inputDescription input = DebugNameDiffI {} -> wat DebugNumberedArgsI {} -> wat DebugTabCompletionI _input -> wat + DebugLSPNameCompletionI _prefix -> wat DebugFuzzyOptionsI cmd input -> pure . Text.pack $ "debug.fuzzy-completions " <> unwords (cmd : toList input) DebugFormatI -> pure "debug.format" DebugTypecheckedUnisonFileI {} -> wat diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/LSPDebug.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/LSPDebug.hs new file mode 100644 index 0000000000..dc4f0cc14d --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/LSPDebug.hs @@ -0,0 +1,15 @@ +module Unison.Codebase.Editor.HandleInput.LSPDebug (debugLspNameCompletion) where + +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.NamesUtils qualified as Cli +import Unison.Codebase.Editor.Output (Output (DisplayDebugLSPNameCompletions)) +import Unison.LSP.Completion qualified as Completion +import Unison.Prelude + +debugLspNameCompletion :: Text -> Cli () +debugLspNameCompletion prefix = do + names <- Cli.currentNames + let ct = Completion.namesToCompletionTree names + let (_, matches) = Completion.completionsForQuery ct prefix + Cli.respond $ DisplayDebugLSPNameCompletions matches diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 86ecb38491..d9278b0588 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -192,6 +192,7 @@ data Input -- no path is provided. NamespaceDependenciesI (Maybe Path') | DebugTabCompletionI [String] -- The raw arguments provided + | DebugLSPNameCompletionI Text -- The raw arguments provided | DebugFuzzyOptionsI String [String] -- cmd and arguments | DebugFormatI | DebugNumberedArgsI diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 1534f42d0f..78d2cac1c1 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -56,6 +56,7 @@ import Unison.LabeledDependency (LabeledDependency) import Unison.Name (Name) import Unison.NameSegment (NameSegment) import Unison.Names (Names) +import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) @@ -82,7 +83,6 @@ import Unison.Util.Defns (DefnsF, defnsAreEmpty) import Unison.Util.Pretty qualified as P import Unison.Util.Relation (Relation) import Unison.WatchKind qualified as WK -import qualified Unison.Names as Names type ListDetailed = Bool @@ -186,15 +186,15 @@ data Output | -- | Function found, but has improper type -- Note: the constructor name is misleading here; we weren't necessarily looking for a "main". BadMainFunction + -- | what we were trying to do (e.g. "run", "io.test") Text - -- ^ what we were trying to do (e.g. "run", "io.test") + -- | name of function (HQ.HashQualified Name) - -- ^ name of function + -- | bad type of function (Type Symbol Ann) - -- ^ bad type of function PPE.PrettyPrintEnv + -- | acceptable type(s) of function [Type Symbol Ann] - -- ^ acceptable type(s) of function | BranchEmpty WhichBranchEmpty | LoadPullRequest (ReadRemoteNamespace Void) (ReadRemoteNamespace Void) Path' Path' Path' Path' | CreatedNewBranch Path.Absolute @@ -231,12 +231,12 @@ data Output -- for terms. This additional info is used to provide an enhanced -- error message. SearchTermsNotFoundDetailed + -- | @True@ if we are searching for a term, @False@ if we are searching for a type Bool - -- ^ @True@ if we are searching for a term, @False@ if we are searching for a type + -- | Misses (search terms that returned no hits for terms or types) [HQ.HashQualified Name] - -- ^ Misses (search terms that returned no hits for terms or types) + -- | Hits for types if we are searching for terms or terms if we are searching for types [HQ.HashQualified Name] - -- ^ Hits for types if we are searching for terms or terms if we are searching for types | -- ask confirmation before deleting the last branch that contains some defns -- `Path` is one of the paths the user has requested to delete, and is paired -- with whatever named definitions would not have any remaining names if @@ -336,6 +336,7 @@ data Output | IntegrityCheck IntegrityResult | DisplayDebugNameDiff NameChanges | DisplayDebugCompletions [Completion.Completion] + | DisplayDebugLSPNameCompletions [(Text, Name, LabeledDependency)] | DebugDisplayFuzzyOptions Text [String {- arg description, options -}] | DebugFuzzyOptionsNoResolver | DebugTerm (Bool {- verbose mode -}) (Either (Text {- A builtin hash -}) (Term Symbol Ann)) @@ -384,8 +385,8 @@ data Output | CalculatingDiff | -- | The `local` in a `clone remote local` is ambiguous AmbiguousCloneLocal + -- | Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) - -- ^ Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) | -- | The `remote` in a `clone remote local` is ambiguous AmbiguousCloneRemote ProjectName (ProjectAndBranch ProjectName ProjectBranchName) @@ -594,6 +595,7 @@ isFailure o = case o of ShareError {} -> True ViewOnShare {} -> False DisplayDebugCompletions {} -> False + DisplayDebugLSPNameCompletions {} -> False DebugDisplayFuzzyOptions {} -> False DebugFuzzyOptionsNoResolver {} -> True DebugTerm {} -> False diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 31fcd41ae6..4af89e8474 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -31,6 +31,7 @@ module Unison.CommandLine.InputPatterns debugNameDiff, debugNumberedArgs, debugTabCompletion, + debugLspNameCompletion, debugTerm, debugTermVerbose, debugType, @@ -1821,6 +1822,21 @@ debugTabCompletion = ) (fmap Input.DebugTabCompletionI . traverse (unsupportedStructuredArgument "text")) +debugLspNameCompletion :: InputPattern +debugLspNameCompletion = + InputPattern + "debug.lsp-name-completion" + [] + I.Hidden + [("Completion prefix", OnePlus, noCompletionsArg)] + ( P.lines + [ P.wrap $ "This command can be used to test and debug ucm's LSP name-completion within transcripts." + ] + ) + \case + [prefix] -> Input.DebugLSPNameCompletionI . Text.pack <$> unsupportedStructuredArgument "text" prefix + _ -> Left (I.help debugLspNameCompletion) + debugFuzzyOptions :: InputPattern debugFuzzyOptions = InputPattern @@ -3341,6 +3357,7 @@ validInputs = debugNameDiff, debugNumberedArgs, debugTabCompletion, + debugLspNameCompletion, debugFuzzyOptions, debugFormat, delete, diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index f17f483adf..992ed44d24 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1646,6 +1646,16 @@ notifyUser dir = \case else "" in (isCompleteTxt, P.string (Completion.replacement comp)) ) + DisplayDebugLSPNameCompletions completions -> + pure $ + P.columnNHeader + ["Matching Path", "Name", "Hash"] + ( completions <&> \(pathText, fqn, ld) -> + let ldRef = case ld of + LD.TermReferent ref -> prettyReferent 10 ref + LD.TypeReference ref -> prettyReference 10 ref + in [P.text pathText, prettyName fqn, P.syntaxToColor ldRef] + ) DebugDisplayFuzzyOptions argDesc fuzzyOptions -> pure $ P.lines diff --git a/unison-cli/src/Unison/LSP/Completion.hs b/unison-cli/src/Unison/LSP/Completion.hs index 129ba8bc54..89a375eee6 100644 --- a/unison-cli/src/Unison/LSP/Completion.hs +++ b/unison-cli/src/Unison/LSP/Completion.hs @@ -3,7 +3,14 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} -module Unison.LSP.Completion where +module Unison.LSP.Completion + ( completionHandler, + completionItemResolveHandler, + namesToCompletionTree, + -- Exported for transcript tests + completionsForQuery, + ) +where import Control.Comonad.Cofree import Control.Lens hiding (List, (:<)) @@ -11,6 +18,7 @@ import Control.Monad.Reader import Data.Aeson qualified as Aeson import Data.Aeson.Types qualified as Aeson import Data.Foldable qualified as Foldable +import Data.List qualified as List import Data.List.Extra (nubOrdOn) import Data.List.NonEmpty (NonEmpty (..)) import Data.Map qualified as Map @@ -58,26 +66,30 @@ completionHandler m respond = (range, prefix) <- VFS.completionPrefix (m ^. params . textDocument . uri) (m ^. params . position) ppe <- PPED.suffixifiedPPE <$> lift currentPPED codebaseCompletions <- lift getCodebaseCompletions - -- Config {maxCompletions} <- lift getConfig - let defMatches = matchCompletions codebaseCompletions prefix - let (isIncomplete, defCompletions) = - defMatches - & nubOrdOn (\(p, _name, ref) -> (p, ref)) - & fmap (over _1 Path.toText) - & (False,) - -- case maxCompletions of - -- Nothing -> (False,) - -- Just n -> takeCompletions n + let (isIncomplete, matches) = completionsForQuery codebaseCompletions prefix let defCompletionItems = - defCompletions + matches & mapMaybe \(path, fqn, dep) -> let biasedPPE = PPE.biasTo [fqn] ppe hqName = LD.fold (PPE.types biasedPPE) (PPE.terms biasedPPE) dep in hqName <&> \hqName -> mkDefCompletionItem fileUri range (HQ'.toName hqName) fqn path (HQ'.toText hqName) dep + let itemDefaults = Nothing pure . CompletionList isIncomplete itemDefaults $ defCompletionItems where +completionsForQuery :: CompletionTree -> Text -> (Bool, [(Text, Name, LabeledDependency)]) +completionsForQuery codebaseCompletions prefix = + let defMatches = matchCompletions codebaseCompletions prefix + (isIncomplete, defCompletions) = + defMatches + -- sort shorter names first + & sortOn (matchSortCriteria . view _2) + & nubOrdOn (\(p, _name, ref) -> (p, ref)) + & fmap (over _1 Path.toText) + & (False,) + in (isIncomplete, defCompletions) + -- Takes at most the specified number of completions, but also indicates with a boolean -- whether there were more completions remaining so we can pass that along to the client. -- takeCompletions :: Int -> [a] -> (Bool, [a]) @@ -100,7 +112,9 @@ mkDefCompletionItem fileUri range relativeName fullyQualifiedName path suffixifi _documentation = Nothing, _deprecated = Nothing, _preselect = Nothing, - _sortText = Nothing, + _sortText = + let (nls, ns, fn) = matchSortCriteria fullyQualifiedName + in Just $ Text.intercalate "|" [paddedInt nls, paddedInt ns, Name.toText fn], _filterText = Just path, _insertText = Nothing, _insertTextFormat = Nothing, @@ -113,6 +127,13 @@ mkDefCompletionItem fileUri range relativeName fullyQualifiedName path suffixifi _data_ = Just $ Aeson.toJSON $ CompletionItemDetails {dep, relativeName, fullyQualifiedName, fileUri} } where + -- Pads an integer with zeroes so it sorts lexicographically in the right order + -- + -- >>> paddedInt 1 + -- "00001" + paddedInt :: Int -> Text + paddedInt n = + Text.justifyRight 5 '0' (Text.pack $ show n) -- We should generally show the longer of the path or suffixified name in the label, -- it helps the user understand the difference between options which may otherwise look -- the same. @@ -131,6 +152,21 @@ mkDefCompletionItem fileUri range relativeName fullyQualifiedName path suffixifi then path else suffixified +-- | LSP clients sort completions using a text field, so we have to convert Unison's sort criteria to text. +matchSortCriteria :: Name -> (Int, Int, Name) +matchSortCriteria fqn = + (numLibSegments, numSegments, fqn) + where + numSegments :: Int + numSegments = + Name.countSegments fqn + numLibSegments :: Int + numLibSegments = + Name.reverseSegments fqn + & Foldable.toList + & List.filter (== NameSegment.libSegment) + & List.length + -- | Generate a completion tree from a set of names. -- A completion tree is a suffix tree over the path segments of each name it contains. -- The goal is to allow fast completion of names by any partial path suffix. diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index a8b8202763..6075a09219 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -67,6 +67,7 @@ library Unison.Codebase.Editor.HandleInput.InstallLib Unison.Codebase.Editor.HandleInput.Load Unison.Codebase.Editor.HandleInput.Ls + Unison.Codebase.Editor.HandleInput.LSPDebug Unison.Codebase.Editor.HandleInput.Merge2 Unison.Codebase.Editor.HandleInput.MoveAll Unison.Codebase.Editor.HandleInput.MoveBranch diff --git a/unison-src/transcripts/lsp-name-completion.md b/unison-src/transcripts/lsp-name-completion.md new file mode 100644 index 0000000000..ba879a72e9 --- /dev/null +++ b/unison-src/transcripts/lsp-name-completion.md @@ -0,0 +1,35 @@ +```ucm:hide +scratch/main> builtins.merge lib.builtins +``` + +```unison:hide +foldMap = "top-level" +nested.deeply.foldMap = "nested" +lib.base.foldMap = "lib" +lib.dep.lib.transitive.foldMap = "transitive-lib" +-- A deeply nested definition with the same hash as the top level one. +-- This should not be included in the completion results if a better name with the same hash IS included. +lib.dep.lib.transitive_same_hash.foldMap = "top-level" +foldMapWith = "partial match" + +other = "other" +``` + +```ucm:hide +scratch/main> add +``` + +Completion should find all the `foldMap` definitions in the codebase, +sorted by number of name segments, shortest first. + +Individual LSP clients may still handle sorting differently, e.g. doing a fuzzy match over returned results, or +prioritizing exact matches over partial matches. We don't have any control over that. + +```ucm +scratch/main> debug.lsp-name-completion foldMap +``` + +Should still find the term which has a matching hash to a better name if the better name doesn't match. +```ucm +scratch/main> debug.lsp-name-completion transitive_same_hash.foldMap +``` diff --git a/unison-src/transcripts/lsp-name-completion.output.md b/unison-src/transcripts/lsp-name-completion.output.md new file mode 100644 index 0000000000..622d415f4f --- /dev/null +++ b/unison-src/transcripts/lsp-name-completion.output.md @@ -0,0 +1,38 @@ +```unison +foldMap = "top-level" +nested.deeply.foldMap = "nested" +lib.base.foldMap = "lib" +lib.dep.lib.transitive.foldMap = "transitive-lib" +-- A deeply nested definition with the same hash as the top level one. +-- This should not be included in the completion results if a better name with the same hash IS included. +lib.dep.lib.transitive_same_hash.foldMap = "top-level" +foldMapWith = "partial match" + +other = "other" +``` + +Completion should find all the `foldMap` definitions in the codebase, +sorted by number of name segments, shortest first. + +Individual LSP clients may still handle sorting differently, e.g. doing a fuzzy match over returned results, or +prioritizing exact matches over partial matches. We don't have any control over that. + +```ucm +scratch/main> debug.lsp-name-completion foldMap + + Matching Path Name Hash + foldMap foldMap #o38ps8p4q6 + foldMapWith foldMapWith #r9rs4mcb0m + foldMap nested.deeply.foldMap #snrjegr5dk + foldMap lib.base.foldMap #jf4buul17k + foldMap lib.dep.lib.transitive.foldMap #0o01gvr3fi + +``` +Should still find the term which has a matching hash to a better name if the better name doesn't match. +```ucm +scratch/main> debug.lsp-name-completion transitive_same_hash.foldMap + + Matching Path Name Hash + transitive_same_hash.foldMap lib.dep.lib.transitive_same_hash.foldMap #o38ps8p4q6 + +``` From 8be432be1b81e57c92f48178c10a864d1b0b1b80 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 5 Jul 2024 15:10:28 -0400 Subject: [PATCH 388/631] change a punctuation --- unison-cli/src/Unison/CommandLine.hs | 2 +- unison-src/transcripts/input-parse-errors.output.md | 4 ++-- unison-src/transcripts/pull-errors.output.md | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 32019a4dd3..155020304c 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -154,7 +154,7 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do . first ( \msg -> P.warnCallout $ - P.wrap "Sorry, I wasn’t sure how to process your request." + P.wrap "Sorry, I wasn’t sure how to process your request:" <> P.newline <> P.newline <> P.indentN 2 msg diff --git a/unison-src/transcripts/input-parse-errors.output.md b/unison-src/transcripts/input-parse-errors.output.md index ad6efd02d6..9eced0311f 100644 --- a/unison-src/transcripts/input-parse-errors.output.md +++ b/unison-src/transcripts/input-parse-errors.output.md @@ -10,7 +10,7 @@ scratch/main> add . ⚠️ -Sorry, I wasn’t sure how to process your request. +Sorry, I wasn’t sure how to process your request: 1:2: | @@ -66,7 +66,7 @@ scratch/main> update arg ⚠️ -Sorry, I wasn’t sure how to process your request. +Sorry, I wasn’t sure how to process your request: I expected no arguments, but received 1. diff --git a/unison-src/transcripts/pull-errors.output.md b/unison-src/transcripts/pull-errors.output.md index 14ca55ad6a..063c439dd5 100644 --- a/unison-src/transcripts/pull-errors.output.md +++ b/unison-src/transcripts/pull-errors.output.md @@ -14,7 +14,7 @@ test/main> pull @aryairani/test-almost-empty/main a.b ⚠️ -Sorry, I wasn’t sure how to process your request. +Sorry, I wasn’t sure how to process your request: I think you want to merge @aryairani/test-almost-empty/main into the a.b namespace, but the `pull` command only supports @@ -32,7 +32,7 @@ test/main> pull @aryairani/test-almost-empty/main .a ⚠️ -Sorry, I wasn’t sure how to process your request. +Sorry, I wasn’t sure how to process your request: I think you want to merge @aryairani/test-almost-empty/main into the .a namespace, but the `pull` command only supports From b9f4bfe19815b3741cf455c2aa9238718da432ab Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 12:09:00 -0700 Subject: [PATCH 389/631] Add unused binding detection to LSP --- unison-cli/src/Unison/LSP/FileAnalysis.hs | 5 ++- .../Unison/LSP/FileAnalysis/UnusedBindings.hs | 32 +++++++++++++++++++ unison-cli/unison-cli.cabal | 1 + 3 files changed, 37 insertions(+), 1 deletion(-) create mode 100644 unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index f5f29b5e27..32a51af4a8 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -35,6 +35,7 @@ import Unison.KindInference.Error qualified as KindInference import Unison.LSP.Conversions import Unison.LSP.Conversions qualified as Cv import Unison.LSP.Diagnostics (DiagnosticSeverity (..), mkDiagnostic, reportDiagnostics) +import Unison.LSP.FileAnalysis.UnusedBindings qualified as UnusedBindings import Unison.LSP.Orphans () import Unison.LSP.Types import Unison.LSP.VFS qualified as VFS @@ -111,12 +112,14 @@ checkFile doc = runMaybeT do & toRangeMap let typeSignatureHints = fromMaybe mempty (mkTypeSignatureHints <$> parsedFile <*> typecheckedFile) let fileSummary = FileSummary.mkFileSummary parsedFile typecheckedFile + let unusedBindingDiagnostics = fileSummary ^.. _Just . to termsBySymbol . folded . _3 . folding (UnusedBindings.analyseTerm fileUri) + Debug.debugM Debug.Temp "Unused binding diagnostics" unusedBindingDiagnostics let tokenMap = getTokenMap tokens conflictWarningDiagnostics <- fold <$> for fileSummary \fs -> lift $ computeConflictWarningDiagnostics fileUri fs let diagnosticRanges = - (errDiagnostics <> conflictWarningDiagnostics) + (errDiagnostics <> conflictWarningDiagnostics <> unusedBindingDiagnostics) & fmap (\d -> (d ^. range, d)) & toRangeMap let fileAnalysis = FileAnalysis {diagnostics = diagnosticRanges, codeActions = codeActionRanges, fileSummary, typeSignatureHints, ..} diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs new file mode 100644 index 0000000000..0a9e231c55 --- /dev/null +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -0,0 +1,32 @@ +module Unison.LSP.FileAnalysis.UnusedBindings (analyseTerm) where + +import Data.Foldable qualified as Foldable +import Data.Map qualified as Map +import Data.Set qualified as Set +import Language.LSP.Protocol.Types (Diagnostic) +import Language.LSP.Protocol.Types qualified as Lsp +import U.Core.ABT (ABT (..)) +import U.Core.ABT qualified as ABT +import Unison.LSP.Conversions qualified as Cv +import Unison.LSP.Diagnostics qualified as Diagnostic +import Unison.Parser.Ann (Ann) +import Unison.Prelude +import Unison.Symbol (Symbol) +import Unison.Term (Term) + +analyseTerm :: Lsp.Uri -> Term Symbol Ann -> [Diagnostic] +analyseTerm fileUri tm = + let (unusedVars, _) = ABT.cata alg tm + in Map.toList unusedVars & mapMaybe \(v, ann) -> do + range <- Cv.annToRange ann + pure $ Diagnostic.mkDiagnostic fileUri range Diagnostic.DiagnosticSeverity_Warning ("Unused binding " <> tShow v) [] + where + alg :: (Foldable f, Ord v) => Ann -> ABT f v (Map v Ann, Set v) -> (Map v Ann, Set v) + alg ann abt = case abt of + Var v -> (mempty, Set.singleton v) + Cycle x -> x + Abs v (unusedBindings, usedVars) -> + if v `Set.member` usedVars + then (unusedBindings, Set.delete v usedVars) + else (Map.insert v ann unusedBindings, usedVars) + Tm fx -> Foldable.fold fx diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index a8b8202763..94a05b1eae 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -128,6 +128,7 @@ library Unison.LSP.Conversions Unison.LSP.Diagnostics Unison.LSP.FileAnalysis + Unison.LSP.FileAnalysis.UnusedBindings Unison.LSP.FoldingRange Unison.LSP.Formatting Unison.LSP.HandlerUtils From 6a6c4d600481e697607d058555a8e02a2941472a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 12:47:43 -0700 Subject: [PATCH 390/631] Swap to using para instead of cata --- .../Unison/LSP/FileAnalysis/UnusedBindings.hs | 22 +++++++++++-------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs index 0a9e231c55..7aee4d37ab 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -1,8 +1,8 @@ module Unison.LSP.FileAnalysis.UnusedBindings (analyseTerm) where -import Data.Foldable qualified as Foldable -import Data.Map qualified as Map +import Control.Lens import Data.Set qualified as Set + import Language.LSP.Protocol.Types (Diagnostic) import Language.LSP.Protocol.Types qualified as Lsp import U.Core.ABT (ABT (..)) @@ -13,20 +13,24 @@ import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Symbol (Symbol) import Unison.Term (Term) +import Unison.Term qualified as Term analyseTerm :: Lsp.Uri -> Term Symbol Ann -> [Diagnostic] analyseTerm fileUri tm = - let (unusedVars, _) = ABT.cata alg tm - in Map.toList unusedVars & mapMaybe \(v, ann) -> do + let (unusedVars, _) = ABT.para alg tm + in unusedVars & mapMaybe \(v, ann) -> do range <- Cv.annToRange ann pure $ Diagnostic.mkDiagnostic fileUri range Diagnostic.DiagnosticSeverity_Warning ("Unused binding " <> tShow v) [] where - alg :: (Foldable f, Ord v) => Ann -> ABT f v (Map v Ann, Set v) -> (Map v Ann, Set v) + alg :: (Ord v) => Ann -> ABT (Term.F v a a) v (Term v Ann, ([(v, Ann)], Set v)) -> ([(v, Ann)], Set v) alg ann abt = case abt of Var v -> (mempty, Set.singleton v) - Cycle x -> x - Abs v (unusedBindings, usedVars) -> + Cycle (_t, x) -> x + Abs v (_, (unusedBindings, usedVars)) -> if v `Set.member` usedVars then (unusedBindings, Set.delete v usedVars) - else (Map.insert v ann unusedBindings, usedVars) - Tm fx -> Foldable.fold fx + else ((v, ann) : unusedBindings, usedVars) + Tm fx -> case fx of + Term.Let _isTop (lhsTerm, lx) (_rhsTerm, rx) -> + set (_1 . _head . _2) (ABT.annotation lhsTerm) lx <> rx + _ -> foldOf (folded . _2) fx From 25db6fbf05d0e4c68dc8a7b6a1cec624c10113e8 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 13:18:44 -0700 Subject: [PATCH 391/631] Revert back to simple cata --- .../Unison/LSP/FileAnalysis/UnusedBindings.hs | 26 ++++++++----------- 1 file changed, 11 insertions(+), 15 deletions(-) diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs index 7aee4d37ab..114d4a369e 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -1,8 +1,8 @@ -module Unison.LSP.FileAnalysis.UnusedBindings (analyseTerm) where +module Unison.LSP.FileAnalysis.UnusedBindings where -import Control.Lens +import Data.Foldable qualified as Foldable +import Data.Map qualified as Map import Data.Set qualified as Set - import Language.LSP.Protocol.Types (Diagnostic) import Language.LSP.Protocol.Types qualified as Lsp import U.Core.ABT (ABT (..)) @@ -13,24 +13,20 @@ import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Symbol (Symbol) import Unison.Term (Term) -import Unison.Term qualified as Term analyseTerm :: Lsp.Uri -> Term Symbol Ann -> [Diagnostic] analyseTerm fileUri tm = - let (unusedVars, _) = ABT.para alg tm - in unusedVars & mapMaybe \(v, ann) -> do + let (unusedVars, _) = ABT.cata alg tm + in Map.toList unusedVars & mapMaybe \(v, ann) -> do range <- Cv.annToRange ann pure $ Diagnostic.mkDiagnostic fileUri range Diagnostic.DiagnosticSeverity_Warning ("Unused binding " <> tShow v) [] where - alg :: (Ord v) => Ann -> ABT (Term.F v a a) v (Term v Ann, ([(v, Ann)], Set v)) -> ([(v, Ann)], Set v) + alg :: (Foldable f, Ord v) => Ann -> ABT f v (Map v Ann, Set v) -> (Map v Ann, Set v) alg ann abt = case abt of Var v -> (mempty, Set.singleton v) - Cycle (_t, x) -> x - Abs v (_, (unusedBindings, usedVars)) -> + Cycle x -> x + Abs v (unusedBindings, usedVars) -> if v `Set.member` usedVars - then (unusedBindings, Set.delete v usedVars) - else ((v, ann) : unusedBindings, usedVars) - Tm fx -> case fx of - Term.Let _isTop (lhsTerm, lx) (_rhsTerm, rx) -> - set (_1 . _head . _2) (ABT.annotation lhsTerm) lx <> rx - _ -> foldOf (folded . _2) fx + then (mempty, Set.delete v usedVars) + else (Map.insert v ann unusedBindings, usedVars) + Tm fx -> Foldable.fold fx From e102b0d5c6fec14797b0853784d5abbabef360d6 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 5 Jul 2024 16:27:41 -0400 Subject: [PATCH 392/631] fix compile error and use `makeExample` more --- unison-cli/src/Unison/CommandLine.hs | 17 ++++--- .../src/Unison/CommandLine/InputPatterns.hs | 49 +++++++++---------- 2 files changed, 33 insertions(+), 33 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 77e689982e..b10dbd5aec 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -39,6 +39,7 @@ import Unison.CommandLine.FuzzySelect qualified as Fuzzy import Unison.CommandLine.Helpers (warn) import Unison.CommandLine.InputPattern (InputPattern (..)) import Unison.CommandLine.InputPattern qualified as InputPattern +import Unison.CommandLine.InputPatterns qualified as IPs import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Project.Util (ProjectContext, projectContextFromPath) @@ -117,12 +118,10 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do <> P.newline <> P.newline <> P.wrap - ( P.text $ - "You can run `help " - <> Text.pack command - <> "` for more information on using `" - <> Text.pack command - <> "`." + ( "You can run" + <> IPs.makeExample IPs.help [fromString command] + <> "for more information on using" + <> IPs.makeExampleEOS pat [] ) ) $ parse resolvedArgs @@ -131,9 +130,11 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do throwE . warn . P.wrap - $ "I don't know how to " + $ "I don't know how to" <> P.group (fromString command <> ".") - <> "Type `help` or `?` to get help." + <> "Type" + <> IPs.makeExample' IPs.help + <> "or `?` to get help." where noCompletionsMessage argDesc = P.callout "⚠️" $ diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index e89857d0ce..ae2886e2de 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -190,7 +190,7 @@ import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..), parseBran import Unison.CommandLine.BranchRelativePath qualified as BranchRelativePath import Unison.CommandLine.Completion import Unison.CommandLine.FZFResolvers qualified as Resolvers -import Unison.CommandLine.Helpers (aside, backtick, tip, warn) +import Unison.CommandLine.Helpers (aside, backtick, tip) import Unison.CommandLine.InputPattern (ArgumentType (..), InputPattern (InputPattern), IsOptional (..), unionSuggestions) import Unison.CommandLine.InputPattern qualified as I import Unison.Core.Project (ProjectBranchName (..)) @@ -300,14 +300,13 @@ searchResultToHQ oprefix = \case addPrefix :: Name -> Name addPrefix = maybe id Path.prefixNameIfRel oprefix -unsupportedStructuredArgument :: Text -> Text -> I.Argument -> Either (P.Pretty CT.ColorText) String +unsupportedStructuredArgument :: InputPattern -> Text -> I.Argument -> Either (P.Pretty CT.ColorText) String unsupportedStructuredArgument command expected = - either pure . const . Left . P.text $ - "`" - <> command - <> "` can’t accept a numbered argument for " - <> expected - <> " and it’s not yet possible to provide un-expanded numbers as arguments." + either pure . const . Left . P.wrap $ + makeExample' command + <> "can’t accept a numbered argument for" + <> P.text expected + <> "and it’s not yet possible to provide un-expanded numbers as arguments." expectedButActually' :: Text -> String -> P.Pretty CT.ColorText expectedButActually' expected actualValue = @@ -793,7 +792,7 @@ load = ) \case [] -> pure $ Input.LoadI Nothing - [file] -> Input.LoadI . Just <$> unsupportedStructuredArgument "load" "a file name" file + [file] -> Input.LoadI . Just <$> unsupportedStructuredArgument load "a file name" file args -> wrongArgsLength "no more than one argument" args clear :: InputPattern @@ -1016,7 +1015,7 @@ displayTo = (wrongArgsLength "at least two arguments" [file]) ( \defs -> Input.DisplayI . Input.FileLocation - <$> unsupportedStructuredArgument "display.to" "a file name" file + <$> unsupportedStructuredArgument displayTo "a file name" file <*> traverse handleHashQualifiedNameArg defs ) $ NE.nonEmpty defs @@ -1823,7 +1822,7 @@ debugTabCompletion = P.wrap $ "Completions which are finished are prefixed with a * represent finished completions." ] ) - (fmap Input.DebugTabCompletionI . traverse (unsupportedStructuredArgument "debug.tab-complete" "text")) + (fmap Input.DebugTabCompletionI . traverse (unsupportedStructuredArgument debugTabCompletion "text")) debugLspNameCompletion :: InputPattern debugLspNameCompletion = @@ -1837,8 +1836,8 @@ debugLspNameCompletion = ] ) \case - [prefix] -> Input.DebugLSPNameCompletionI . Text.pack <$> unsupportedStructuredArgument "text" prefix - _ -> Left (I.help debugLspNameCompletion) + [prefix] -> Input.DebugLSPNameCompletionI . Text.pack <$> unsupportedStructuredArgument debugLspNameCompletion "text" prefix + args -> wrongArgsLength "exactly one argument" args debugFuzzyOptions :: InputPattern debugFuzzyOptions = @@ -1858,8 +1857,8 @@ debugFuzzyOptions = \case (cmd : args) -> Input.DebugFuzzyOptionsI - <$> unsupportedStructuredArgument "debug.fuzzy-options" "a command" cmd - <*> traverse (unsupportedStructuredArgument "debug.fuzzy-options" "text") args + <$> unsupportedStructuredArgument debugFuzzyOptions "a command" cmd + <*> traverse (unsupportedStructuredArgument debugFuzzyOptions "text") args args -> wrongArgsLength "at least one argument" args debugFormat :: InputPattern @@ -2345,7 +2344,7 @@ helpTopics = ( \case [] -> Right $ Input.CreateMessage topics [topic] -> do - topic <- unsupportedStructuredArgument "help-topics" "a help topic" topic + topic <- unsupportedStructuredArgument helpTopics "a help topic" topic case Map.lookup topic helpTopicsMap of Nothing -> Left $ "I don't know of that topic. Try `help-topics`." Just t -> Right $ Input.CreateMessage t @@ -2534,10 +2533,10 @@ help = showPatternHelp visibleInputs [cmd] -> do - cmd <- unsupportedStructuredArgument "help" "a command" cmd + cmd <- unsupportedStructuredArgument help "a command" cmd case (Map.lookup cmd commandsByName, isHelp cmd) of (Nothing, Just msg) -> Right $ Input.CreateMessage msg - (Nothing, Nothing) -> Left $ "I don't know of that command. Try `help`." + (Nothing, Nothing) -> Left $ "I don't know of that command. Try" <> makeExampleEOS help [] (Just pat, Nothing) -> Right . Input.CreateMessage $ showPatternHelp pat -- If we have a command and a help topic with the same name (like "projects"), then append a tip to the -- command's help that suggests running `help-topic command` @@ -2816,7 +2815,7 @@ docsToHtml = [namespacePath, destinationFilePath] -> Input.DocsToHtmlI <$> handleBranchRelativePathArg namespacePath - <*> unsupportedStructuredArgument "docs.to-html" "a file name" destinationFilePath + <*> unsupportedStructuredArgument docsToHtml "a file name" destinationFilePath args -> wrongArgsLength "exactly two arguments" args docToMarkdown :: InputPattern @@ -2856,7 +2855,7 @@ execute = main : args -> Input.ExecuteI <$> handleHashQualifiedNameArg main - <*> traverse (unsupportedStructuredArgument "run" "a command-line argument") args + <*> traverse (unsupportedStructuredArgument execute "a command-line argument") args [] -> wrongArgsLength "at least one argument" [] saveExecuteResult :: InputPattern @@ -2927,7 +2926,7 @@ makeStandalone = $ \case [main, file] -> Input.MakeStandaloneI - <$> unsupportedStructuredArgument "compile" "a file name" file + <$> unsupportedStructuredArgument makeStandalone "a file name" file <*> handleHashQualifiedNameArg main args -> wrongArgsLength "exactly two arguments" args @@ -2948,7 +2947,7 @@ runScheme = main : args -> Input.ExecuteSchemeI <$> handleHashQualifiedNameArg main - <*> traverse (unsupportedStructuredArgument "run.native" "a command-line argument") args + <*> traverse (unsupportedStructuredArgument runScheme "a command-line argument") args [] -> wrongArgsLength "at least one argument" [] compileScheme :: InputPattern @@ -2969,7 +2968,7 @@ compileScheme = $ \case [main, file] -> Input.CompileSchemeI . Text.pack - <$> unsupportedStructuredArgument "compile.native" "a file name" file + <$> unsupportedStructuredArgument compileScheme "a file name" file <*> handleHashQualifiedNameArg main args -> wrongArgsLength "exactly two arguments" args @@ -2997,7 +2996,7 @@ createAuthor = <$> handleRelativeNameSegmentArg symbolStr <*> fmap (parseAuthorName . unwords) - (traverse (unsupportedStructuredArgument "create.author" "text") authorStr) + (traverse (unsupportedStructuredArgument createAuthor "text") authorStr) args -> wrongArgsLength "at least two arguments" args where -- let's have a real parser in not too long @@ -3265,7 +3264,7 @@ releaseDraft = bimap (const "Couldn’t parse version number") Input.ReleaseDraftI . tryInto @Semver . Text.pack - =<< unsupportedStructuredArgument "release.draft" "a version number" semverString + =<< unsupportedStructuredArgument releaseDraft "a version number" semverString args -> wrongArgsLength "exactly one argument" args } From 61287bdce5d106636e6d165fc4bdbf424d75ca4c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 13:19:13 -0700 Subject: [PATCH 393/631] Move warnings to the top of the term --- unison-cli/src/Unison/LSP/Conversions.hs | 7 +++++ unison-cli/src/Unison/LSP/FileAnalysis.hs | 3 +- .../Unison/LSP/FileAnalysis/UnusedBindings.hs | 29 ++++++++++++++----- 3 files changed, 30 insertions(+), 9 deletions(-) diff --git a/unison-cli/src/Unison/LSP/Conversions.hs b/unison-cli/src/Unison/LSP/Conversions.hs index 307fd5c99d..f6163485cb 100644 --- a/unison-cli/src/Unison/LSP/Conversions.hs +++ b/unison-cli/src/Unison/LSP/Conversions.hs @@ -49,3 +49,10 @@ annToRange = \case Ann.External -> Nothing Ann.GeneratedFrom a -> annToRange a Ann.Ann start end -> Just $ Range (uToLspPos start) (uToLspPos end) + +annToURange :: Ann.Ann -> Maybe Range.Range +annToURange = \case + Ann.Intrinsic -> Nothing + Ann.External -> Nothing + Ann.GeneratedFrom a -> annToURange a + Ann.Ann start end -> Just $ Range.Range start end diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index 32a51af4a8..ddd7fc477c 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -112,8 +112,7 @@ checkFile doc = runMaybeT do & toRangeMap let typeSignatureHints = fromMaybe mempty (mkTypeSignatureHints <$> parsedFile <*> typecheckedFile) let fileSummary = FileSummary.mkFileSummary parsedFile typecheckedFile - let unusedBindingDiagnostics = fileSummary ^.. _Just . to termsBySymbol . folded . _3 . folding (UnusedBindings.analyseTerm fileUri) - Debug.debugM Debug.Temp "Unused binding diagnostics" unusedBindingDiagnostics + let unusedBindingDiagnostics = fileSummary ^.. _Just . to termsBySymbol . folded . folding (\(topLevelAnn, _refId, trm, _type) -> UnusedBindings.analyseTerm fileUri topLevelAnn trm) let tokenMap = getTokenMap tokens conflictWarningDiagnostics <- fold <$> for fileSummary \fs -> diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs index 114d4a369e..acb5d15c32 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -3,6 +3,7 @@ module Unison.LSP.FileAnalysis.UnusedBindings where import Data.Foldable qualified as Foldable import Data.Map qualified as Map import Data.Set qualified as Set +import Data.Text qualified as Text import Language.LSP.Protocol.Types (Diagnostic) import Language.LSP.Protocol.Types qualified as Lsp import U.Core.ABT (ABT (..)) @@ -11,22 +12,36 @@ import Unison.LSP.Conversions qualified as Cv import Unison.LSP.Diagnostics qualified as Diagnostic import Unison.Parser.Ann (Ann) import Unison.Prelude -import Unison.Symbol (Symbol) +import Unison.Symbol (Symbol (..)) import Unison.Term (Term) +import Unison.Util.Range qualified as Range +import Unison.Var qualified as Var +import Unison.Lexer.Pos qualified as Pos -analyseTerm :: Lsp.Uri -> Term Symbol Ann -> [Diagnostic] -analyseTerm fileUri tm = +analyseTerm :: Lsp.Uri -> Ann -> Term Symbol Ann -> [Diagnostic] +analyseTerm fileUri topLevelTermAnn tm = let (unusedVars, _) = ABT.cata alg tm - in Map.toList unusedVars & mapMaybe \(v, ann) -> do - range <- Cv.annToRange ann - pure $ Diagnostic.mkDiagnostic fileUri range Diagnostic.DiagnosticSeverity_Warning ("Unused binding " <> tShow v) [] + in Map.toList unusedVars & mapMaybe \(v, _ann) -> do + name <- getRelevantVarName v + -- Unfortunately we don't capture the annotation of the actual binding when parsing :'(, for now the least + -- annoying thing to do is just highlight the top of the binding. + urange <- Cv.annToURange topLevelTermAnn <&> (\(Range.Range start@(Pos.Pos line _col) _end) -> Range.Range start (Pos.Pos line 9999)) + let lspRange = Cv.uToLspRange urange + pure $ Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning ("Unused binding " <> tShow name <> " inside this term.\nUse the binding, or prefix it with an _ to dismiss this warning.") [] where + getRelevantVarName :: Symbol -> Maybe Text + getRelevantVarName = \case + -- We only care about user bindings which don't start with an underscore + Symbol _ (Var.User n) -> do + guard (not (Text.isPrefixOf "_" n)) + pure n + _ -> Nothing alg :: (Foldable f, Ord v) => Ann -> ABT f v (Map v Ann, Set v) -> (Map v Ann, Set v) alg ann abt = case abt of Var v -> (mempty, Set.singleton v) Cycle x -> x Abs v (unusedBindings, usedVars) -> if v `Set.member` usedVars - then (mempty, Set.delete v usedVars) + then (unusedBindings, Set.delete v usedVars) else (Map.insert v ann unusedBindings, usedVars) Tm fx -> Foldable.fold fx From a6b8af1edecff9f8028a30464b9bf4c83f2d09cb Mon Sep 17 00:00:00 2001 From: ChrisPenner Date: Fri, 5 Jul 2024 20:51:54 +0000 Subject: [PATCH 394/631] automatically run ormolu --- unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs index acb5d15c32..1f23729307 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -10,13 +10,13 @@ import U.Core.ABT (ABT (..)) import U.Core.ABT qualified as ABT import Unison.LSP.Conversions qualified as Cv import Unison.LSP.Diagnostics qualified as Diagnostic +import Unison.Lexer.Pos qualified as Pos import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Symbol (Symbol (..)) import Unison.Term (Term) import Unison.Util.Range qualified as Range import Unison.Var qualified as Var -import Unison.Lexer.Pos qualified as Pos analyseTerm :: Lsp.Uri -> Ann -> Term Symbol Ann -> [Diagnostic] analyseTerm fileUri topLevelTermAnn tm = From 0587ddec238d3883af2df3e38b064a0d0fc19418 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 13:51:17 -0700 Subject: [PATCH 395/631] Compress unused bindings into a single diagnostic --- .../Unison/LSP/FileAnalysis/UnusedBindings.hs | 21 ++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs index 1f23729307..859d464d7d 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -21,13 +21,20 @@ import Unison.Var qualified as Var analyseTerm :: Lsp.Uri -> Ann -> Term Symbol Ann -> [Diagnostic] analyseTerm fileUri topLevelTermAnn tm = let (unusedVars, _) = ABT.cata alg tm - in Map.toList unusedVars & mapMaybe \(v, _ann) -> do - name <- getRelevantVarName v - -- Unfortunately we don't capture the annotation of the actual binding when parsing :'(, for now the least - -- annoying thing to do is just highlight the top of the binding. - urange <- Cv.annToURange topLevelTermAnn <&> (\(Range.Range start@(Pos.Pos line _col) _end) -> Range.Range start (Pos.Pos line 9999)) - let lspRange = Cv.uToLspRange urange - pure $ Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning ("Unused binding " <> tShow name <> " inside this term.\nUse the binding, or prefix it with an _ to dismiss this warning.") [] + -- Unfortunately we don't capture the annotation of the actual binding when parsing :'(, for now the least + -- annoying thing to do is just highlight the top of the binding. + mayRange = + Cv.annToURange topLevelTermAnn + <&> (\(Range.Range start@(Pos.Pos line _col) _end) -> Range.Range start (Pos.Pos line 9999)) + <&> Cv.uToLspRange + vars = + Map.toList unusedVars & mapMaybe \(v, _ann) -> do + getRelevantVarName v + in case mayRange of + Nothing -> [] + Just lspRange -> + let bindings = Text.intercalate ", " (tShow <$> vars) + in [Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning ("Unused binding(s) " <> bindings <> " inside this term.\nUse the binding, or prefix it with an _ to dismiss this warning.") []] where getRelevantVarName :: Symbol -> Maybe Text getRelevantVarName = \case From dd17539f980c5f6f014f6b56b7f6a2b15c7286d0 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 13:55:57 -0700 Subject: [PATCH 396/631] Fix diagnostic still reporting when no unused bindings --- lib/unison-prelude/src/Unison/Debug.hs | 2 +- unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs | 8 ++++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/lib/unison-prelude/src/Unison/Debug.hs b/lib/unison-prelude/src/Unison/Debug.hs index 7881045c65..6bbcaa9cac 100644 --- a/lib/unison-prelude/src/Unison/Debug.hs +++ b/lib/unison-prelude/src/Unison/Debug.hs @@ -147,7 +147,7 @@ debugPatternCoverageConstraintSolver = PatternCoverageConstraintSolver `Set.memb debug :: (Show a) => DebugFlag -> String -> a -> a debug flag msg a = if shouldDebug flag - then (pTrace (msg <> ":\n" <> into @String (pShow a)) a) + then (trace (msg <> ":\n" <> into @String (pShow a)) a) else a -- | Use for selective debug logging in monadic contexts. diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs index 859d464d7d..af688aa4df 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -15,6 +15,7 @@ import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Symbol (Symbol (..)) import Unison.Term (Term) +import Unison.Util.Monoid qualified as Monoid import Unison.Util.Range qualified as Range import Unison.Var qualified as Var @@ -34,14 +35,17 @@ analyseTerm fileUri topLevelTermAnn tm = Nothing -> [] Just lspRange -> let bindings = Text.intercalate ", " (tShow <$> vars) - in [Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning ("Unused binding(s) " <> bindings <> " inside this term.\nUse the binding, or prefix it with an _ to dismiss this warning.") []] + in Monoid.whenM (not $ null vars) [Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning ("Unused binding(s) " <> bindings <> " inside this term.\nUse the binding(s), or prefix them with an _ to dismiss this warning.") []] where getRelevantVarName :: Symbol -> Maybe Text getRelevantVarName = \case + -- Sometimes 'do' gets a binding of '()', which we don't care about + Symbol _ (Var.User "()") -> Nothing + Symbol _ (Var.User "") -> Nothing -- We only care about user bindings which don't start with an underscore Symbol _ (Var.User n) -> do guard (not (Text.isPrefixOf "_" n)) - pure n + Just n _ -> Nothing alg :: (Foldable f, Ord v) => Ann -> ABT f v (Map v Ann, Set v) -> (Map v Ann, Set v) alg ann abt = case abt of From dd81f0aa95e4f2c526c7598dfdea7a3a3cf4bcef Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 16:55:07 -0700 Subject: [PATCH 397/631] disable names.global transcript for now --- unison-src/transcripts/names.md | 4 +- unison-src/transcripts/names.output.md | 83 +++++++++++--------------- 2 files changed, 38 insertions(+), 49 deletions(-) diff --git a/unison-src/transcripts/names.md b/unison-src/transcripts/names.md index 0e38b9f75c..492e32353f 100644 --- a/unison-src/transcripts/names.md +++ b/unison-src/transcripts/names.md @@ -35,7 +35,9 @@ scratch/main> names .some.place.x `names.global` searches from the root, and absolutely qualifies results -```ucm +TODO: swap this back to a 'ucm' block when names.global is re-implemented + +``` -- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. scratch/other> names.global x -- We can search by hash, and see all aliases of that hash in the codebase diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index f283ee9210..498cab0a28 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -2,8 +2,10 @@ ```ucm scratch/main> builtins.merge lib.builtins -``` + Done. + +``` Example uses of the `names` command and output ```unison @@ -23,89 +25,74 @@ somewhere.y = 2 I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: - - some.otherplace.x : ##Nat - some.otherplace.y : ##Nat - some.place.x : ##Nat - somewhere.y : ##Nat - somewhere.z : ##Nat + + some.otherplace.x : Nat + some.otherplace.y : Nat + some.place.x : Nat + somewhere.y : Nat + somewhere.z : Nat ``` ```ucm scratch/main> add ⍟ I've added these definitions: - - some.otherplace.x : ##Nat - some.otherplace.y : ##Nat - some.place.x : ##Nat - somewhere.y : ##Nat - somewhere.z : ##Nat + + some.otherplace.x : Nat + some.otherplace.y : Nat + some.place.x : Nat + somewhere.y : Nat + somewhere.z : Nat ``` `names` searches relative to the current path. ```ucm -- We can search by suffix and find all definitions named 'x', and each of their aliases respectively. --- But we don't see somewhere.z which is has the same value but is out of our namespace -.some> names x +scratch/main> names x Terms Hash: #gjmq673r1v - Names: otherplace.y place.x - + Names: some.otherplace.y some.place.x somewhere.z + Hash: #pi25gcdv0o - Names: otherplace.x - + Names: some.otherplace.x + Tip: Use `names.global` to see more results. -- We can search by hash, and see all aliases of that hash -.some> names #gjmq673r1v +scratch/main> names #gjmq673r1v Term Hash: #gjmq673r1v - Names: otherplace.y place.x - + Names: some.otherplace.y some.place.x somewhere.z + Tip: Use `names.global` to see more results. --- If the query is absolute, treat it as a `names.global` -.some> names .some.place.x +-- Works with global names too +scratch/main> names .some.place.x Term Hash: #gjmq673r1v - Names: .some.otherplace.y .some.place.x .somewhere.z - + Names: some.otherplace.y some.place.x somewhere.z + Tip: Use `names.global` to see more results. ``` `names.global` searches from the root, and absolutely qualifies results -```ucm --- We can search by suffix and find all definitions in the codebase named 'x', and each of their aliases respectively. -.some> names.global x - - Terms - Hash: #gjmq673r1v - Names: .some.otherplace.y .some.place.x .somewhere.z - - Hash: #pi25gcdv0o - Names: .some.otherplace.x +TODO: swap this back to a 'ucm' block when names.global is re-implemented +``` +-- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. +scratch/other> names.global x -- We can search by hash, and see all aliases of that hash in the codebase -.some> names.global #gjmq673r1v - - Term - Hash: #gjmq673r1v - Names: .some.otherplace.y .some.place.x .somewhere.z - +scratch/other> names.global #gjmq673r1v -- We can search using an absolute name -.some> names.global .some.place.x - - Term - Hash: #gjmq673r1v - Names: .some.otherplace.y .some.place.x .somewhere.z +scratch/other> names.global .some.place.x ``` + From 4c89423ef1806e0e5286d6a9f0a9940ca15ccf9c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 16:55:07 -0700 Subject: [PATCH 398/631] Rerun transcripts --- unison-src/transcripts/alias-many.output.md | 3 +- .../transcripts/debug-name-diffs.output.md | 3 +- unison-src/transcripts/delete.output.md | 42 ++++++++++------ unison-src/transcripts/diff-namespace.md | 2 +- .../transcripts/diff-namespace.output.md | 13 ++--- unison-src/transcripts/help.output.md | 17 +++++-- .../transcripts/move-namespace.output.md | 6 ++- unison-src/transcripts/todo.output.md | 48 +++++++++++++++++-- 8 files changed, 98 insertions(+), 36 deletions(-) diff --git a/unison-src/transcripts/alias-many.output.md b/unison-src/transcripts/alias-many.output.md index b12422e093..05fe8e7f1f 100644 --- a/unison-src/transcripts/alias-many.output.md +++ b/unison-src/transcripts/alias-many.output.md @@ -40,7 +40,8 @@ scratch/main> alias.many List.adjacentPairs List.all List.any List.chunk List.ch 14. List.tail : [a] -> Optional [a] 15. List.takeWhile : (a ->{𝕖} Boolean) -> [a] ->{𝕖} [a] - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. scratch/main> find-in mylib diff --git a/unison-src/transcripts/debug-name-diffs.output.md b/unison-src/transcripts/debug-name-diffs.output.md index 9d15bfe476..1c5f77f17a 100644 --- a/unison-src/transcripts/debug-name-diffs.output.md +++ b/unison-src/transcripts/debug-name-diffs.output.md @@ -45,7 +45,8 @@ scratch/main> delete.term.verbose a.b.one 1. a.b.one : ##Nat - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. scratch/main> alias.term a.two a.newtwo diff --git a/unison-src/transcripts/delete.output.md b/unison-src/transcripts/delete.output.md index 46414513b2..02518fe8cf 100644 --- a/unison-src/transcripts/delete.output.md +++ b/unison-src/transcripts/delete.output.md @@ -36,7 +36,8 @@ scratch/main> delete.verbose foo 1. foo : Nat - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. scratch/main> delete.verbose Foo @@ -44,7 +45,8 @@ scratch/main> delete.verbose Foo 1. structural type Foo - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. scratch/main> delete.verbose Foo.Foo @@ -52,7 +54,8 @@ scratch/main> delete.verbose Foo.Foo 1. Foo.Foo : '#089vmor9c5 - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` How about an ambiguous term? @@ -90,7 +93,8 @@ scratch/main> delete.verbose a.foo 2. a.bar ┐ 3. a.foo#dcgdua2lj6 (removed) 4. a.foo#dcgdua2lj6 ┘ - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. scratch/main> ls a @@ -130,7 +134,8 @@ scratch/main> delete.verbose a.Foo 4. lib.builtins.Unit │ 5. a.Foo#00nv2kob8f ┘ - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. scratch/main> delete.verbose a.Foo.Foo @@ -138,7 +143,8 @@ scratch/main> delete.verbose a.Foo.Foo 1. a.Foo.Foo : '#089vmor9c5 - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` Finally, let's try to delete a term and a type with the same name. @@ -163,7 +169,8 @@ scratch/main> delete.verbose foo 1. structural type foo 2. foo : Nat - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` We want to be able to delete multiple terms at once @@ -191,7 +198,8 @@ scratch/main> delete.verbose a b c 2. b : Text 3. c : Text - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` We can delete terms and types in the same invocation of delete @@ -222,7 +230,8 @@ scratch/main> delete.verbose a b c Foo 3. b : Text 4. c : Text - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. scratch/main> delete.verbose Foo.Foo @@ -232,7 +241,8 @@ scratch/main> delete.verbose Foo.Foo 1. Foo.Foo ┐ 2. Foo.Foo (removed) 3. foo.Foo ┘ - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` We can delete a type and its constructors @@ -260,7 +270,8 @@ scratch/main> delete.verbose Foo Foo.Foo 2. Foo.Foo ┐ 3. Foo.Foo (removed) 4. foo.Foo ┘ - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` You should not be able to delete terms which are referenced by other terms @@ -324,7 +335,8 @@ scratch/main> delete.verbose e f g h 3. g : Nat 4. h : Nat - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` You should be able to delete a type and all the functions that reference it in a single command @@ -353,7 +365,8 @@ scratch/main> delete.verbose Foo Foo.Foo incrementFoo 2. Foo.Foo : Nat -> #68k40ra7l7 3. incrementFoo : #68k40ra7l7 -> Nat - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. ``` If you mess up on one of the names of your command, delete short circuits @@ -404,7 +417,8 @@ scratch/main> delete.verbose ping 1. ping : 'Nat - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. scratch/main> view pong diff --git a/unison-src/transcripts/diff-namespace.md b/unison-src/transcripts/diff-namespace.md index 4352835ed6..ecb0b129d0 100644 --- a/unison-src/transcripts/diff-namespace.md +++ b/unison-src/transcripts/diff-namespace.md @@ -64,7 +64,7 @@ scratch/main> diff.namespace .nothing /ns1: ``` ```ucm:error -scratch/main> diff.namespace /ns1: ns2: +scratch/main> diff.namespace /ns1: /ns2: ``` ```unison:hide diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md index b45d8574eb..4cfe5a19e8 100644 --- a/unison-src/transcripts/diff-namespace.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -112,15 +112,9 @@ scratch/main> diff.namespace .nothing /ns1: ``` ```ucm -scratch/main> diff.namespace /ns1: ns2: - -:1:4: - | -1 | ns2: - | ^ -unexpected ':' -expecting '/' or end of input +scratch/main> diff.namespace /ns1: /ns2: + The namespaces are identical. ``` ```unison @@ -274,7 +268,8 @@ scratch/ns2> delete.term.verbose fromJust' 3. fromJust' │ 4. yoohoo ┘ - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. scratch/main> diff.namespace /ns3: /ns2: diff --git a/unison-src/transcripts/help.output.md b/unison-src/transcripts/help.output.md index 27a6d74897..a2d216cb03 100644 --- a/unison-src/transcripts/help.output.md +++ b/unison-src/transcripts/help.output.md @@ -40,12 +40,14 @@ scratch/main> help branch `foo` `branch /bar foo` forks the branch `bar` of the current project to a new branch `foo` - `branch .bar foo` forks the path `.bar` of the current - project to a new branch `foo` branch.empty (or branch.create-empty, create.empty-branch) Create a new empty branch. + branch.reflog (or reflog.branch, reflog) + `branch.reflog` lists all the changes that have affected the current branch. + `branch.reflog /mybranch` lists all the changes that have affected /mybranch. + branch.rename (or rename.branch) `branch.rename foo` renames the current branch to `foo` @@ -178,6 +180,9 @@ scratch/main> help that `fzf` can be found within your PATH. + deprecated.root-reflog + `deprecated.root-reflog` lists the changes that have affected the root namespace. This has been deprecated in favor of `branch.reflog` which shows the reflog for the current project. + diff.namespace `diff.namespace before after` shows how the namespace `after` differs from the namespace @@ -538,6 +543,10 @@ scratch/main> help `project.create` creates a project with a random name `project.create foo` creates a project named `foo` + project.reflog (or reflog.project) + `project.reflog` lists all the changes that have affected any branches in the current project. + `project.reflog myproject` lists all the changes that have affected any branches in myproject. + project.rename (or rename.project) `project.rename foo` renames the current project to `foo` @@ -666,8 +675,8 @@ scratch/main> help quit (or exit, :q) Exits the Unison command line interface. - reflog - `reflog` lists the changes that have affected the root namespace + reflog.global + `reflog.global` lists all recent changes across all projects and branches. release.draft (or draft.release) Draft a release. diff --git a/unison-src/transcripts/move-namespace.output.md b/unison-src/transcripts/move-namespace.output.md index 3ac591c420..b5bc79e03b 100644 --- a/unison-src/transcripts/move-namespace.output.md +++ b/unison-src/transcripts/move-namespace.output.md @@ -59,7 +59,8 @@ scratch/main> move.namespace .root.at.path . A branch existed at the destination: . so I over-wrote it. - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. Done. @@ -350,7 +351,8 @@ scratch/existing> move.namespace a b A branch existed at the destination: b so I over-wrote it. - Tip: You can use `undo` or `reflog` to undo this change. + Tip: You can use `undo` or use a hash from `branch.reflog` to + undo this change. Done. diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index a60c216ee5..cfad74ec15 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -31,8 +31,48 @@ bar = foo + foo I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: + + ⍟ These new definitions are ok to `add`: + + bar : Nat + foo : Nat + +``` +```ucm +project/main> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat +project/main> todo + + These terms call `todo`: + + 1. foo + +``` +# Direct dependencies without names + +The `todo` command shows hashes of direct dependencies of local (outside `lib`) definitions that don't have names in +the current namespace. + +```unison +foo.bar = 15 +baz = foo.bar + foo.bar +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + ⍟ These new definitions are ok to `add`: + baz : Nat foo.bar : Nat @@ -41,7 +81,7 @@ bar = foo + foo project/main> add ⍟ I've added these definitions: - + baz : Nat foo.bar : Nat @@ -50,17 +90,17 @@ project/main> delete.namespace.force foo Done. ⚠️ - + Of the things I deleted, the following are still used in the following definitions. They now contain un-named references. - + Dependency Referenced In bar 1. baz project/main> todo These terms do not have any names in the current namespace: - + 1. #1jujb8oelv ``` From d0002b45c9a7bbd6cbed73e11189bda8364a1fb4 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 16:55:07 -0700 Subject: [PATCH 399/631] Disable view.global transcript for now --- unison-src/transcripts/view.md | 10 ++++++++-- unison-src/transcripts/view.output.md | 28 ++++++++++----------------- 2 files changed, 18 insertions(+), 20 deletions(-) diff --git a/unison-src/transcripts/view.md b/unison-src/transcripts/view.md index ac8f42a915..f281cf3eca 100644 --- a/unison-src/transcripts/view.md +++ b/unison-src/transcripts/view.md @@ -16,10 +16,16 @@ scratch/main> add ```ucm -- Should suffix-search and find values in sub-namespaces scratch/main> view thing --- view.global should search globally and be absolutely qualified -scratch/other> view.global thing -- Should support absolute paths scratch/main> view .b.thing +``` + + +TODO: swap this back to a 'ucm' block when view.global is re-implemented + +``` +-- view.global should search globally and be absolutely qualified +scratch/other> view.global thing -- Should support branch relative paths scratch/other> view /main:.a.thing ``` diff --git a/unison-src/transcripts/view.output.md b/unison-src/transcripts/view.output.md index 8c40abf628..1e478e4d4f 100644 --- a/unison-src/transcripts/view.output.md +++ b/unison-src/transcripts/view.output.md @@ -15,28 +15,20 @@ scratch/main> view thing b.thing : Text b.thing = "b" --- view.global should search globally and be absolutely qualified -scratch/other> view.global thing +-- Should support absolute paths +scratch/main> view .b.thing - ⚠️ - - The following names were not found in the codebase. Check your spelling. - thing + .b.thing : Text + .b.thing = "b" ``` +TODO: swap this back to a 'ucm' block when view.global is re-implemented -```ucm --- Should suffix-search and find values in sub-namespacesscratch/main> view thing-- view.global should search globally and be absolutely qualifiedscratch/other> view.global thing-- Should support absolute pathsscratch/main> view .b.thing-- Should support branch relative pathsscratch/other> view /main:.a.thing ``` +-- view.global should search globally and be absolutely qualified +scratch/other> view.global thing +-- Should support branch relative paths +scratch/other> view /main:.a.thing - -🛑 - -The transcript failed due to an error in the stanza above. The error is: - - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - thing +``` From 424b43b897c99167246d528382c35cd38c7e5189 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 16:55:07 -0700 Subject: [PATCH 400/631] Fix up reset transcripts for projects --- .../src/Unison/Codebase/Editor/HandleInput.hs | 21 +-- .../src/Unison/Codebase/Editor/Input.hs | 6 +- .../src/Unison/CommandLine/InputPatterns.hs | 4 +- unison-src/transcripts/reset.md | 67 +++---- unison-src/transcripts/reset.output.md | 166 +++++++++++++----- 5 files changed, 164 insertions(+), 100 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 1361c13ad6..1533096d38 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -251,13 +251,7 @@ loop e = do ShowProjectReflogI mayProj -> do Reflogs.showProjectReflog mayProj ResetI newRoot mtarget -> do - newRoot <- - case newRoot of - BranchAtPath p -> do - pp <- Cli.resolvePath' p - Cli.getBranchFromProjectPath pp - BranchAtSCH sch -> Cli.resolveShortCausalHash sch - BranchAtProjectPath pp -> Cli.getBranchFromProjectPath pp + newRoot <- resolveBranchId2 newRoot target <- case mtarget of Nothing -> Cli.getCurrentProjectPath @@ -902,11 +896,8 @@ inputDescription input = Branch.RegularMerge -> "merge" Branch.SquashMerge -> "merge.squash" pure (command <> " " <> src <> " " <> dest) - ResetI hash tgt -> do - hashTxt <- case hash of - BranchAtSCH hash -> hp' $ Left hash - BranchAtPath pr -> pure $ into @Text pr - BranchAtProjectPath pp -> pure $ into @Text pp + ResetI newRoot tgt -> do + hashTxt <- bid2 newRoot tgt <- case tgt of Nothing -> pure "" Just tgt -> do @@ -1074,8 +1065,6 @@ inputDescription input = UpgradeCommitI {} -> wat VersionI -> wat where - hp' :: Either SCH.ShortCausalHash Path' -> Cli Text - hp' = either (pure . into @Text) p' p :: Path -> Cli Text p = fmap (into @Text) . Cli.resolvePath p' :: Path' -> Cli Text @@ -1096,6 +1085,10 @@ inputDescription input = hqs (p, hq) = hqs' (Path' . Right . Path.Relative $ p, hq) ps' = p' . Path.unsplit' ps = p . Path.unsplit + bid2 :: BranchId2 -> Cli Text + bid2 = \case + Left sch -> pure $ into @Text sch + Right p -> brp p handleFindI :: Bool -> diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 262b759081..0dfc2b034d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -126,9 +126,9 @@ data Input | PullI !PullSourceTarget !PullMode | PushRemoteBranchI PushRemoteBranchInput | ResetRootI BranchId - | ResetI BranchId (Maybe UnresolvedProjectBranch) - | -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? - -- Does it make sense to fork from not-the-root of a Github repo? + | ResetI (BranchId2 {- namespace to reset it to -}) (Maybe UnresolvedProjectBranch {- ProjectBranch to reset -}) + -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? + | -- Does it make sense to fork from not-the-root of a Github repo? -- used in Welcome module to give directions to user CreateMessage (P.Pretty P.ColorText) | -- Change directory. diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 6032f2efbd..c03b899dd3 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1663,8 +1663,8 @@ reset = ] ) \case - [arg0] -> Input.ResetI <$> handleBranchIdArg arg0 <*> pure Nothing - [arg0, arg1] -> Input.ResetI <$> handleBranchIdArg arg0 <*> fmap pure (handleMaybeProjectBranchArg arg1) + [resetTo] -> Input.ResetI <$> handleBranchId2Arg resetTo <*> pure Nothing + [resetTo, branchToReset] -> Input.ResetI <$> handleBranchId2Arg resetTo <*> fmap pure (handleMaybeProjectBranchArg branchToReset) args -> wrongArgsLength "one or two arguments" args where config = diff --git a/unison-src/transcripts/reset.md b/unison-src/transcripts/reset.md index f8d18e7822..2cd19597de 100644 --- a/unison-src/transcripts/reset.md +++ b/unison-src/transcripts/reset.md @@ -2,28 +2,36 @@ scratch/main> builtins.merge ``` -# reset loose code ```unison -a = 5 +def = "first value" +``` + +```ucm:hide +scratch/main> update ``` +```unison:hide +def = "second value" +``` + +Can reset to a value from history by number. + ```ucm -scratch/main> add +scratch/main> update scratch/main> history scratch/main> reset 2 +scratch/main> view def scratch/main> history ``` -```unison -foo.a = 5 -``` +Can reset to a value from reflog by number. ```ucm -scratch/main> add -scratch/main> ls foo +scratch/main> reflog +-- Reset the current branch to the first history element +scratch/main> reset 2 +scratch/main> view def scratch/main> history -scratch/main> reset 1 foo -scratch/main> ls foo.foo ``` # reset branch @@ -32,47 +40,24 @@ scratch/main> ls foo.foo foo/main> history ``` -```unison +```unison:hide a = 5 ``` -```ucm -foo/main> add -foo/main> branch topic -foo/main> history -``` - -```unison -a = 3 -``` - ```ucm foo/main> update -foo/main> reset /topic -foo/main> history +foo/empty> reset /main:. +foo/empty> view a +foo/empty> history ``` -# ambiguous reset - -## ambiguous target -```unison +## second argument is always interpreted as a branch +```unison:hide main.a = 3 ``` -```ucm:error -foo/main> add +```ucm +foo/main> update foo/main> history foo/main> reset 2 main ``` - -## ambiguous hash - -```unison -main.a = 3 -``` - -```ucm:error -foo/main> switch /topic -foo/topic> add -foo/topic> reset main -``` diff --git a/unison-src/transcripts/reset.output.md b/unison-src/transcripts/reset.output.md index ea8f1b645f..7cfac62e4e 100644 --- a/unison-src/transcripts/reset.output.md +++ b/unison-src/transcripts/reset.output.md @@ -1,6 +1,5 @@ -# reset loose code ```unison -a = 5 +def = "first value" ``` ```ucm @@ -13,99 +12,186 @@ a = 5 ⍟ These new definitions are ok to `add`: - a : Nat + def : Text ``` +```unison +def = "second value" +``` + +Can reset to a value from history by number. + ```ucm -scratch/main> add +scratch/main> update - ⍟ I've added these definitions: - - a : Nat + Okay, I'm searching the branch for code that needs to be + updated... + + Done. scratch/main> history Note: The most recent namespace hash is immediately below this message. - ⊙ 1. #d079vet1oj + ⊙ 1. #5vq851j3hg + Adds / updates: - a + def - □ 2. #4bigcpnl7t (start of history) + ⊙ 2. #ujvq6e87kp + + + Adds / updates: + + def + + □ 3. #4bigcpnl7t (start of history) scratch/main> reset 2 Done. +scratch/main> view def + + def : Text + def = "first value" + scratch/main> history Note: The most recent namespace hash is immediately below this message. + ⊙ 1. #ujvq6e87kp + + Adds / updates: + + def - □ 1. #4bigcpnl7t (start of history) + □ 2. #4bigcpnl7t (start of history) ``` -```unison -foo.a = 5 -``` +Can reset to a value from reflog by number. ```ucm +scratch/main> reflog - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: + Below is a record of recent changes, you can use + `reset #abcdef` to reset the current branch to a previous + state. - ⍟ These new definitions are ok to `add`: - - foo.a : Nat - -``` -```ucm -scratch/main> add - - ⍟ I've added these definitions: + Tip: Use `diff.namespace 1 7` to compare between points in + history. - foo.a : Nat + Branch When Hash Description + 1. scratch/main now #ujvq6e87kp reset ujvq6e87kp4288eq3al9v5luctic0ocd7ug1fu0go5bicrr2vfnrb0... + 2. scratch/main now #5vq851j3hg update + 3. scratch/main now #ujvq6e87kp update + 4. scratch/main now #4bigcpnl7t builtins.merge + 5. scratch/main now #sg60bvjo91 Project Created + +-- Reset the current branch to the first history element +scratch/main> reset 2 + + Done. -scratch/main> ls foo +scratch/main> view def - 1. a (Nat) + def : Text + def = "second value" scratch/main> history Note: The most recent namespace hash is immediately below this message. - ⊙ 1. #tfg7r9359n + ⊙ 1. #5vq851j3hg + Adds / updates: - foo.a + def - □ 2. #4bigcpnl7t (start of history) + ⊙ 2. #ujvq6e87kp + + + Adds / updates: + + def + + □ 3. #4bigcpnl7t (start of history) -scratch/main> reset 1 foo +``` +# reset branch - scratch/foo does not exist. +```ucm +foo/main> history + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) ``` +```unison +a = 5 +``` ```ucm -scratch/main> addscratch/main> ls fooscratch/main> historyscratch/main> reset 1 fooscratch/main> ls foo.foo +foo/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +foo/empty> reset /main:. + + Done. + +foo/empty> view a + + a : ##Nat + a = 5 + +foo/empty> history + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #5l94rduvel (start of history) + ``` +## second argument is always interpreted as a branch +```unison +main.a = 3 +``` + +```ucm +foo/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + Done. -🛑 +foo/main> history -The transcript failed due to an error in the stanza above. The error is: + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #0i64kpfccl + + + Adds / updates: + + main.a + + □ 2. #5l94rduvel (start of history) +foo/main> reset 2 main - scratch/foo does not exist. + Done. +``` From 6021a3a2e76585a12fc6303cf89bad35e1842af5 Mon Sep 17 00:00:00 2001 From: ChrisPenner Date: Sat, 6 Jul 2024 00:37:59 +0000 Subject: [PATCH 401/631] automatically run ormolu --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index c03b899dd3..bd8f9321e9 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -254,7 +254,7 @@ formatStructuredArgument schLength = \case BranchAtProjectPath pp -> pp & PP.absPath_ - %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) + %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) & PP.toNames & into @Text @@ -501,7 +501,7 @@ handleBranchIdArg = BranchAtProjectPath pp -> pp & PP.absPath_ - %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) + %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) & BranchAtProjectPath SA.Namespace hash -> pure . BranchAtSCH $ SCH.fromFullHash hash otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg From 927b76bd59572ba3cf3b6d29dd865cf33a5cb783 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 17:41:38 -0700 Subject: [PATCH 402/631] Get tests building again. --- unison-cli/tests/Unison/Test/ClearCache.hs | 4 ++-- unison-cli/tests/Unison/Test/Cli/Monad.hs | 9 ++++----- unison-cli/tests/Unison/Test/UriParser.hs | 23 ++++------------------ 3 files changed, 10 insertions(+), 26 deletions(-) diff --git a/unison-cli/tests/Unison/Test/ClearCache.hs b/unison-cli/tests/Unison/Test/ClearCache.hs index 655bd6d91a..20f5090f2f 100644 --- a/unison-cli/tests/Unison/Test/ClearCache.hs +++ b/unison-cli/tests/Unison/Test/ClearCache.hs @@ -23,7 +23,7 @@ test = scope "clearWatchCache" $ c [i| ```ucm - .> alias.term ##Nat.+ + + scratch/main> alias.term ##Nat.+ + ``` ```unison > 1 + 1 @@ -38,7 +38,7 @@ test = scope "clearWatchCache" $ c [i| ```ucm - .> debug.clear-cache + scratch/main> debug.clear-cache ``` |] diff --git a/unison-cli/tests/Unison/Test/Cli/Monad.hs b/unison-cli/tests/Unison/Test/Cli/Monad.hs index 712b6c083b..7aa02dd69b 100644 --- a/unison-cli/tests/Unison/Test/Cli/Monad.hs +++ b/unison-cli/tests/Unison/Test/Cli/Monad.hs @@ -36,12 +36,11 @@ dummyEnv = undefined dummyLoopState :: Cli.LoopState dummyLoopState = Cli.LoopState - { currentPathStack = undefined, - lastInput = Nothing, - lastRunResult = Nothing, - lastSavedRootHash = undefined, + { currentProjectRoot = undefined, + projectPathStack = undefined, latestFile = Nothing, latestTypecheckedFile = Nothing, + lastInput = Nothing, numberedArgs = [], - root = undefined + lastRunResult = Nothing } diff --git a/unison-cli/tests/Unison/Test/UriParser.hs b/unison-cli/tests/Unison/Test/UriParser.hs index 1a896f4bae..4c64958f0e 100644 --- a/unison-cli/tests/Unison/Test/UriParser.hs +++ b/unison-cli/tests/Unison/Test/UriParser.hs @@ -8,11 +8,6 @@ import EasyTest import Text.Megaparsec qualified as P import Unison.Codebase.Editor.RemoteRepo ( ReadRemoteNamespace (..), - ShareCodeserver (..), - ShareUserHandle (..), - WriteRemoteNamespace (..), - WriteShareRemoteNamespace (..), - pattern ReadShareLooseCode, ) import Unison.Codebase.Editor.UriParser qualified as UriParser import Unison.Codebase.Path qualified as Path @@ -27,8 +22,7 @@ test = [ parserTests "repoPath" (UriParser.readRemoteNamespaceParser ProjectBranchSpecifier'Name <* P.eof) - [ ("unisonweb.base._releases.M4", looseR "unisonweb" ["base", "_releases", "M4"]), - ("project", branchR (This "project")), + [ ("project", branchR (This "project")), ("/branch", branchR (That "branch")), ("project/branch", branchR (These "project" "branch")) ] @@ -36,8 +30,7 @@ test = parserTests "writeRemoteNamespace" (UriParser.writeRemoteNamespace <* P.eof) - [ ("unisonweb.base._releases.M4", looseW "unisonweb" ["base", "_releases", "M4"]), - ("project", branchW (This "project")), + [ ("project", branchW (This "project")), ("/branch", branchW (That "branch")), ("project/branch", branchW (These "project" "branch")) ] @@ -48,14 +41,6 @@ test = mkPath :: [Text] -> Path.Path mkPath = Path.fromList . fmap NameSegment -looseR :: Text -> [Text] -> ReadRemoteNamespace void -looseR user path = - ReadShare'LooseCode (ReadShareLooseCode DefaultCodeserver (ShareUserHandle user) (mkPath path)) - -looseW :: Text -> [Text] -> WriteRemoteNamespace void -looseW user path = - WriteRemoteNamespaceShare (WriteShareRemoteNamespace DefaultCodeserver (ShareUserHandle user) (mkPath path)) - branchR :: These Text Text -> ReadRemoteNamespace (These ProjectName ProjectBranchName) branchR = ReadShare'ProjectBranch . \case @@ -63,9 +48,9 @@ branchR = That branch -> That (UnsafeProjectBranchName branch) These project branch -> These (UnsafeProjectName project) (UnsafeProjectBranchName branch) -branchW :: These Text Text -> WriteRemoteNamespace (These ProjectName ProjectBranchName) +branchW :: These Text Text -> (These ProjectName ProjectBranchName) branchW = - WriteRemoteProjectBranch . \case + \case This project -> This (UnsafeProjectName project) That branch -> That (UnsafeProjectBranchName branch) These project branch -> These (UnsafeProjectName project) (UnsafeProjectBranchName branch) From c431d350d27418c08902ba6ebee10c5a904ad582 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 18:02:05 -0700 Subject: [PATCH 403/631] Fix integration-tests --- .gitignore | 1 + .../IntegrationTests/transcript.md | 17 ++++++----------- .../IntegrationTests/transcript.output.md | 6 +++--- 3 files changed, 10 insertions(+), 14 deletions(-) diff --git a/.gitignore b/.gitignore index 1c9b75d999..3b9fce4920 100644 --- a/.gitignore +++ b/.gitignore @@ -3,6 +3,7 @@ test-output scratch.u unisonLocal.zip +*.uc # Auto-generated jit-tests.md diff --git a/unison-cli-integration/integration-tests/IntegrationTests/transcript.md b/unison-cli-integration/integration-tests/IntegrationTests/transcript.md index c8b10ea268..2db0994f0e 100644 --- a/unison-cli-integration/integration-tests/IntegrationTests/transcript.md +++ b/unison-cli-integration/integration-tests/IntegrationTests/transcript.md @@ -1,18 +1,13 @@ # Integration test: transcript ```ucm:hide -.> builtins.mergeio -.> load ./unison-src/transcripts-using-base/base.u -``` - -```ucm:hide -.> builtins.mergeio -.> load ./unison-src/transcripts-using-base/base.u -.> add +scratch/main> builtins.mergeio lib.builtins +scratch/main> load ./unison-src/transcripts-using-base/base.u +scratch/main> add ``` ```unison -use .builtin +use lib.builtins unique type MyBool = MyTrue | MyFalse @@ -39,6 +34,6 @@ main = do ``` ```ucm -.> add -.> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main +scratch/main> add +scratch/main> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main ``` diff --git a/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md index c74133f4ba..fa29d77287 100644 --- a/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md +++ b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md @@ -1,7 +1,7 @@ # Integration test: transcript ```unison -use .builtin +use lib.builtins unique type MyBool = MyTrue | MyFalse @@ -44,7 +44,7 @@ main = do ``` ```ucm -.> add +scratch/main> add ⍟ I've added these definitions: @@ -53,6 +53,6 @@ main = do main : '{IO, Exception} () resume : Request {g, Break} x -> x -.> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main +scratch/main> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main ``` From 69edceffdf5bbc917a448ea22e5d153f47f93e6a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 18:02:05 -0700 Subject: [PATCH 404/631] Fix up round-trip tests --- unison-src/transcripts-round-trip/main.md | 62 ++++++++----------- .../transcripts-round-trip/main.output.md | 39 +++++++++--- 2 files changed, 59 insertions(+), 42 deletions(-) diff --git a/unison-src/transcripts-round-trip/main.md b/unison-src/transcripts-round-trip/main.md index 7287a7ddba..3ce811c295 100644 --- a/unison-src/transcripts-round-trip/main.md +++ b/unison-src/transcripts-round-trip/main.md @@ -1,14 +1,13 @@ This transcript verifies that the pretty-printer produces code that can be successfully parsed, for a variety of examples. Terms or types that fail to round-trip can be added to either `reparses-with-same-hash.u` or `reparses.u` as regression tests. ```ucm:hide -.> builtins.mergeio +scratch/a1> builtins.mergeio lib.builtins +scratch/a2> builtins.mergeio lib.builtins ``` ```ucm:hide -.> copy.namespace builtin a1.lib.builtin -.> copy.namespace builtin a2.lib.builtin -.> load unison-src/transcripts-round-trip/reparses-with-same-hash.u -.a1> add +scratch/a1> load unison-src/transcripts-round-trip/reparses-with-same-hash.u +scratch/a1> add ``` ```unison @@ -16,45 +15,40 @@ x = () ``` ```ucm:hide -.a1> find +scratch/a1> find ``` So we can see the pretty-printed output: ```ucm -.a1> edit 1-1000 +scratch/a1> edit 1-1000 ``` ```ucm:hide -.a1> delete.namespace.force lib.builtin +scratch/a1> delete.namespace.force lib.builtins ``` ```ucm:hide -.a2> load +scratch/a2> load ``` ```ucm:hide -.a2> add -.a2> delete.namespace.force lib.builtin +scratch/a2> add +scratch/a2> delete.namespace.force lib.builtins ``` This diff should be empty if the two namespaces are equivalent. If it's nonempty, the diff will show us the hashes that differ. ```ucm:error -.> diff.namespace a1 a2 -``` - -```ucm:hide -.> undo -.> undo +scratch/main> diff.namespace /a1:. /a2:. ``` Now check that definitions in 'reparses.u' at least parse on round trip: ```ucm:hide -.a3> copy.namespace .builtin lib.builtin -.a3> load unison-src/transcripts-round-trip/reparses.u -.a3> add +scratch/a3> builtins.mergeio lib.builtins +scratch/a3> load unison-src/transcripts-round-trip/reparses.u +scratch/a3> add ``` This just makes 'roundtrip.u' the latest scratch file. @@ -64,37 +58,35 @@ x = () ``` ```ucm:hide -.a3> find +scratch/a3> find ``` ```ucm -.a3> edit 1-5000 +scratch/a3> edit 1-5000 ``` ```ucm:hide -.> move.namespace a3 a3_old -.a3> copy.namespace .builtin lib.builtin -.a3> load -.a3> add -.a3> delete.namespace.force lib.builtin -.a3_old> delete.namespace.force lib.builtin +scratch/a3_new> builtins.mergeio lib.builtins +scratch/a3_new> load +scratch/a3_new> add +scratch/a3> delete.namespace.force lib.builtins +scratch/a3_new> delete.namespace.force lib.builtins ``` These are currently all expected to have different hashes on round trip. ```ucm -.> diff.namespace a3 a3_old +scratch/main> diff.namespace /a3_new:. /a3:. ``` ## Other regression tests not covered by above -### Comment out builtins in the edit command +### Builtins should appear commended out in the edit command Regression test for https://github.com/unisonweb/unison/pull/3548 -```ucm:hide -.> alias.term ##Nat.+ plus -.> edit plus -.> load -.> undo +```ucm +scratch/regressions> alias.term ##Nat.+ plus +scratch/regressions> edit plus +scratch/regressions> load ``` diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index 2ece57588c..7f8c0067d1 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -20,7 +20,7 @@ x = () So we can see the pretty-printed output: ```ucm -.a1> edit 1-1000 +scratch/a1> edit 1-1000 ☝️ @@ -771,7 +771,7 @@ a |> f = f a This diff should be empty if the two namespaces are equivalent. If it's nonempty, the diff will show us the hashes that differ. ```ucm -.> diff.namespace a1 a2 +scratch/main> diff.namespace /a1:. /a2:. The namespaces are identical. @@ -785,7 +785,7 @@ x = () ``` ```ucm -.a3> edit 1-5000 +scratch/a3> edit 1-5000 ☝️ @@ -820,18 +820,43 @@ sloppyDocEval = These are currently all expected to have different hashes on round trip. ```ucm -.> diff.namespace a3 a3_old +scratch/main> diff.namespace /a3_new:. /a3:. Updates: - 1. sloppyDocEval : Doc2 + 1. sloppyDocEval : #ej86si0ur1 ↓ - 2. sloppyDocEval : Doc2 + 2. sloppyDocEval : #ej86si0ur1 ``` ## Other regression tests not covered by above -### Comment out builtins in the edit command +### Builtins should appear commended out in the edit command Regression test for https://github.com/unisonweb/unison/pull/3548 +```ucm +scratch/regressions> alias.term ##Nat.+ plus + + Done. + +scratch/regressions> edit plus + + ☝️ + + I added 1 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. + +scratch/regressions> load + + Loading changes detected in scratch.u. + + I loaded scratch.u and didn't find anything. + +``` +```unison:added-by-ucm scratch.u +-- builtin plus : ##Nat -> ##Nat -> ##Nat +``` + From b14931f7b467ccef59cd0c65b4d4a2fe594ae735 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 6 Jul 2024 14:37:55 -0400 Subject: [PATCH 405/631] avoid numeric vs textual clash in args length error `numerals` doesn't seem to be maintained anymore, however --- stack.yaml | 5 +++++ stack.yaml.lock | 7 +++++++ unison-cli/package.yaml | 1 + unison-cli/src/Unison/CommandLine/InputPatterns.hs | 8 +++++++- unison-cli/unison-cli.cabal | 3 +++ unison-src/transcripts/input-parse-errors.output.md | 2 +- 6 files changed, 24 insertions(+), 2 deletions(-) diff --git a/stack.yaml b/stack.yaml index 477547cab2..ba6491bc91 100644 --- a/stack.yaml +++ b/stack.yaml @@ -64,9 +64,14 @@ extra-deps: - recover-rtti-0.4.2@sha256:c179a303921126d8d782264e14f386c96e54a270df74be002e4c4ec3c8c7aebd,4529 - lsp-2.2.0.0@sha256:82fbf4b69d94d8d22543be71f89986b3e90050032d671fb3de3f8253ea1e5b6f,3550 - lsp-types-2.0.2.0@sha256:a9a51c3cea0726d91fe63fa0670935ee720f7b31bc3f3b33b2483fc538152677,29421 + - numerals-0.4.1@sha256:f138b4a0efbde3b3c6cbccb788eff683cb8a5d046f449729712fd174c5ee8a78,11430 - row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071 - network-udp-0.0.0 +allow-newer: true +allow-newer-deps: + - numerals + ghc-options: # All packages "$locals": -Wall -Werror -Wno-name-shadowing -Wno-missing-pattern-synonym-signatures -fprint-expanded-synonyms -fwrite-ide-info #-freverse-errors diff --git a/stack.yaml.lock b/stack.yaml.lock index 4f98b610bf..52d2861560 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -75,6 +75,13 @@ packages: size: 45527 original: hackage: lsp-types-2.0.2.0@sha256:a9a51c3cea0726d91fe63fa0670935ee720f7b31bc3f3b33b2483fc538152677,29421 +- completed: + hackage: numerals-0.4.1@sha256:f138b4a0efbde3b3c6cbccb788eff683cb8a5d046f449729712fd174c5ee8a78,11430 + pantry-tree: + sha256: c616791b08f1792fd1d4ca03c6d2c773dedb25b24b66454c97864aefd85a5d0a + size: 13751 + original: + hackage: numerals-0.4.1@sha256:f138b4a0efbde3b3c6cbccb788eff683cb8a5d046f449729712fd174c5ee8a78,11430 - completed: hackage: row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071 pantry-tree: diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index 923d0c7ae9..d64ed16ae0 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -54,6 +54,7 @@ dependencies: - network-udp - network-uri - nonempty-containers + - numerals - open-browser - optparse-applicative >= 0.16.1.0 - pretty-simple diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index ae2886e2de..b1a6f1541d 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -152,6 +152,8 @@ import System.Console.Haskeline.Completion (Completion (Completion)) import System.Console.Haskeline.Completion qualified as Haskeline import System.Console.Haskeline.Completion qualified as Line import Text.Megaparsec qualified as Megaparsec +import Text.Numeral (defaultInflection) +import Text.Numeral.Language.ENG qualified as Numeral import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Sqlite.DbId (ProjectBranchId) import U.Codebase.Sqlite.Project qualified as Sqlite @@ -342,7 +344,11 @@ wrongStructuredArgument expected actual = wrongArgsLength :: Text -> [a] -> Either (P.Pretty CT.ColorText) b wrongArgsLength expected args = - Left . P.text $ "I expected " <> expected <> ", but received " <> Text.pack (show $ length args) <> "." + let foundCount = + if null args + then "none" + else fromMaybe (tShow $ length args) $ Numeral.us_cardinal defaultInflection (length args) + in Left . P.text $ "I expected " <> expected <> ", but received " <> foundCount <> "." patternName :: InputPattern -> P.Pretty P.ColorText patternName = fromString . I.patternName diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 1382e183a6..97441927c7 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -230,6 +230,7 @@ library , network-udp , network-uri , nonempty-containers + , numerals , open-browser , optparse-applicative >=0.16.1.0 , pretty-simple @@ -371,6 +372,7 @@ executable transcripts , network-udp , network-uri , nonempty-containers + , numerals , open-browser , optparse-applicative >=0.16.1.0 , pretty-simple @@ -519,6 +521,7 @@ test-suite cli-tests , network-udp , network-uri , nonempty-containers + , numerals , open-browser , optparse-applicative >=0.16.1.0 , pretty-simple diff --git a/unison-src/transcripts/input-parse-errors.output.md b/unison-src/transcripts/input-parse-errors.output.md index 9eced0311f..ee1af109d8 100644 --- a/unison-src/transcripts/input-parse-errors.output.md +++ b/unison-src/transcripts/input-parse-errors.output.md @@ -68,7 +68,7 @@ scratch/main> update arg Sorry, I wasn’t sure how to process your request: - I expected no arguments, but received 1. + I expected no arguments, but received one. You can run `help update` for more information on using `update`. From 5e775ccf7b7207daaebda31c6c7d4e84e864d7ac Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 8 Jul 2024 10:43:29 -0700 Subject: [PATCH 406/631] Improve docs --- .../SqliteCodebase/Migrations/MigrateSchema16To17.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs index 48e711d13a..ce34d51434 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs @@ -34,8 +34,12 @@ import UnliftIO qualified as UnsafeIO -- | This migration converts the codebase from having all projects in a single codebase root to having separate causal -- roots for each project branch. -- It: --- * adds a new table to the schema, `currentProjectPath`, and sets it to contain the path to the scratch project. --- * Adds the causal_hash_id column to the project_branch table. +-- +-- * Adds the new project reflog table +-- * Adds the project-branch head as a causal-hash-id column on the project-branch table, and populates it from all the projects in the project root. +-- * Makes a new legacy project from the existing root branch (minus .__projects) +-- * Adds a new scratch/main project +-- * Adds a currentProjectPath table to replace the most-recent-path functionality. -- -- It requires a Connection argument rather than working inside a Transaction because it needs to temporarily disable -- foreign key checking, and the foreign_key pragma cannot be set within a transaction. From c625e47f8963e3887a77ecfe77522bed3e8c8698 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 8 Jul 2024 11:55:52 -0700 Subject: [PATCH 407/631] Add undo.md transcript --- unison-src/transcripts/undo.md | 51 +++++++ unison-src/transcripts/undo.output.md | 199 ++++++++++++++++++++++++++ 2 files changed, 250 insertions(+) create mode 100644 unison-src/transcripts/undo.md create mode 100644 unison-src/transcripts/undo.output.md diff --git a/unison-src/transcripts/undo.md b/unison-src/transcripts/undo.md new file mode 100644 index 0000000000..112fc30eb3 --- /dev/null +++ b/unison-src/transcripts/undo.md @@ -0,0 +1,51 @@ +# Undo + +Undo should pop a node off of the history of the current branch. + +```unison:hide +x = 1 +``` + +```ucm +scratch/main> builtins.merge lib.builtins +scratch/main> add +scratch/main> ls +scratch/main> alias.term x y +scratch/main> ls +scratch/main> history +scratch/main> undo +scratch/main> ls +scratch/main> history +``` + +--- + +It should not be affected by changes on other branches. + +```unison:hide +x = 1 +``` + +```ucm +scratch/branch1> builtins.merge lib.builtins +scratch/branch1> add +scratch/branch1> ls +scratch/branch1> alias.term x y +scratch/branch1> ls +scratch/branch1> history +-- Make some changes on an unrelated branch +scratch/branch2> builtins.merge lib.builtins +scratch/branch2> delete.namespace lib +scratch/branch1> undo +scratch/branch1> ls +scratch/branch1> history +``` + +--- + +Undo should be a no-op on a newly created branch + +```ucm:error +scratch/main> branch.create-empty new +scratch/new> undo +``` diff --git a/unison-src/transcripts/undo.output.md b/unison-src/transcripts/undo.output.md new file mode 100644 index 0000000000..ae58e4b631 --- /dev/null +++ b/unison-src/transcripts/undo.output.md @@ -0,0 +1,199 @@ +# Undo + +Undo should pop a node off of the history of the current branch. + +```unison +x = 1 +``` + +```ucm +scratch/main> builtins.merge lib.builtins + + Done. + +scratch/main> add + + ⍟ I've added these definitions: + + x : Nat + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/main> alias.term x y + + Done. + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + 3. y (Nat) + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #nmem6r6no1 + + + Adds / updates: + + y + + = Copies: + + Original name New name(s) + x y + + ⊙ 2. #3rqf1hbev7 + + + Adds / updates: + + x + + □ 3. #ms9lggs2rg (start of history) + +scratch/main> undo + + Here are the changes I undid + + Name changes: + + Original Changes + 1. x 2. y (added) + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #3rqf1hbev7 + + + Adds / updates: + + x + + □ 2. #ms9lggs2rg (start of history) + +``` +--- + +It should not be affected by changes on other branches. + +```unison +x = 1 +``` + +```ucm +scratch/branch1> builtins.merge lib.builtins + + Done. + +scratch/branch1> add + + ⍟ I've added these definitions: + + x : Nat + +scratch/branch1> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/branch1> alias.term x y + + Done. + +scratch/branch1> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + 3. y (Nat) + +scratch/branch1> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #nmem6r6no1 + + + Adds / updates: + + y + + = Copies: + + Original name New name(s) + x y + + ⊙ 2. #3rqf1hbev7 + + + Adds / updates: + + x + + □ 3. #ms9lggs2rg (start of history) + +-- Make some changes on an unrelated branch +scratch/branch2> builtins.merge lib.builtins + + Done. + +scratch/branch2> delete.namespace lib + + Done. + +scratch/branch1> undo + + Here are the changes I undid + + Name changes: + + Original Changes + 1. x 2. y (added) + +scratch/branch1> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/branch1> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #3rqf1hbev7 + + + Adds / updates: + + x + + □ 2. #ms9lggs2rg (start of history) + +``` +--- + +Undo should be a no-op on a newly created branch + +```ucm +scratch/main> branch.create-empty new + + Done. I've created an empty branch scratch/new. + + Tip: Use `merge /somebranch` to initialize this branch. + +scratch/new> undo + + ⚠️ + + Nothing more to undo. + +``` From da449fb415ca7ddba32b1df36b77385270350839 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 8 Jul 2024 16:13:23 -0700 Subject: [PATCH 408/631] Use annotations from Abs instead --- .../Unison/LSP/FileAnalysis/UnusedBindings.hs | 27 +++++++------------ unison-core/src/Unison/Term.hs | 2 +- 2 files changed, 10 insertions(+), 19 deletions(-) diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs index af688aa4df..05074f78dc 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -10,32 +10,23 @@ import U.Core.ABT (ABT (..)) import U.Core.ABT qualified as ABT import Unison.LSP.Conversions qualified as Cv import Unison.LSP.Diagnostics qualified as Diagnostic -import Unison.Lexer.Pos qualified as Pos import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Symbol (Symbol (..)) import Unison.Term (Term) -import Unison.Util.Monoid qualified as Monoid -import Unison.Util.Range qualified as Range import Unison.Var qualified as Var -analyseTerm :: Lsp.Uri -> Ann -> Term Symbol Ann -> [Diagnostic] -analyseTerm fileUri topLevelTermAnn tm = +analyseTerm :: Lsp.Uri -> Term Symbol Ann -> [Diagnostic] +analyseTerm fileUri tm = let (unusedVars, _) = ABT.cata alg tm - -- Unfortunately we don't capture the annotation of the actual binding when parsing :'(, for now the least - -- annoying thing to do is just highlight the top of the binding. - mayRange = - Cv.annToURange topLevelTermAnn - <&> (\(Range.Range start@(Pos.Pos line _col) _end) -> Range.Range start (Pos.Pos line 9999)) - <&> Cv.uToLspRange vars = - Map.toList unusedVars & mapMaybe \(v, _ann) -> do - getRelevantVarName v - in case mayRange of - Nothing -> [] - Just lspRange -> - let bindings = Text.intercalate ", " (tShow <$> vars) - in Monoid.whenM (not $ null vars) [Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning ("Unused binding(s) " <> bindings <> " inside this term.\nUse the binding(s), or prefix them with an _ to dismiss this warning.") []] + Map.toList unusedVars & mapMaybe \(v, ann) -> do + (,ann) <$> getRelevantVarName v + diagnostics = + vars & mapMaybe \(varName, ann) -> do + lspRange <- Cv.annToRange ann + pure $ Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning ("Unused binding " <> varName <> ". Use the binding, or prefix it with an _ to dismiss this warning.") [] + in diagnostics where getRelevantVarName :: Symbol -> Maybe Text getRelevantVarName = \case diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index c5f6193e1d..2f36dcaa06 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -947,7 +947,7 @@ letRec isTop blockAnn bindings e = (foldr addAbs body bindings) where addAbs :: ((a, v), b) -> ABT.Term f v a -> ABT.Term f v a - addAbs ((_a, v), _b) t = ABT.abs' blockAnn v t + addAbs ((a, v), _b) t = ABT.abs' a v t body :: Term' vt v a body = ABT.tm' blockAnn (LetRec isTop (map snd bindings) e) From 9cc6c2bd8a255d7b511e65e417e3b6a1343070ee Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 9 Jul 2024 11:33:32 -0400 Subject: [PATCH 409/631] synhash var bugfix: hash debruijn indexes, not var names also adds a debug.synhash.term command for debugging --- .../src/Unison/Codebase/Editor/HandleInput.hs | 37 ++++---- .../Editor/HandleInput/DebugSynhashTerm.hs | 65 ++++++++++++++ .../Codebase/Editor/HandleInput/Merge2.hs | 1 + .../Codebase/Editor/HandleInput/Update2.hs | 1 + .../Codebase/Editor/HandleInput/Upgrade.hs | 1 + .../src/Unison/Codebase/Editor/Input.hs | 1 + .../src/Unison/Codebase/Editor/Output.hs | 20 +++-- .../src/Unison/CommandLine/InputPatterns.hs | 14 +++ .../src/Unison/CommandLine/OutputMessages.hs | 10 +++ unison-cli/unison-cli.cabal | 1 + unison-core/src/Unison/Hashable.hs | 1 + unison-merge/package.yaml | 1 + unison-merge/src/Unison/Merge/Synhash.hs | 86 ++++++++++--------- unison-merge/unison-merge.cabal | 1 + 14 files changed, 176 insertions(+), 64 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 09d101923c..6ca0b0733b 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -59,6 +59,7 @@ import Unison.Codebase.Editor.HandleInput.CommitMerge (handleCommitMerge) import Unison.Codebase.Editor.HandleInput.CommitUpgrade (handleCommitUpgrade) import Unison.Codebase.Editor.HandleInput.DebugDefinition qualified as DebugDefinition import Unison.Codebase.Editor.HandleInput.DebugFoldRanges qualified as DebugFoldRanges +import Unison.Codebase.Editor.HandleInput.DebugSynhashTerm (handleDebugSynhashTerm) import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch) import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject) import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace) @@ -947,6 +948,7 @@ loop e = do UpgradeI old new -> handleUpgrade old new UpgradeCommitI -> handleCommitUpgrade LibInstallI remind libdep -> handleInstallLib remind libdep + DebugSynhashTermI name -> handleDebugSynhashTerm name inputDescription :: Input -> Cli Text inputDescription input = @@ -1059,7 +1061,17 @@ inputDescription input = CreateAuthorI id name -> pure ("create.author " <> NameSegment.toEscapedText id <> " " <> name) ClearI {} -> pure "clear" DocToMarkdownI name -> pure ("debug.doc-to-markdown " <> Name.toText name) - -- + DebugTermI verbose hqName -> + if verbose + then pure ("debug.term.verbose " <> HQ.toText hqName) + else pure ("debug.term " <> HQ.toText hqName) + DebugTypeI hqName -> pure ("debug.type " <> HQ.toText hqName) + DebugLSPFoldRangesI -> pure "debug.lsp.fold-ranges" + DebugFuzzyOptionsI cmd input -> pure . Text.pack $ "debug.fuzzy-completions " <> unwords (cmd : toList input) + DebugFormatI -> pure "debug.format" + EditNamespaceI paths -> + pure $ Text.unwords ("edit.namespace" : (Path.toText <$> paths)) + -- wat land ApiI -> wat AuthLoginI {} -> wat BranchI {} -> wat @@ -1071,18 +1083,11 @@ inputDescription input = DebugDoctorI {} -> wat DebugDumpNamespaceSimpleI {} -> wat DebugDumpNamespacesI {} -> wat - DebugTermI verbose hqName -> - if verbose - then pure ("debug.term.verbose " <> HQ.toText hqName) - else pure ("debug.term " <> HQ.toText hqName) - DebugTypeI hqName -> pure ("debug.type " <> HQ.toText hqName) - DebugLSPFoldRangesI -> pure "debug.lsp.fold-ranges" + DebugLSPNameCompletionI {} -> wat DebugNameDiffI {} -> wat DebugNumberedArgsI {} -> wat - DebugTabCompletionI _input -> wat - DebugLSPNameCompletionI _prefix -> wat - DebugFuzzyOptionsI cmd input -> pure . Text.pack $ "debug.fuzzy-completions " <> unwords (cmd : toList input) - DebugFormatI -> pure "debug.format" + DebugSynhashTermI {} -> wat + DebugTabCompletionI {} -> wat DebugTypecheckedUnisonFileI {} -> wat DiffNamespaceI {} -> wat DisplayI {} -> wat @@ -1090,15 +1095,13 @@ inputDescription input = DocsToHtmlI {} -> wat FindI {} -> wat FindShallowI {} -> wat - StructuredFindI {} -> wat - StructuredFindReplaceI {} -> wat HistoryI {} -> wat LibInstallI {} -> wat ListDependenciesI {} -> wat ListDependentsI {} -> wat LoadI {} -> wat - MergeI {} -> wat MergeCommitI {} -> wat + MergeI {} -> wat NamesI {} -> wat NamespaceDependenciesI {} -> wat PopBranchI {} -> wat @@ -1114,16 +1117,16 @@ inputDescription input = QuitI {} -> wat ReleaseDraftI {} -> wat ShowDefinitionI {} -> wat - EditNamespaceI paths -> - pure $ Text.unwords ("edit.namespace" : (Path.toText <$> paths)) ShowReflogI {} -> wat + StructuredFindI {} -> wat + StructuredFindReplaceI {} -> wat SwitchBranchI {} -> wat TestI {} -> wat TodoI {} -> wat UiI {} -> wat UpI {} -> wat - UpgradeI {} -> wat UpgradeCommitI {} -> wat + UpgradeI {} -> wat VersionI -> wat where hp' :: Either SCH.ShortCausalHash Path' -> Cli Text diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs new file mode 100644 index 0000000000..8f2a24e305 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs @@ -0,0 +1,65 @@ +-- | @debug.synhash.term@ input handler. +module Unison.Codebase.Editor.HandleInput.DebugSynhashTerm + ( handleDebugSynhashTerm, + ) +where + +import Control.Monad.Reader (ask) +import U.Util.Base32Hex qualified as Base32Hex +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.Pretty (prettyBase32Hex, prettyHash) +import Unison.Cli.PrettyPrintUtils qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Editor.Output (Output (..)) +import Unison.Hash (Hash) +import Unison.Hashable qualified as Hashable +import Unison.Merge.Synhash (hashBuiltinTermTokens, hashDerivedTermTokens) +import Unison.Name (Name) +import Unison.Names qualified as Names +import Unison.Prelude +import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) +import Unison.Reference qualified as Reference +import Unison.Util.Pretty (ColorText, Pretty) +import Unison.Util.Pretty qualified as Pretty +import qualified Data.Text as Text +import qualified Data.Text.IO as Text +import qualified Unison.Syntax.Name as Name + +handleDebugSynhashTerm :: Name -> Cli () +handleDebugSynhashTerm name = do + namespace <- Cli.getCurrentBranch0 + let names = Branch.toNames namespace + pped <- Cli.prettyPrintEnvDeclFromNames names + + for_ (Names.refTermsNamed names name) \ref -> do + maybeTokens <- + case ref of + Reference.Builtin builtin -> pure (Just (hashBuiltinTermTokens builtin)) + Reference.DerivedId refId -> do + env <- ask + Cli.runTransaction (Codebase.getTerm env.codebase refId) <&> \case + Nothing -> Nothing + Just term -> Just (hashDerivedTermTokens pped.unsuffixifiedPPE term) + whenJust maybeTokens \tokens -> do + let filename = Name.toText name <> "-" <> Reference.toText ref <> "-synhash-tokens.txt" + let renderedTokens = + tokens + & map prettyToken + & Pretty.lines + & Pretty.toAnsiUnbroken + & Text.pack + liftIO (Text.writeFile (Text.unpack filename) renderedTokens) + Cli.respond (Output'DebugSynhashTerm ref (Hashable.accumulate tokens) filename) + +prettyToken :: Hashable.Token Hash -> Pretty ColorText +prettyToken = \case + Hashable.Bytes bytes -> "0x" <> prettyBase32Hex (Base32Hex.fromByteString bytes) + Hashable.Double n -> Pretty.string (show n) + Hashable.Hashed h -> prettyHash h + Hashable.Int n -> (if n >= 0 then "+" else mempty) <> Pretty.string (show n) + Hashable.Nat n -> Pretty.string (show n) + Hashable.Tag n -> "@" <> Pretty.string (show n) + Hashable.Text s -> Pretty.string (show s) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index ceee0aa836..f263bd6601 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -1,3 +1,4 @@ +-- | @merge@ input handler. module Unison.Codebase.Editor.HandleInput.Merge2 ( handleMerge, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index b0dd664a25..25f6de5709 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -1,3 +1,4 @@ +-- | @update@ input handler. module Unison.Codebase.Editor.HandleInput.Update2 ( handleUpdate2, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index 7785e386d4..70e2475445 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -1,3 +1,4 @@ +-- | @upgrade@ input handler. module Unison.Codebase.Editor.HandleInput.Upgrade ( handleUpgrade, ) diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index d9278b0588..c2ac1a407c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -230,6 +230,7 @@ data Input !(ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) | UpgradeCommitI | MergeCommitI + | DebugSynhashTermI !Name 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 78d2cac1c1..647759774a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -50,8 +50,10 @@ import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.CommandLine.InputPattern qualified as Input import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.ConstructorId (ConstructorId) +import Unison.Hash (Hash) import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' +import Unison.Hashable qualified as Hashable import Unison.LabeledDependency (LabeledDependency) import Unison.Name (Name) import Unison.NameSegment (NameSegment) @@ -186,15 +188,15 @@ data Output | -- | Function found, but has improper type -- Note: the constructor name is misleading here; we weren't necessarily looking for a "main". BadMainFunction - -- | what we were trying to do (e.g. "run", "io.test") Text - -- | name of function + -- ^ what we were trying to do (e.g. "run", "io.test") (HQ.HashQualified Name) - -- | bad type of function + -- ^ name of function (Type Symbol Ann) + -- ^ bad type of function PPE.PrettyPrintEnv - -- | acceptable type(s) of function [Type Symbol Ann] + -- ^ acceptable type(s) of function | BranchEmpty WhichBranchEmpty | LoadPullRequest (ReadRemoteNamespace Void) (ReadRemoteNamespace Void) Path' Path' Path' Path' | CreatedNewBranch Path.Absolute @@ -231,12 +233,12 @@ data Output -- for terms. This additional info is used to provide an enhanced -- error message. SearchTermsNotFoundDetailed - -- | @True@ if we are searching for a term, @False@ if we are searching for a type Bool - -- | Misses (search terms that returned no hits for terms or types) + -- ^ @True@ if we are searching for a term, @False@ if we are searching for a type [HQ.HashQualified Name] - -- | Hits for types if we are searching for terms or terms if we are searching for types + -- ^ Misses (search terms that returned no hits for terms or types) [HQ.HashQualified Name] + -- ^ Hits for types if we are searching for terms or terms if we are searching for types | -- ask confirmation before deleting the last branch that contains some defns -- `Path` is one of the paths the user has requested to delete, and is paired -- with whatever named definitions would not have any remaining names if @@ -385,8 +387,8 @@ data Output | CalculatingDiff | -- | The `local` in a `clone remote local` is ambiguous AmbiguousCloneLocal - -- | Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) + -- ^ Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) | -- | The `remote` in a `clone remote local` is ambiguous AmbiguousCloneRemote ProjectName (ProjectAndBranch ProjectName ProjectBranchName) @@ -426,6 +428,7 @@ data Output | UseLibInstallNotPull !(ProjectAndBranch ProjectName ProjectBranchName) | PullIntoMissingBranch !(ReadRemoteNamespace Share.RemoteProjectBranch) !(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) | NoMergeInProgress + | Output'DebugSynhashTerm !TermReference !Hash !Text data UpdateOrUpgrade = UOUUpdate | UOUUpgrade @@ -665,6 +668,7 @@ isFailure o = case o of UseLibInstallNotPull {} -> False PullIntoMissingBranch {} -> True NoMergeInProgress {} -> True + Output'DebugSynhashTerm {} -> 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 ae2886e2de..5973026ef2 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -3326,6 +3326,19 @@ upgradeCommitInputPattern = args -> wrongArgsLength "no arguments" args } +debugSynhashTermInputPattern :: InputPattern +debugSynhashTermInputPattern = + InputPattern + { patternName = "debug.synhash.term", + aliases = [], + visibility = I.Hidden, + args = [("term", Required, exactDefinitionTermQueryArg)], + help = mempty, + parse = \case + [arg] -> Input.DebugSynhashTermI <$> handleNameArg arg + args -> wrongArgsLength "exactly one argument" args + } + validInputs :: [InputPattern] validInputs = sortOn @@ -3352,6 +3365,7 @@ validInputs = debugDoctor, debugDumpNamespace, debugDumpNamespaceSimple, + debugSynhashTermInputPattern, debugTerm, debugTermVerbose, debugType, diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 7c5553c577..c06408578c 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2159,6 +2159,16 @@ notifyUser dir = \case Just targetProject -> prettyProjectAndBranchName (ProjectAndBranch targetProject targetBranch) NoMergeInProgress -> pure . P.wrap $ "It doesn't look like there's a merge in progress." + Output'DebugSynhashTerm ref synhash filename -> + pure $ + "Hash: " + <> P.syntaxToColor (prettyReference 120 ref) + <> P.newline + <> "Synhash: " + <> prettyHash synhash + <> P.newline + <> "Synhash tokens: " + <> P.text filename expectedEmptyPushDest :: WriteRemoteNamespace Void -> Pretty expectedEmptyPushDest namespace = diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 1382e183a6..12b012fff6 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -59,6 +59,7 @@ library Unison.Codebase.Editor.HandleInput.CommitUpgrade Unison.Codebase.Editor.HandleInput.DebugDefinition Unison.Codebase.Editor.HandleInput.DebugFoldRanges + Unison.Codebase.Editor.HandleInput.DebugSynhashTerm Unison.Codebase.Editor.HandleInput.DeleteBranch Unison.Codebase.Editor.HandleInput.DeleteProject Unison.Codebase.Editor.HandleInput.EditNamespace diff --git a/unison-core/src/Unison/Hashable.hs b/unison-core/src/Unison/Hashable.hs index b0d32ce2a9..69f7173bef 100644 --- a/unison-core/src/Unison/Hashable.hs +++ b/unison-core/src/Unison/Hashable.hs @@ -31,6 +31,7 @@ data Token h | Double !Double | Hashed !h | Nat !Word64 + deriving stock (Show) class Accumulate h where accumulate :: [Token h] -> h diff --git a/unison-merge/package.yaml b/unison-merge/package.yaml index 68cb7d0727..c31adfcd5b 100644 --- a/unison-merge/package.yaml +++ b/unison-merge/package.yaml @@ -36,6 +36,7 @@ dependencies: - unison-util-cache - unison-util-relation - vector + - witch - witherable library: diff --git a/unison-merge/src/Unison/Merge/Synhash.hs b/unison-merge/src/Unison/Merge/Synhash.hs index 6acf835a75..11fec0ec62 100644 --- a/unison-merge/src/Unison/Merge/Synhash.hs +++ b/unison-merge/src/Unison/Merge/Synhash.hs @@ -30,6 +30,10 @@ module Unison.Merge.Synhash synhashTerm, synhashBuiltinDecl, synhashDerivedDecl, + + -- * Exported for debugging + hashBuiltinTermTokens, + hashDerivedTermTokens, ) where @@ -55,13 +59,14 @@ import Unison.Reference (Reference' (..), TypeReferenceId) import Unison.Reference qualified as V1 import Unison.Referent (Referent) import Unison.Referent qualified as Referent +import Witch (unsafeFrom) import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar) import Unison.Term (Term) import Unison.Term qualified as Term import Unison.Type (Type) import Unison.Type qualified as Type import Unison.Var (Var) -import Unison.Var qualified as Var +import qualified Data.List as List type Token = H.Token Hash @@ -80,8 +85,12 @@ synhashBuiltinDecl name = H.accumulate [isBuiltinTag, isDeclTag, H.Text name] hashBuiltinTerm :: Text -> Hash -hashBuiltinTerm name = - H.accumulate [isBuiltinTag, isTermTag, H.Text name] +hashBuiltinTerm = + H.accumulate . hashBuiltinTermTokens + +hashBuiltinTermTokens :: Text -> [Token] +hashBuiltinTermTokens name = + [isBuiltinTag, isTermTag, H.Text name] hashCaseTokens :: PrettyPrintEnv -> Term.MatchCase loc a -> [Token] hashCaseTokens ppe (Term.MatchCase pat Nothing _) = H.Tag 0 : hashPatternTokens ppe pat @@ -108,8 +117,21 @@ hashConstructorNameToken declName conName = in H.Text (Name.toText strippedConName) hashDerivedTerm :: Var v => PrettyPrintEnv -> Term v a -> Hash -hashDerivedTerm ppe t = - H.accumulate $ isNotBuiltinTag : isTermTag : hashTermTokens ppe t +hashDerivedTerm ppe term = + H.accumulate (hashDerivedTermTokens ppe term) + +hashDerivedTermTokens :: forall a v. Var v => PrettyPrintEnv -> Term v a -> [Token] +hashDerivedTermTokens ppe = + (isNotBuiltinTag :) . (isTermTag :) . go [] + where + go :: [v] -> Term v a -> [Token] + go bound t = + H.Tag 255 : case ABT.out t of + ABT.Var v -> [H.Tag 0, hashVarToken bound v] + -- trick: encode the structure, followed the children as a flat list + ABT.Tm f -> H.Tag 1 : hashTermFTokens ppe (void f) <> (toList f >>= go bound) + ABT.Cycle c -> H.Tag 2 : go bound c + ABT.Abs v body -> H.Tag 3 : go (v : bound) body hashConstructorType :: ConstructorType -> Token hashConstructorType = \case @@ -117,18 +139,15 @@ hashConstructorType = \case CT.Data -> H.Tag 1 hashDataDeclTokens :: Var v => PrettyPrintEnv -> Name -> DataDeclaration v a -> [Token] -hashDataDeclTokens ppe declName (DD.DataDeclaration modifier _ vs ctors) = - hashModifierTokens modifier <> goVs <> (ctors >>= hashConstructorTokens ppe declName) - where - goVs = - hashLengthToken vs : map hashVarToken vs +hashDataDeclTokens ppe declName (DD.DataDeclaration modifier _ bound ctors) = + hashModifierTokens modifier <> (ctors >>= hashConstructorTokens ppe declName bound) -- separating constructor types with tag of 99, which isn't used elsewhere -hashConstructorTokens :: Var v => PrettyPrintEnv -> Name -> (a, v, Type v a) -> [Token] -hashConstructorTokens ppe declName (_, conName, ty) = +hashConstructorTokens :: Var v => PrettyPrintEnv -> Name -> [v] -> (a, v, Type v a) -> [Token] +hashConstructorTokens ppe declName bound (_, conName, ty) = H.Tag 99 : hashConstructorNameToken declName (Name.unsafeParseVar conName) - : hashTypeTokens ppe ty + : hashTypeTokens ppe bound ty hashDeclTokens :: Var v => PrettyPrintEnv -> Name -> Decl v a -> [Token] hashDeclTokens ppe name decl = @@ -205,19 +224,6 @@ synhashTerm loadTerm ppe = \case ReferenceBuiltin builtin -> pure (hashBuiltinTerm builtin) ReferenceDerived ref -> hashDerivedTerm ppe <$> loadTerm ref -hashTermTokens :: forall v a. Var v => PrettyPrintEnv -> Term v a -> [Token] -hashTermTokens ppe = - go - where - go :: Term v a -> [Token] - go t = - H.Tag 255 : case ABT.out t of - ABT.Var v -> [H.Tag 0, hashVarToken v] - -- trick: encode the structure, followed the children as a flat list - ABT.Tm f -> H.Tag 1 : hashTermFTokens ppe (void f) <> (toList f >>= go) - ABT.Cycle c -> H.Tag 2 : go c - ABT.Abs v body -> H.Tag 3 : hashVarToken v : go body - hashTermFTokens :: Var v => PrettyPrintEnv -> Term.F v a a () -> [Token] hashTermFTokens ppe = \case Term.Int n -> [H.Tag 0, H.Int n] @@ -233,7 +239,7 @@ hashTermFTokens ppe = \case Term.Request cr -> [H.Tag 7, hashReferentToken ppe (Referent.Con cr CT.Effect)] Term.Handle {} -> [H.Tag 8] Term.App {} -> [H.Tag 9] - Term.Ann _ ty -> H.Tag 10 : hashTypeTokens ppe ty + Term.Ann _ ty -> H.Tag 10 : hashTypeTokens ppe [] ty Term.List xs -> [H.Tag 11, hashLengthToken xs] Term.If {} -> [H.Tag 12] Term.And {} -> [H.Tag 13] @@ -250,20 +256,20 @@ hashTermFTokens ppe = \case -- Two types will have the same syntactic hash if they would -- print the the same way under the given pretty-print env. synhashType :: Var v => PrettyPrintEnv -> Type v a -> Hash -synhashType ppe t = - H.accumulate $ hashTypeTokens ppe t +synhashType ppe ty = + H.accumulate $ hashTypeTokens ppe [] ty -hashTypeTokens :: forall v a. Var v => PrettyPrintEnv -> Type v a -> [Token] +hashTypeTokens :: forall v a. Var v => PrettyPrintEnv -> [v] -> Type v a -> [Token] hashTypeTokens ppe = go where - go :: Type v a -> [Token] - go t = + go :: [v] -> Type v a -> [Token] + go bound t = H.Tag 254 : case ABT.out t of - ABT.Var v -> [H.Tag 0, hashVarToken v] + ABT.Var v -> [H.Tag 0, hashVarToken bound v] -- trick: encode the structure, followed the children as a flat list - ABT.Tm f -> H.Tag 1 : (hashTypeFTokens ppe (void f) <> (toList f >>= go)) - ABT.Cycle c -> H.Tag 2 : go c - ABT.Abs v body -> H.Tag 3 : hashVarToken v : go body + ABT.Tm f -> H.Tag 1 : (hashTypeFTokens ppe (void f) <> (toList f >>= go bound)) + ABT.Cycle c -> H.Tag 2 : go bound c + ABT.Abs v body -> H.Tag 3 : go (v : bound) body hashTypeFTokens :: PrettyPrintEnv -> Type.F () -> [Token] hashTypeFTokens ppe = \case @@ -280,6 +286,8 @@ hashTypeReferenceToken :: PrettyPrintEnv -> TypeReference -> Token hashTypeReferenceToken ppe = hashHQNameToken . PPE.typeNameOrHashOnlyFq ppe -hashVarToken :: Var v => v -> Token -hashVarToken = - H.Text . Var.name +hashVarToken :: Var v => [v] -> v -> Token +hashVarToken bound v = + case List.elemIndex v bound of + Nothing -> error (reportBug "E633940" ("var " ++ show v ++ " not bound in " ++ show bound)) + Just index -> H.Nat (unsafeFrom @Int @Word64 index) diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index ee5b36f481..83131b33be 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -105,6 +105,7 @@ library , unison-util-cache , unison-util-relation , vector + , witch , witherable default-language: Haskell2010 if !os(windows) From d70b2190587bb982f1a78bc4e301709d3ea0ad4b Mon Sep 17 00:00:00 2001 From: mitchellwrosen Date: Tue, 9 Jul 2024 15:48:21 +0000 Subject: [PATCH 410/631] automatically run ormolu --- unison-merge/src/Unison/Merge/Synhash.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-merge/src/Unison/Merge/Synhash.hs b/unison-merge/src/Unison/Merge/Synhash.hs index 11fec0ec62..da9a988449 100644 --- a/unison-merge/src/Unison/Merge/Synhash.hs +++ b/unison-merge/src/Unison/Merge/Synhash.hs @@ -38,6 +38,7 @@ module Unison.Merge.Synhash where import Data.Char (ord) +import Data.List qualified as List import Data.Text qualified as Text import U.Codebase.Reference (TypeReference) import Unison.ABT qualified as ABT @@ -59,14 +60,13 @@ import Unison.Reference (Reference' (..), TypeReferenceId) import Unison.Reference qualified as V1 import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Witch (unsafeFrom) import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar) import Unison.Term (Term) import Unison.Term qualified as Term import Unison.Type (Type) import Unison.Type qualified as Type import Unison.Var (Var) -import qualified Data.List as List +import Witch (unsafeFrom) type Token = H.Token Hash From 701f308ab5d46db982f106f86a8c7477358d11e7 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 9 Jul 2024 11:58:41 -0400 Subject: [PATCH 411/631] delete unused import --- unison-cli/src/Unison/Codebase/Editor/Output.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 647759774a..1eb7fda3c2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -53,7 +53,6 @@ import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.Hash (Hash) import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' -import Unison.Hashable qualified as Hashable import Unison.LabeledDependency (LabeledDependency) import Unison.Name (Name) import Unison.NameSegment (NameSegment) From 22d4b26f024485091c08fcb6829fea92f16292ad Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Tue, 9 Jul 2024 12:12:57 -0400 Subject: [PATCH 412/631] Update unison-cli/src/Unison/CommandLine/InputPatterns.hs Co-authored-by: Greg Pfeil --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index b1a6f1541d..a09a6595ca 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -345,9 +345,9 @@ wrongStructuredArgument expected actual = wrongArgsLength :: Text -> [a] -> Either (P.Pretty CT.ColorText) b wrongArgsLength expected args = let foundCount = - if null args - then "none" - else fromMaybe (tShow $ length args) $ Numeral.us_cardinal defaultInflection (length args) + case length args of + 0 -> "none" + n -> fromMaybe (tShow n) $ Numeral.us_cardinal defaultInflection n in Left . P.text $ "I expected " <> expected <> ", but received " <> foundCount <> "." patternName :: InputPattern -> P.Pretty P.ColorText From ee6793bd27dd74fb23d2c7d4b82c6a668ce715b3 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 8 Jul 2024 16:13:23 -0700 Subject: [PATCH 413/631] Attempt to fix Unused Binding locations --- .../src/Unison/Syntax/TermParser.hs | 16 ++++++------ .../src/Unison/Typechecker/Components.hs | 7 ++---- unison-cli/src/Unison/LSP/FileAnalysis.hs | 5 +++- unison-cli/src/Unison/LSP/Queries.hs | 14 ++++++++--- unison-core/src/Unison/Term.hs | 25 ++++++++++++------- unison-syntax/src/Unison/Lexer/Pos.hs | 12 ++------- unison-syntax/src/Unison/Syntax/Lexer.hs | 2 -- 7 files changed, 43 insertions(+), 38 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 044a29ead5..cfa25490d4 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -38,8 +38,8 @@ import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names -import Unison.Parser.Ann qualified as Ann import Unison.Parser.Ann (Ann) +import Unison.Parser.Ann qualified as Ann import Unison.Pattern (Pattern) import Unison.Pattern qualified as Pattern import Unison.Prelude @@ -412,7 +412,7 @@ hashQualifiedPrefixTerm = resolveHashQualified =<< hqPrefixId hashQualifiedInfixTerm :: (Monad m, Var v) => TermP v m hashQualifiedInfixTerm = resolveHashQualified =<< hqInfixId -quasikeyword :: Ord v => Text -> P v m (L.Token ()) +quasikeyword :: (Ord v) => Text -> P v m (L.Token ()) quasikeyword kw = queryToken \case L.WordyId (HQ'.NameOnly n) | nameIsKeyword n kw -> Just () _ -> Nothing @@ -993,10 +993,10 @@ bang = P.label "bang" do e <- termLeaf pure $ DD.forceTerm (ann start <> ann e) (ann start) e -force :: forall m v . (Monad m, Var v) => TermP v m +force :: forall m v. (Monad m, Var v) => TermP v m force = P.label "force" $ P.try do -- `forkAt pool() blah` parses as `forkAt (pool ()) blah` - -- That is, empty parens immediately (no space) following a symbol + -- That is, empty parens immediately (no space) following a symbol -- is treated as high precedence function application of `Unit` fn <- hashQualifiedPrefixTerm tok <- ann <$> openBlockWith "(" @@ -1008,10 +1008,10 @@ seqOp :: (Ord v) => P v m Pattern.SeqOp seqOp = Pattern.Snoc <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.snocSegment))) - <|> Pattern.Cons - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment))) - <|> Pattern.Concat - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment))) + <|> Pattern.Cons + <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment))) + <|> Pattern.Concat + <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment))) term4 :: (Monad m, Var v) => TermP v m term4 = f <$> some termLeaf diff --git a/parser-typechecker/src/Unison/Typechecker/Components.hs b/parser-typechecker/src/Unison/Typechecker/Components.hs index ccef8995d3..72dac37113 100644 --- a/parser-typechecker/src/Unison/Typechecker/Components.hs +++ b/parser-typechecker/src/Unison/Typechecker/Components.hs @@ -78,7 +78,7 @@ minimize (Term.LetRecNamedAnnotatedTop' isTop blockAnn bs e) = blockAnn [(annotatedVar hdv, hdb)] e - | otherwise = Term.singleLet isTop blockAnn (hdv, hdb) e + | otherwise = Term.singleLet isTop blockAnn (annotationFor hdv) (hdv, hdb) e mklet cycle@((_, _) : _) e = Term.letRec isTop @@ -86,10 +86,7 @@ minimize (Term.LetRecNamedAnnotatedTop' isTop blockAnn bs e) = (first annotatedVar <$> cycle) e mklet [] e = e - in -- The outer annotation is going to be meaningful, so we make - -- sure to preserve it, whereas the annotations at intermediate Abs - -- nodes aren't necessarily meaningful - Right . Just . ABT.annotate blockAnn . foldr mklet e $ cs + in Right . Just . foldr mklet e $ cs minimize _ = Right Nothing minimize' :: diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index ddd7fc477c..d6c6e678f9 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -29,6 +29,7 @@ import Unison.Cli.UniqueTypeGuidLookup qualified as Cli import Unison.Codebase qualified as Codebase import Unison.DataDeclaration qualified as DD import Unison.Debug qualified as Debug +import Debug.Trace import Unison.FileParsers (ShouldUseTndr (..)) import Unison.FileParsers qualified as FileParsers import Unison.KindInference.Error qualified as KindInference @@ -111,8 +112,10 @@ checkFile doc = runMaybeT do & foldMap (\(RangedCodeAction {_codeActionRanges, _codeAction}) -> (,_codeAction) <$> _codeActionRanges) & toRangeMap let typeSignatureHints = fromMaybe mempty (mkTypeSignatureHints <$> parsedFile <*> typecheckedFile) + for_ (parsedFile & foldMap (Map.toList . UF.terms )) \(v, (_, trm)) -> do + traceM (show $ (v, trm)) let fileSummary = FileSummary.mkFileSummary parsedFile typecheckedFile - let unusedBindingDiagnostics = fileSummary ^.. _Just . to termsBySymbol . folded . folding (\(topLevelAnn, _refId, trm, _type) -> UnusedBindings.analyseTerm fileUri topLevelAnn trm) + let unusedBindingDiagnostics = fileSummary ^.. _Just . to termsBySymbol . folded . folding (\(_topLevelAnn, _refId, trm, _type) -> UnusedBindings.analyseTerm fileUri trm) let tokenMap = getTokenMap tokens conflictWarningDiagnostics <- fold <$> for fileSummary \fs -> diff --git a/unison-cli/src/Unison/LSP/Queries.hs b/unison-cli/src/Unison/LSP/Queries.hs index b6e87497cf..d8391b8bf7 100644 --- a/unison-cli/src/Unison/LSP/Queries.hs +++ b/unison-cli/src/Unison/LSP/Queries.hs @@ -198,14 +198,14 @@ instance Functor SourceNode where -- children contain that position. findSmallestEnclosingNode :: Pos -> Term Symbol Ann -> Maybe (SourceNode Ann) findSmallestEnclosingNode pos term - | annIsFilePosition (ABT.annotation term) && not (ABT.annotation term `Ann.contains` pos) = Nothing + | annIsFilePosition ann && not (ann `Ann.contains` pos) = Nothing | Just r <- cleanImplicitUnit term = findSmallestEnclosingNode pos r | otherwise = do -- For leaf nodes we require that they be an in-file position, not Intrinsic or -- external. -- In some rare cases it's possible for an External/Intrinsic node to have children that -- ARE in the file, so we need to make sure we still crawl their children. - let guardInFile = guard (annIsFilePosition (ABT.annotation term)) + let guardInFile = guard (annIsFilePosition ann) let bestChild = case ABT.out term of ABT.Tm f -> case f of Term.Int {} -> guardInFile *> Just (TermNode term) @@ -244,7 +244,7 @@ findSmallestEnclosingNode pos term ABT.Var _v -> guardInFile *> Just (TermNode term) ABT.Cycle r -> findSmallestEnclosingNode pos r ABT.Abs _v r -> findSmallestEnclosingNode pos r - let fallback = if annIsFilePosition (ABT.annotation term) then Just (TermNode term) else Nothing + let fallback = if annIsFilePosition ann then Just (TermNode term) else Nothing bestChild <|> fallback where -- tuples always end in an implicit unit, but it's annotated with the span of the whole @@ -256,6 +256,14 @@ findSmallestEnclosingNode pos term ABT.Tm' (Term.App (ABT.Tm' (Term.App (ABT.Tm' (Term.Constructor (ConstructorReference ref 0))) x)) trm) | ref == Builtins.pairRef && Term.amap (const ()) trm == Builtins.unitTerm () -> Just x _ -> Nothing + ann = getTermSpanAnn term + + +-- | Most nodes have the property that their annotation spans all their children, but there are some exceptions. +getTermSpanAnn :: Term Symbol Ann -> Ann +getTermSpanAnn tm = case ABT.out tm of + ABT.Abs _v r -> ABT.annotation tm <> getTermSpanAnn r + _ -> ABT.annotation tm findSmallestEnclosingPattern :: Pos -> Pattern.Pattern Ann -> Maybe (Pattern.Pattern Ann) findSmallestEnclosingPattern pos pat diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index 2f36dcaa06..3bd9336c75 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -866,9 +866,14 @@ ann :: Term2 vt at ap v a ann a e t = ABT.tm' a (Ann e t) --- arya: are we sure we want the two annotations to be the same? -lam :: (Ord v) => a -> v -> Term2 vt at ap v a -> Term2 vt at ap v a -lam a v body = ABT.tm' a (Lam (ABT.abs' a v body)) +lam :: + (Ord v) => + a -> + -- Annotation for just the variable binding + (a, v) -> + Term2 vt at ap v a -> + Term2 vt at ap v a +lam spanAnn (bindingAnn, v) body = ABT.tm' spanAnn (Lam (ABT.abs' bindingAnn v body)) delay :: (Var v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a delay a body = @@ -978,7 +983,7 @@ let1 :: Term2 vt at ap v a let1 isTop bindings e = foldr f e bindings where - f ((ann, v), b) body = ABT.tm' (ann <> ABT.annotation body) (Let isTop b (ABT.abs' (ABT.annotation body) v body)) + f ((ann, v), b) body = ABT.tm' (ann <> ABT.annotation body) (Let isTop b (ABT.abs' ann v body)) let1' :: (Semigroup a, Ord v) => @@ -997,12 +1002,14 @@ let1' isTop bindings e = foldr f e bindings singleLet :: (Ord v) => IsTop -> - -- Annotation spanning the whole let-binding + -- Annotation spanning the let-binding and its body + a -> + -- Annotation for just the binding, not the body it's used in. a -> (v, Term2 vt at ap v a) -> Term2 vt at ap v a -> Term2 vt at ap v a -singleLet isTop a (v, body) e = ABT.tm' a (Let isTop body (ABT.abs' a v e)) +singleLet isTop spanAnn absAnn (v, body) e = ABT.tm' spanAnn (Let isTop body (ABT.abs' absAnn v e)) -- let1' :: Var v => [(Text, Term0 vt v)] -> Term0 vt v -> Term0 vt v -- let1' bs e = let1 [(ABT.v' name, b) | (name,b) <- bs ] e @@ -1383,7 +1390,7 @@ containsExpression = ABT.containsExpression -- Used to find matches of `@rewrite case` rules -- Returns `Nothing` if `pat` can't be interpreted as a `Pattern` -- (like `1 + 1` is not a valid pattern, but `Some x` can be) -containsCaseTerm :: Var v1 => Term2 tv ta tb v1 loc -> Term2 typeVar typeAnn loc v2 a -> Maybe Bool +containsCaseTerm :: (Var v1) => Term2 tv ta tb v1 loc -> Term2 typeVar typeAnn loc v2 a -> Maybe Bool containsCaseTerm pat = (\tm -> containsCase <$> pat' <*> pure tm) where @@ -1456,7 +1463,7 @@ rewriteCasesLHS pat0 pat0' = go t = t -- Implementation detail of `@rewrite case` rules (both find and replace) -toPattern :: Var v => Term2 tv ta tb v loc -> Maybe (Pattern loc) +toPattern :: (Var v) => Term2 tv ta tb v loc -> Maybe (Pattern loc) toPattern tm = case tm of Var' v | "_" `Text.isPrefixOf` Var.name v -> pure $ Pattern.Unbound loc Var' _ -> pure $ Pattern.Var loc @@ -1484,7 +1491,7 @@ toPattern tm = case tm of loc = ABT.annotation tm -- Implementation detail of `@rewrite case` rules (both find and replace) -matchCaseFromTerm :: Var v => Term2 typeVar typeAnn a v a -> Maybe (MatchCase a (Term2 typeVar typeAnn a v a)) +matchCaseFromTerm :: (Var v) => Term2 typeVar typeAnn a v a -> Maybe (MatchCase a (Term2 typeVar typeAnn a v a)) matchCaseFromTerm (App' (Builtin' "#case") (ABT.unabsA -> (_, Apps' _ci [pat, guard, body]))) = do p <- toPattern pat let g = unguard guard diff --git a/unison-syntax/src/Unison/Lexer/Pos.hs b/unison-syntax/src/Unison/Lexer/Pos.hs index b3297b9221..9286d36b05 100644 --- a/unison-syntax/src/Unison/Lexer/Pos.hs +++ b/unison-syntax/src/Unison/Lexer/Pos.hs @@ -4,21 +4,13 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} -module Unison.Lexer.Pos (Pos (..), Line, Column, line, column) where +module Unison.Lexer.Pos (Pos (..), Line, Column) where type Line = Int type Column = Int -data Pos = Pos {-# UNPACK #-} !Line {-# UNPACK #-} !Column deriving (Eq, Ord) - -line :: Pos -> Line -line (Pos line _) = line - -column :: Pos -> Column -column (Pos _ column) = column - -instance Show Pos where show (Pos line col) = "line " <> show line <> ", column " <> show col +data Pos = Pos { line :: {-# UNPACK #-} !Line, column :: {-# UNPACK #-} !Column} deriving (Show, Eq, Ord) instance Semigroup Pos where Pos line col <> Pos line2 col2 = diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 6ff55150f7..6a2d74911e 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -8,8 +8,6 @@ module Unison.Syntax.Lexer Pos (..), Lexeme (..), lexer, - line, - column, escapeChars, debugFileLex, debugLex', From 94c6bfca628049b2918d47d6f804aaddcd945c8e Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 9 Jul 2024 14:10:53 -0400 Subject: [PATCH 414/631] add transcript --- unison-src/transcripts/merge.md | 62 +++++++++++++ unison-src/transcripts/merge.output.md | 121 +++++++++++++++++++++++++ 2 files changed, 183 insertions(+) diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 164b458f5d..4a84996f4d 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -1645,3 +1645,65 @@ project/bob> merge /alice project/carol> merge /bob project/carol> history ``` + +```ucm:hide +.> project.delete project +``` + +### Variables named `_` + +This test demonstrates a change in syntactic hashing that fixed a bug due to auto-generated variable names for ignored +results. + +```ucm:hide +scratch/alice> builtins.mergeio lib.builtins +``` + +```unison +ignore : a -> () +ignore _ = () + +foo : Nat +foo = 18 + +bar : Nat +bar = + ignore "hi" + foo + foo +``` + +```ucm +scratch/alice> add +scratch/alice> branch bob +``` + +```unison +bar : Nat +bar = + ignore "hi" + foo + foo + foo +``` + +```ucm +scratch/bob> update +``` + +Previously, this update to `foo` would also cause a "real update" on `bar`, its dependent. Now it doesn't, so the merge +will succeed. + +```unison +foo : Nat +foo = 19 +``` + +```ucm +scratch/alice> update +``` + +```ucm +scratch/alice> merge /bob +``` + +```ucm:hide +.> project.delete scratch +``` diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index d0251764e2..a8a97adb6b 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -2121,3 +2121,124 @@ project/carol> history 3. #dm4u1eokg1 ``` +### Variables named `_` + +This test demonstrates a change in syntactic hashing that fixed a bug due to auto-generated variable names for ignored +results. + +```unison +ignore : a -> () +ignore _ = () + +foo : Nat +foo = 18 + +bar : Nat +bar = + ignore "hi" + foo + foo +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bar : Nat + foo : Nat + ignore : a -> () + +``` +```ucm +scratch/alice> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat + ignore : a -> () + +scratch/alice> branch bob + + Done. I've created the bob branch based off of alice. + + Tip: To merge your work back into the alice branch, first + `switch /alice` then `merge /bob`. + +``` +```unison +bar : Nat +bar = + ignore "hi" + foo + foo + foo +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These names already exist. You can `update` them to your + new definition: + + bar : Nat + +``` +```ucm +scratch/bob> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +``` +Previously, this update to `foo` would also cause a "real update" on `bar`, its dependent. Now it doesn't, so the merge +will succeed. + +```unison +foo : Nat +foo = 19 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These names already exist. You can `update` them to your + new definition: + + foo : Nat + +``` +```ucm +scratch/alice> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +``` +```ucm +scratch/alice> merge /bob + + I merged scratch/bob into scratch/alice. + +``` From 2c1a0485f70586e8d4fc20c280101aa4e5b97c37 Mon Sep 17 00:00:00 2001 From: Paul Chiusano Date: Tue, 9 Jul 2024 15:17:46 -0400 Subject: [PATCH 415/631] Don't use DelayForceChar as syntax style for `blah.default()` --- parser-typechecker/src/Unison/Syntax/TermPrinter.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index 08b805c4dd..59d27cae36 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -490,7 +490,7 @@ pretty0 (App' x (Constructor' (ConstructorReference DD.UnitRef 0)), _) | isLeaf x -> do px <- pretty0 (ac (if isBlock x then 0 else 9) Normal im doc) x pure . paren (p >= 11 || isBlock x && p >= 3) $ - px <> fmt S.DelayForceChar (l "()") + px <> fmt S.Unit (l "()") (Apps' f (unsnoc -> Just (args, lastArg)), _) | isSoftHangable lastArg -> do fun <- goNormal 9 f From c3405c27b450570e760b42d8f3bba49f67c43df6 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 9 Jul 2024 13:50:32 -0600 Subject: [PATCH 416/631] Pin Haskell tool versions for VS Code This also has the flake get its version pins (when possible) from the VS Code settings. And we pin Cabal now, too. --- .vscode/settings.json | 7 +++++++ flake.nix | 12 ++++++++---- nix/haskell-nix-flake.nix | 2 +- 3 files changed, 16 insertions(+), 5 deletions(-) create mode 100644 .vscode/settings.json diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000000..6002d51193 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,7 @@ +{ + "haskell.toolchain": { + "cabal": "3.10.3.0", + "hls": "2.8.0.0", + "stack": "2.15.7" + } +} diff --git a/flake.nix b/flake.nix index 0be2f8da81..a266bd2e29 100644 --- a/flake.nix +++ b/flake.nix @@ -26,11 +26,15 @@ "aarch64-darwin" ] (system: let - versions = { - ormolu = "0.7.2.0"; - hls = "2.8.0.0"; - stack = "2.15.7"; + ## It’s much easier to read from a JSON file than to have JSON import from some other file, so we extract some + ## configuration from the VS Code settings to avoid duplication. + vscodeSettings = nixpkgs-release.lib.importJSON ./.vscode/settings.json; + versions = + vscodeSettings."haskell.toolchain" + ## There are some things we want to pin that the VS Code Haskell extension doesn’t let us control. + // { hpack = "0.35.2"; + ormolu = "0.7.2.0"; }; pkgs = import nixpkgs-haskellNix { inherit system; diff --git a/nix/haskell-nix-flake.nix b/nix/haskell-nix-flake.nix index 25930790c1..97c8f1ebc0 100644 --- a/nix/haskell-nix-flake.nix +++ b/nix/haskell-nix-flake.nix @@ -28,7 +28,7 @@ tools = (args.tools or {}) // { - cabal = {}; + cabal = {version = versions.cabal;}; ormolu = {version = versions.ormolu;}; haskell-language-server = { version = versions.hls; From 66d9b76c77854165d69fd8539c031f0861d18caf Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 9 Jul 2024 09:52:31 -0700 Subject: [PATCH 417/631] Ignore more scratchfiles --- .gitignore | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 3b9fce4920..b182f70b40 100644 --- a/.gitignore +++ b/.gitignore @@ -1,9 +1,14 @@ # Unison .unison* test-output -scratch.u unisonLocal.zip *.uc +# Ignore all scratch files... +*.u +# Except those in unison-src +!unison-src/**/*.u +# And integration tests +!unison-cli-integration/integration-tests/IntegrationTests/**/*.u # Auto-generated jit-tests.md From e506b009ed602b7dccb8ce9a9f0ba6356927147b Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 9 Jul 2024 09:52:31 -0700 Subject: [PATCH 418/631] No in-memory branch in loop-state --- parser-typechecker/src/Unison/Codebase.hs | 8 ++++ unison-cli/src/Unison/Cli/Monad.hs | 29 +++++-------- unison-cli/src/Unison/Cli/MonadUtils.hs | 30 ++++++------- .../src/Unison/Codebase/TranscriptParser.hs | 8 ++-- unison-cli/src/Unison/CommandLine/Main.hs | 39 +++++------------ unison-cli/src/Unison/Main.hs | 43 ++++++------------- 6 files changed, 60 insertions(+), 97 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 2271ff62d0..d8b372f81c 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -4,6 +4,7 @@ module Unison.Codebase -- * UCM session state expectCurrentProjectPath, setCurrentProjectPath, + resolveProjectPathIds, -- * Terms getTerm, @@ -571,3 +572,10 @@ expectCurrentProjectPath = do setCurrentProjectPath :: PP.ProjectPathIds -> Sqlite.Transaction () setCurrentProjectPath (PP.ProjectPath projectId projectBranchId path) = Q.setCurrentProjectPath projectId projectBranchId (Path.toList (Path.unabsolute path)) + +-- | Hydrate the project and branch from IDs. +resolveProjectPathIds :: PP.ProjectPathIds -> Sqlite.Transaction PP.ProjectPath +resolveProjectPathIds (PP.ProjectPath projectId projectBranchId path) = do + proj <- Q.expectProject projectId + projBranch <- Q.expectProjectBranch projectId projectBranchId + pure $ PP.ProjectPath proj projBranch path diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index 62704e556e..efefd1906e 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -50,7 +50,6 @@ module Unison.Cli.Monad -- * Internal setMostRecentProjectPath, - setInMemoryCurrentProjectRoot, -- * Misc types LoadSourceResult (..), @@ -78,7 +77,6 @@ import Unison.Auth.CredentialManager (CredentialManager) import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch (Branch) import Unison.Codebase.Editor.Input (Input) import Unison.Codebase.Editor.Output (NumberedArgs, NumberedOutput, Output) import Unison.Codebase.Editor.UCMVersion (UCMVersion) @@ -96,7 +94,8 @@ import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Type (Type) import Unison.UnisonFile qualified as UF -import UnliftIO.STM +import UnliftIO qualified +import UnliftIO.Concurrent qualified as UnliftIO import Unsafe.Coerce (unsafeCoerce) -- | The main command-line app monad. @@ -186,8 +185,7 @@ data Env = Env -- -- There's an additional pseudo @"currentPath"@ field lens, for convenience. data LoopState = LoopState - { currentProjectRoot :: TMVar (Branch IO), - -- the current position in the codebase, with the head being the most recent lcoation. + { -- the current position in the codebase, with the head being the most recent lcoation. projectPathStack :: List.NonEmpty PP.ProjectPathIds, -- TBD -- , _activeEdits :: Set Branch.EditGuid @@ -214,11 +212,10 @@ data LoopState = LoopState deriving stock (Generic) -- | Create an initial loop state given a root branch and the current path. -loopState0 :: TMVar (Branch IO) -> PP.ProjectPathIds -> LoopState -loopState0 b p = do +loopState0 :: PP.ProjectPathIds -> LoopState +loopState0 p = do LoopState - { currentProjectRoot = b, - projectPathStack = pure p, + { projectPathStack = pure p, latestFile = Nothing, latestTypecheckedFile = Nothing, lastInput = Nothing, @@ -391,22 +388,18 @@ cd path = do setMostRecentProjectPath newPP #projectPathStack %= NonEmpty.cons newPP --- | Set the in-memory project root to the given branch, without updating the database. -setInMemoryCurrentProjectRoot :: Branch IO -> Cli () -setInMemoryCurrentProjectRoot !newRoot = do - rootVar <- use #currentProjectRoot - atomically do - void $ swapTMVar rootVar newRoot - switchProject :: ProjectAndBranch ProjectId ProjectBranchId -> Cli () switchProject (ProjectAndBranch projectId branchId) = do Env {codebase} <- ask let newPP = PP.ProjectPath projectId branchId Path.absoluteEmpty #projectPathStack %= NonEmpty.cons newPP runTransaction $ do Q.setMostRecentBranch projectId branchId - pbr <- liftIO $ Codebase.expectProjectBranchRoot codebase projectId branchId - setInMemoryCurrentProjectRoot pbr setMostRecentProjectPath newPP + -- Prime the cache with the new project branch root so it's ready when a command needs it. + void . liftIO . UnliftIO.forkIO $ do + b <- Codebase.expectProjectBranchRoot codebase projectId branchId + -- Force the branch in the background thread to avoid delays later. + void $ UnliftIO.evaluate b -- | Pop the latest path off the stack, if it's not the only path in the stack. -- diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index ba182aacbb..25034b4b45 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -131,7 +131,6 @@ import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UFN import Unison.Util.Set qualified as Set import Unison.Var qualified as Var -import UnliftIO.STM ------------------------------------------------------------------------------------------------------------------------ -- .unisonConfig things @@ -147,13 +146,8 @@ getConfig key = do getCurrentProjectPath :: Cli PP.ProjectPath getCurrentProjectPath = do - (PP.ProjectPath projId branchId path) <- Cli.getProjectPathIds - -- TODO: Reset to a valid project on error. - (proj, branch) <- fmap (fromMaybe (error $ reportBug "E794202" ("Project branch not found in database for ids: " <> show (projId, branchId)))) . Cli.runTransaction . runMaybeT $ do - project <- MaybeT $ Q.loadProject projId - branch <- MaybeT $ Q.loadProjectBranch projId branchId - pure (project, branch) - pure (PP.ProjectPath proj branch path) + ppIds <- Cli.getProjectPathIds + Cli.runTransaction $ Codebase.resolveProjectPathIds ppIds getCurrentProjectAndBranch :: Cli (ProjectAndBranch Project ProjectBranch) getCurrentProjectAndBranch = do @@ -266,7 +260,9 @@ resolveShortCausalHashToCausalHash rollback shortHash = do -- | Get the root branch. getCurrentProjectRoot :: Cli (Branch IO) getCurrentProjectRoot = do - use #currentProjectRoot >>= atomically . readTMVar + Cli.Env {codebase} <- ask + ProjectAndBranch proj branch <- getCurrentProjectAndBranch + liftIO $ Codebase.expectProjectBranchRoot codebase proj.projectId branch.branchId -- | Get the root branch0. getCurrentProjectRoot0 :: Cli (Branch0 IO) @@ -445,18 +441,18 @@ updateAndStepAt reason projectBranch updates steps = do updateProjectBranchRoot :: ProjectBranch -> Text -> (Branch IO -> Cli (Branch IO, r)) -> Cli r updateProjectBranchRoot projectBranch reason f = do - currentPB <- getCurrentProjectBranch Cli.Env {codebase} <- ask Cli.time "updateProjectBranchRoot" do old <- getProjectBranchRoot projectBranch (new, result) <- f old - liftIO $ Codebase.putBranch codebase new - Cli.runTransaction $ do - causalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash new) - Q.setProjectBranchHead reason (projectBranch ^. #projectId) (projectBranch ^. #branchId) causalHashId - if projectBranch.branchId == currentPB.branchId - then Cli.setInMemoryCurrentProjectRoot new - else pure () + when (old /= new) do + liftIO $ Codebase.putBranch codebase new + Cli.runTransaction $ do + -- TODO: If we transactionally check that the project branch hasn't changed while we were computing the new + -- branch, and if it has, abort the transaction and return an error, then we can + -- remove the single UCM per codebase restriction. + causalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash new) + Q.setProjectBranchHead reason (projectBranch ^. #projectId) (projectBranch ^. #branchId) causalHashId pure result updateProjectBranchRoot_ :: ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli () diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/TranscriptParser.hs index f59169efdd..ffb0c4c20a 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/unison-cli/src/Unison/Codebase/TranscriptParser.hs @@ -28,6 +28,7 @@ import Data.Configurator qualified as Configurator import Data.Configurator.Types (Config) import Data.IORef import Data.List (isSubsequenceOf) +import Data.List.NonEmpty qualified as NonEmpty import Data.Map qualified as Map import Data.Text qualified as Text import Data.These (These (..)) @@ -51,7 +52,6 @@ import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase -import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.HandleInput qualified as HandleInput import Unison.Codebase.Editor.Input (Event (UnisonFileChanged), Input (..)) import Unison.Codebase.Editor.Output qualified as Output @@ -250,7 +250,6 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion initialPP <- Codebase.expectCurrentProjectPath pure (initialPP, emptyCausalHashId) - projectRootVar <- newTMVarIO Branch.empty unless (isSilent verbosity) . putPrettyLn $ Pretty.lines [ asciiartUnison, @@ -378,7 +377,8 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion args -> do liftIO (output ("\n" <> show p <> "\n")) numberedArgs <- use #numberedArgs - let getProjectRoot = atomically $ readTMVar projectRootVar + PP.ProjectAndBranch projId branchId <- PP.toProjectAndBranch . NonEmpty.head <$> use #projectPathStack + let getProjectRoot = liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId liftIO (parseInput codebase curPath getProjectRoot numberedArgs patternMap args) >>= \case -- invalid command is treated as a failure Left msg -> do @@ -572,7 +572,7 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion texts <- readIORef out pure $ Text.concat (Text.pack <$> toList (texts :: Seq String)) - loop (Cli.loopState0 projectRootVar (PP.toIds initialPP)) + loop (Cli.loopState0 (PP.toIds initialPP)) transcriptFailure :: IORef (Seq String) -> Text -> IO b transcriptFailure out msg = do diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index a4309e8733..8067cf463b 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -12,6 +12,7 @@ import Crypto.Random qualified as Random import Data.Configurator.Types (Config) import Data.IORef import Data.List.NonEmpty qualified as NEL +import Data.List.NonEmpty qualified as NonEmpty import Data.Text qualified as Text import Data.Text.IO qualified as Text import Ki qualified @@ -20,7 +21,6 @@ import System.Console.Haskeline qualified as Line import System.Console.Haskeline.History qualified as Line import System.IO (hGetEcho, hPutStrLn, hSetEcho, stderr, stdin) import System.IO.Error (isDoesNotExistError) -import U.Codebase.HashTags (CausalHash) import Unison.Auth.CredentialManager (newCredentialManager) import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Auth.HTTPClient qualified as AuthN @@ -31,7 +31,6 @@ import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch) -import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.HandleInput qualified as HandleInput import Unison.Codebase.Editor.Input (Event, Input (..)) import Unison.Codebase.Editor.Output (NumberedArgs, Output) @@ -133,37 +132,18 @@ main :: Codebase IO Symbol Ann -> Maybe Server.BaseUrl -> UCMVersion -> - (CausalHash -> STM ()) -> - (PP.ProjectPath -> STM ()) -> + (PP.ProjectPathIds -> IO ()) -> ShouldWatchFiles -> IO () -main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion notifyBranchChange notifyPathChange shouldWatchFiles = Ki.scoped \scope -> do - rootVar <- newEmptyTMVarIO +main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion lspCheckForChanges shouldWatchFiles = Ki.scoped \scope -> do _ <- Ki.fork scope do + -- Pre-load the project root in the background so it'll be ready when a command needs it. projectRoot <- Codebase.expectProjectBranchRoot codebase ppIds.project ppIds.branch - atomically do - -- Try putting the root, but if someone else as already written over the root, don't - -- overwrite it. - void $ tryPutTMVar rootVar projectRoot -- Start forcing thunks in a background thread. - -- This might be overly aggressive, maybe we should just evaluate the top level but avoid - -- recursive "deep*" things. UnliftIO.concurrently_ (UnliftIO.evaluate projectRoot) (UnliftIO.evaluate IOSource.typecheckedFile) -- IOSource takes a while to compile, we should start compiling it on startup - let initialState = Cli.loopState0 rootVar ppIds - Ki.fork_ scope do - let loop lastRoot = do - -- This doesn't necessarily notify on _every_ update, but the LSP only needs the - -- most recent version at any given time, so it's fine to skip some intermediate - -- versions. - currentRoot <- atomically do - currentRoot <- readTMVar rootVar - guard $ Just currentRoot /= lastRoot - notifyBranchChange (Branch.headHash currentRoot) - pure (Just currentRoot) - loop currentRoot - loop Nothing + let initialState = Cli.loopState0 ppIds eventQueue <- Q.newIO initialInputsRef <- newIORef $ Welcome.run welcome ++ initialInputs pageOutput <- newIORef True @@ -179,7 +159,8 @@ main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase getInput loopState = do currentEcho <- hGetEcho stdin liftIO $ restoreEcho currentEcho - let getProjectRoot = atomically $ readTMVar rootVar + let PP.ProjectAndBranch projId branchId = PP.toProjectAndBranch $ NonEmpty.head loopState.projectPathStack + let getProjectRoot = liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId pp <- loopStateProjectPath codebase loopState getUserInput codebase @@ -262,6 +243,9 @@ main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase -- Handle inputs until @HaltRepl@, staying in the loop on Ctrl+C or synchronous exception. let loop0 :: Cli.LoopState -> IO () loop0 s0 = do + -- It's always possible the previous command changed the branch head, so tell the LSP to check if the current + -- path or project has changed. + lspCheckForChanges (NEL.head $ Cli.projectPathStack s0) let step = do input <- awaitInput s0 (!result, resultState) <- Cli.runCli env s0 (HandleInput.loop input) @@ -279,9 +263,6 @@ main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase Text.hPutStrLn stderr ("Encountered exception:\n" <> Text.pack (displayException e)) loop0 s0 Right (Right (result, s1)) -> do - oldPP <- loopStateProjectPath codebase s0 - newPP <- loopStateProjectPath codebase s1 - when (oldPP /= newPP) (atomically . notifyPathChange $ newPP) case result of Cli.Success () -> loop0 s1 Cli.Continue -> loop0 s1 diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index fd6c15d589..f6400ae67c 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -25,7 +25,6 @@ import ArgParse ) import Compat (defaultInterruptHandler, withInterruptHandler) import Control.Concurrent (newEmptyMVar, runInUnboundThread, takeMVar) -import Control.Concurrent.STM import Control.Exception (displayException, evaluate) import Data.ByteString.Lazy qualified as BL import Data.Configurator.Types (Config) @@ -61,8 +60,6 @@ import System.IO.CodePage (withCP65001) import System.IO.Error (catchIOError) import System.IO.Temp qualified as Temp import System.Path qualified as Path -import U.Codebase.HashTags (CausalHash) -import U.Codebase.Sqlite.Operations qualified as SqliteOps import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase, CodebasePath) @@ -86,6 +83,7 @@ import Unison.CommandLine.Welcome (CodebaseInitStatus (..)) import Unison.CommandLine.Welcome qualified as Welcome import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName (..), ProjectName (..)) import Unison.LSP qualified as LSP +import Unison.LSP.Util.Signal qualified as Signal import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyTerminal qualified as PT @@ -177,8 +175,7 @@ main version = do getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do let fileEvent = Input.UnisonFileChanged (Text.pack file) contents - let noOpRootNotifier _ = pure () - let noOpPathNotifier _ = pure () + let noOpCheckForChanges _ = pure () let serverUrl = Nothing startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath launch @@ -193,8 +190,7 @@ main version = do serverUrl (PP.toIds startProjectPath) initRes - noOpRootNotifier - noOpPathNotifier + noOpCheckForChanges CommandLine.ShouldNotWatchFiles Run (RunFromPipe mainName) args -> do e <- safeReadUtf8StdIn @@ -204,8 +200,7 @@ main version = do getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do let fileEvent = Input.UnisonFileChanged (Text.pack "") contents - let noOpRootNotifier _ = pure () - let noOpPathNotifier _ = pure () + let noOpCheckForChanges _ = pure () let serverUrl = Nothing startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath launch @@ -220,8 +215,7 @@ main version = do serverUrl (PP.toIds startProjectPath) initRes - noOpRootNotifier - noOpPathNotifier + noOpCheckForChanges CommandLine.ShouldNotWatchFiles Run (RunCompiled file) args -> BL.readFile file >>= \bs -> @@ -314,22 +308,16 @@ main version = do pure $ PP.fromProjectAndBranch pab Path.absoluteEmpty Nothing -> do Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath - currentProjectRootCH <- Codebase.runTransaction theCodebase do - currentPP <- Codebase.expectCurrentProjectPath - SqliteOps.expectProjectBranchHead (currentPP.project.projectId) (currentPP.branch.branchId) - projectRootHashVar <- newTVarIO currentProjectRootCH - projectPathVar <- newTVarIO startingProjectPath - let notifyOnRootChanges :: CausalHash -> STM () - notifyOnRootChanges b = do - writeTVar projectRootHashVar b - let notifyOnPathChanges :: PP.ProjectPath -> STM () - notifyOnPathChanges = writeTVar projectPathVar + currentPP <- Codebase.runTransaction theCodebase do + PP.toIds <$> Codebase.expectCurrentProjectPath + changeSignal <- Signal.newSignalIO (Just currentPP) + let lspCheckForChanges pp = Signal.writeSignalIO changeSignal pp -- Unfortunately, the windows IO manager on GHC 8.* is prone to just hanging forever -- when waiting for input on handles, so if we listen for LSP connections it will -- prevent UCM from shutting down properly. Hopefully we can re-enable LSP on -- Windows when we move to GHC 9.* -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1224 - void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime (readTVar projectRootHashVar) (readTVar projectPathVar) + void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime changeSignal Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) codebaseServerOpts sbRuntime theCodebase $ \baseUrl -> do case exitOption of DoNotExit -> do @@ -365,8 +353,7 @@ main version = do (Just baseUrl) (PP.toIds startingProjectPath) initRes - notifyOnRootChanges - notifyOnPathChanges + lspCheckForChanges shouldWatchFiles Exit -> do Exit.exitSuccess where @@ -541,11 +528,10 @@ launch :: Maybe Server.BaseUrl -> PP.ProjectPathIds -> InitResult -> - (CausalHash -> STM ()) -> - (PP.ProjectPath -> STM ()) -> + (PP.ProjectPathIds -> IO ()) -> CommandLine.ShouldWatchFiles -> IO () -launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl startingPath initResult notifyRootChange notifyProjPathChange shouldWatchFiles = do +launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl startingPath initResult lspCheckForChanges shouldWatchFiles = do showWelcomeHint <- Codebase.runTransaction codebase Queries.doProjectsExist let isNewCodebase = case initResult of CreatedCodebase -> NewlyCreatedCodebase @@ -564,8 +550,7 @@ launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseU codebase serverBaseUrl ucmVersion - notifyRootChange - notifyProjPathChange + lspCheckForChanges shouldWatchFiles newtype MarkdownFile = MarkdownFile FilePath From d8e34c2884abf3495cc8419eb51da8101e7dea85 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 9 Jul 2024 09:52:31 -0700 Subject: [PATCH 419/631] Write new Transactional Signal type --- unison-cli/src/Unison/LSP/Util/Signal.hs | 69 ++++++++++++++++++++++++ 1 file changed, 69 insertions(+) create mode 100644 unison-cli/src/Unison/LSP/Util/Signal.hs diff --git a/unison-cli/src/Unison/LSP/Util/Signal.hs b/unison-cli/src/Unison/LSP/Util/Signal.hs new file mode 100644 index 0000000000..cce58936bc --- /dev/null +++ b/unison-cli/src/Unison/LSP/Util/Signal.hs @@ -0,0 +1,69 @@ +-- | A transactional signal type. +-- Similar to a broadcast channel, but with better memory characteristics when you only care about the latest value. +-- +-- Allows multiple consumers to detect the latest value of a signal, and to be notified when the signal changes. +module Unison.LSP.Util.Signal + ( newSignalIO, + writeSignal, + writeSignalIO, + subscribe, + Signal, + ) +where + +import Control.Monad.STM qualified as STM +import Unison.Prelude +import UnliftIO.STM + +newtype Signal a = Signal (TVar (Maybe a, Int)) + +-- | Create a new signal with an optional initial value. +newSignalIO :: (MonadIO m) => Maybe a -> m (Signal a) +newSignalIO a = do + tvar <- newTVarIO (a, 0) + pure (Signal tvar) + +writeSignal :: Signal a -> a -> STM () +writeSignal (Signal signalVar) a = do + (_, n) <- readTVar signalVar + writeTVar signalVar (Just a, succ n) + +writeSignalIO :: (MonadIO m) => Signal a -> a -> m () +writeSignalIO signal a = liftIO $ STM.atomically (writeSignal signal a) + +-- | Subscribe to a signal, returning an STM action that will read the latest value. +-- +-- >>> signal <- newSignalIO (Just "initial") +-- >>> subscriber1 <- subscribe signal +-- >>> subscriber2 <- subscribe signal +-- >>> -- Should return the initial value +-- >>> atomically (optional subscriber1) +-- >>> -- Should retry, since the signal hasn't changed. +-- >>> atomically (optional subscriber1) +-- >>> writeSignalIO signal "new value" +-- >>> -- Each subscriber should return the newest value +-- >>> ("sub1",) <$> atomically (optional subscriber1) +-- >>> ("sub2",) <$> atomically (optional subscriber2) +-- >>> -- Both should now retry +-- >>> ("sub1",) <$> atomically (optional subscriber1) +-- >>> ("sub2",) <$> atomically (optional subscriber2) +-- Just "initial" +-- Nothing +-- ("sub1",Just "new value") +-- ("sub2",Just "new value") +-- ("sub1",Nothing) +-- ("sub2",Nothing) +subscribe :: (MonadIO m) => Signal a -> m (STM a) +subscribe (Signal signalVar) = do + (_, n) <- readTVarIO signalVar + -- Start with a different n, so the subscriber will trigger on its first read. + latestNVar <- newTVarIO (pred n) + pure $ do + (mayA, newN) <- readTVar signalVar + latestN <- readTVar latestNVar + guard (newN /= latestN) + writeTVar latestNVar newN + -- Retry until we have a value. + case mayA of + Nothing -> STM.retry + Just a -> pure a From 4254a51e0615d0284486a1857a5ac1e79b6df076 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 9 Jul 2024 09:52:31 -0700 Subject: [PATCH 420/631] Update LSP to listen for changes --- unison-cli/src/Unison/LSP.hs | 23 ++++---- unison-cli/src/Unison/LSP/UCMWorker.hs | 73 ++++++++++++------------ unison-cli/src/Unison/LSP/Util/Signal.hs | 7 ++- unison-cli/unison-cli.cabal | 1 + 4 files changed, 54 insertions(+), 50 deletions(-) diff --git a/unison-cli/src/Unison/LSP.hs b/unison-cli/src/Unison/LSP.hs index 5ec56f6967..7163880956 100644 --- a/unison-cli/src/Unison/LSP.hs +++ b/unison-cli/src/Unison/LSP.hs @@ -27,7 +27,6 @@ import Language.LSP.VFS import Network.Simple.TCP qualified as TCP import System.Environment (lookupEnv) import System.IO (hPutStrLn) -import U.Codebase.HashTags import Unison.Codebase import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) @@ -47,6 +46,7 @@ import Unison.LSP.NotificationHandlers qualified as Notifications import Unison.LSP.Orphans () import Unison.LSP.Types import Unison.LSP.UCMWorker (ucmWorker) +import Unison.LSP.Util.Signal (Signal) import Unison.LSP.VFS qualified as VFS import Unison.Parser.Ann import Unison.Prelude @@ -65,10 +65,9 @@ spawnLsp :: LspFormattingConfig -> Codebase IO Symbol Ann -> Runtime Symbol -> - STM CausalHash -> - STM PP.ProjectPath -> + Signal PP.ProjectPathIds -> IO () -spawnLsp lspFormattingConfig codebase runtime latestProjectRootHash latestPath = +spawnLsp lspFormattingConfig codebase runtime signal = ifEnabled . TCP.withSocketsDo $ do lspPort <- getLspPort UnliftIO.handleIO (handleFailure lspPort) $ do @@ -88,7 +87,7 @@ spawnLsp lspFormattingConfig codebase runtime latestProjectRootHash latestPath = -- different un-saved state for the same file. initVFS $ \vfs -> do vfsVar <- newMVar vfs - void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestProjectRootHash latestPath) + void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope signal) where handleFailure :: String -> IOException -> IO () handleFailure lspPort ioerr = @@ -119,16 +118,15 @@ serverDefinition :: Codebase IO Symbol Ann -> Runtime Symbol -> Ki.Scope -> - STM CausalHash -> - STM PP.ProjectPath -> + Signal PP.ProjectPathIds -> ServerDefinition Config -serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestProjectRootHash latestPath = +serverDefinition lspFormattingConfig vfsVar codebase runtime scope signal = ServerDefinition { defaultConfig = defaultLSPConfig, configSection = "unison", parseConfig = Config.parseConfig, onConfigChange = Config.updateConfig, - doInitialize = lspDoInitialize vfsVar codebase runtime scope latestProjectRootHash latestPath, + doInitialize = lspDoInitialize vfsVar codebase runtime scope signal, staticHandlers = lspStaticHandlers lspFormattingConfig, interpretHandler = lspInterpretHandler, options = lspOptions @@ -140,12 +138,11 @@ lspDoInitialize :: Codebase IO Symbol Ann -> Runtime Symbol -> Ki.Scope -> - STM CausalHash -> - STM PP.ProjectPath -> + Signal PP.ProjectPathIds -> LanguageContextEnv Config -> Msg.TMessage 'Msg.Method_Initialize -> IO (Either Msg.ResponseError Env) -lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath lspContext _initMsg = do +lspDoInitialize vfsVar codebase runtime scope signal lspContext _initMsg = do checkedFilesVar <- newTVarIO mempty dirtyFilesVar <- newTVarIO mempty ppedCacheVar <- newEmptyTMVarIO @@ -164,7 +161,7 @@ lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath lspConte } let lspToIO = flip runReaderT lspContext . unLspT . flip runReaderT env . runLspM Ki.fork scope (lspToIO Analysis.fileAnalysisWorker) - Ki.fork scope (lspToIO $ ucmWorker ppedCacheVar currentNamesCacheVar nameSearchCacheVar currentPathCacheVar latestRootHash latestPath) + Ki.fork scope (lspToIO $ ucmWorker ppedCacheVar currentNamesCacheVar nameSearchCacheVar currentPathCacheVar signal) pure $ Right $ env -- | LSP request handlers that don't register/unregister dynamically diff --git a/unison-cli/src/Unison/LSP/UCMWorker.hs b/unison-cli/src/Unison/LSP/UCMWorker.hs index 1ad17bde36..713ce207f6 100644 --- a/unison-cli/src/Unison/LSP/UCMWorker.hs +++ b/unison-cli/src/Unison/LSP/UCMWorker.hs @@ -1,14 +1,15 @@ module Unison.LSP.UCMWorker where -import U.Codebase.HashTags import Control.Monad.Reader import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.ProjectPath (ProjectPath) -import Unison.Debug qualified as Debug +import Unison.Codebase.ProjectPath qualified as PP import Unison.LSP.Completion import Unison.LSP.Types +import Unison.LSP.Util.Signal (Signal) +import Unison.LSP.Util.Signal qualified as Signal import Unison.LSP.VFS qualified as VFS import Unison.Names (Names) import Unison.Prelude @@ -26,42 +27,42 @@ ucmWorker :: TMVar Names -> TMVar (NameSearch Sqlite.Transaction) -> TMVar ProjectPath -> - STM CausalHash -> - STM ProjectPath -> + Signal PP.ProjectPathIds -> Lsp () -ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar getLatestProjectRootHash getLatestProjectPath = do - Env {codebase, completionsVar} <- ask - let loop :: CausalHash -> ProjectPath -> Lsp a - loop currentProjectRootHash currentProjectPath = do - currentBranch <- liftIO $ Codebase.expectProjectBranchRoot codebase (currentProjectPath ^. #branch . #projectId) (currentProjectPath ^. #branch . #branchId) - Debug.debugM Debug.LSP "LSP path: " currentProjectPath - let currentBranch0 = Branch.head currentBranch - let currentNames = Branch.toNames currentBranch0 - hl <- liftIO $ Codebase.runTransaction codebase Codebase.hashLength - let pped = PPED.makePPED (PPE.hqNamer hl currentNames) (PPE.suffixifyByHash currentNames) - atomically $ do - writeTMVar currentPathVar currentProjectPath - writeTMVar currentNamesVar currentNames - writeTMVar ppedVar pped - writeTMVar nameSearchCacheVar (NameSearch.makeNameSearch hl currentNames) - -- Re-check everything with the new names and ppe - VFS.markAllFilesDirty - atomically do - writeTMVar completionsVar (namesToCompletionTree currentNames) - Debug.debugLogM Debug.LSP "LSP Initialized" - (latestRootHash, latestProjectPath) <- atomically $ do - latestRootHash <- getLatestProjectRootHash - latestPath <- getLatestProjectPath - guard $ (currentProjectRootHash /= latestRootHash || currentProjectPath /= latestPath) - pure (latestRootHash, latestPath) - Debug.debugLogM Debug.LSP "LSP Change detected" - loop latestRootHash latestProjectPath - (currentProjectRootHash, currentProjectPath) <- atomically $ do - latestProjectRootHash <- getLatestProjectRootHash - currentProjectPath <- getLatestProjectPath - pure (latestProjectRootHash, currentProjectPath) - loop currentProjectRootHash currentProjectPath +ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar changeSignal = do + signalChanges <- Signal.subscribe changeSignal + loop signalChanges Nothing where + loop :: STM PP.ProjectPathIds -> Maybe (Branch.Branch IO) -> Lsp a + loop signalChanges currentBranch = do + Env {codebase, completionsVar} <- ask + getChanges signalChanges currentBranch >>= \case + (_newPP, Nothing) -> loop signalChanges currentBranch + (newPP, Just newBranch) -> do + let newBranch0 = Branch.head newBranch + let newNames = Branch.toNames newBranch0 + hl <- liftIO $ Codebase.runTransaction codebase Codebase.hashLength + let pped = PPED.makePPED (PPE.hqNamer hl newNames) (PPE.suffixifyByHash newNames) + atomically $ do + writeTMVar currentPathVar newPP + writeTMVar currentNamesVar newNames + writeTMVar ppedVar pped + writeTMVar nameSearchCacheVar (NameSearch.makeNameSearch hl newNames) + -- Re-check everything with the new names and ppe + VFS.markAllFilesDirty + atomically do + writeTMVar completionsVar (namesToCompletionTree newNames) + loop signalChanges (Just newBranch) + -- Waits for a possible change, then checks if there's actually any difference to the branches we care about. + -- If so, returns the new branch, otherwise Nothing. + getChanges :: STM PP.ProjectPathIds -> Maybe (Branch.Branch IO) -> Lsp (ProjectPath, Maybe (Branch.Branch IO)) + getChanges signalChanges currentBranch = do + Env {codebase} <- ask + ppIds <- atomically signalChanges + pp <- liftIO . Codebase.runTransaction codebase $ Codebase.resolveProjectPathIds ppIds + atomically $ writeTMVar currentPathVar pp + newBranch <- fmap (fromMaybe Branch.empty) . liftIO $ Codebase.getBranchAtProjectPath codebase pp + pure $ (pp, if Just newBranch == currentBranch then Nothing else Just newBranch) -- This is added in stm-2.5.1, remove this if we upgrade. writeTMVar :: TMVar a -> a -> STM () writeTMVar var a = diff --git a/unison-cli/src/Unison/LSP/Util/Signal.hs b/unison-cli/src/Unison/LSP/Util/Signal.hs index cce58936bc..e06dfca111 100644 --- a/unison-cli/src/Unison/LSP/Util/Signal.hs +++ b/unison-cli/src/Unison/LSP/Util/Signal.hs @@ -23,15 +23,20 @@ newSignalIO a = do tvar <- newTVarIO (a, 0) pure (Signal tvar) +-- | Update the value of a signal, notifying all subscribers (even if the value didn't change) writeSignal :: Signal a -> a -> STM () writeSignal (Signal signalVar) a = do (_, n) <- readTVar signalVar writeTVar signalVar (Just a, succ n) +-- | Update the value of a signal, notifying all subscribers (even if the value didn't change) writeSignalIO :: (MonadIO m) => Signal a -> a -> m () writeSignalIO signal a = liftIO $ STM.atomically (writeSignal signal a) --- | Subscribe to a signal, returning an STM action that will read the latest value. +-- | Subscribe to a signal, returning an STM action which will read the latest NEW value, +-- after successfully reading a new value, subsequent reads will retry until there's a new value written to the signal. +-- +-- Each independent reader should have its own subscription. -- -- >>> signal <- newSignalIO (Just "initial") -- >>> subscriber1 <- subscribe signal diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index e7e1f6ce0a..a7801b23e7 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -140,6 +140,7 @@ library Unison.LSP.Queries Unison.LSP.Types Unison.LSP.UCMWorker + Unison.LSP.Util.Signal Unison.LSP.VFS Unison.Main Unison.Share.Codeserver From c156ba75c81fbff5ac4a18d8267b175f65fdff26 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 9 Jul 2024 14:39:09 -0700 Subject: [PATCH 421/631] Add isTranscriptTest to Cli.Env --- unison-cli/src/Unison/Cli/Monad.hs | 5 ++++- unison-cli/src/Unison/Codebase/TranscriptParser.hs | 11 +++++++---- unison-cli/src/Unison/CommandLine/Main.hs | 3 ++- unison-cli/src/Unison/Main.hs | 3 ++- unison-cli/transcripts/Transcripts.hs | 3 ++- 5 files changed, 17 insertions(+), 8 deletions(-) diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index efefd1906e..2dae6a07f7 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -177,7 +177,10 @@ data Env = Env sandboxedRuntime :: Runtime Symbol, nativeRuntime :: Runtime Symbol, serverBaseUrl :: Maybe Server.BaseUrl, - ucmVersion :: UCMVersion + ucmVersion :: UCMVersion, + -- | Whether we're running in a transcript test or not. + -- Avoid using this except when absolutely necessary. + isTranscriptTest :: Bool } deriving stock (Generic) diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/TranscriptParser.hs index ffb0c4c20a..b20378c5e2 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/unison-cli/src/Unison/Codebase/TranscriptParser.hs @@ -195,19 +195,20 @@ type TranscriptRunner = withTranscriptRunner :: forall m r. (UnliftIO.MonadUnliftIO m) => + Bool {- Whether to treat this transcript run as a transcript test, which will try to make output deterministic -} -> Verbosity -> UCMVersion -> FilePath -> Maybe FilePath -> (TranscriptRunner -> m r) -> m r -withTranscriptRunner verbosity ucmVersion nrtp configFile action = do +withTranscriptRunner isTest verbosity ucmVersion nrtp configFile action = do withRuntimes nrtp \runtime sbRuntime nRuntime -> withConfig \config -> do action \transcriptName transcriptSrc (codebaseDir, codebase) -> do Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) Server.defaultCodebaseServerOpts runtime codebase \baseUrl -> do let parsed = parse transcriptName transcriptSrc result <- for parsed \stanzas -> do - liftIO $ run verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime config ucmVersion (tShow baseUrl) + liftIO $ run isTest verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime config ucmVersion (tShow baseUrl) pure $ join @(Either TranscriptError) result where withRuntimes :: @@ -232,6 +233,7 @@ withTranscriptRunner verbosity ucmVersion nrtp configFile action = do (\(config, _cancelConfig) -> action (Just config)) run :: + Bool {- Whether to treat this transcript run as a transcript test, which will try to make output deterministic -} -> Verbosity -> FilePath -> [Stanza] -> @@ -243,7 +245,7 @@ run :: UCMVersion -> Text -> IO (Either TranscriptError Text) -run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion baseURL = UnliftIO.try do +run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion baseURL = UnliftIO.try do httpManager <- HTTP.newManager HTTP.defaultManagerSettings (initialPP, emptyCausalHashId) <- Codebase.runTransaction codebase do (_, emptyCausalHashId) <- Codebase.emptyCausalHash @@ -550,7 +552,8 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion sandboxedRuntime = sbRuntime, nativeRuntime = nRuntime, serverBaseUrl = Nothing, - ucmVersion + ucmVersion, + isTranscriptTest = isTest } let loop :: Cli.LoopState -> IO Text diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 8067cf463b..914581664b 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -234,7 +234,8 @@ main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase sandboxedRuntime = sbRuntime, nativeRuntime = nRuntime, serverBaseUrl, - ucmVersion + ucmVersion, + isTranscriptTest = False } (onInterrupt, waitForInterrupt) <- buildInterruptHandler diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index f6400ae67c..ca74688fd6 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -425,7 +425,8 @@ runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles configFilePath <- getConfigFilePath mcodepath -- We don't need to create a codebase through `getCodebaseOrExit` as we've already done so previously. and <$> getCodebaseOrExit (Just (DontCreateCodebaseWhenMissing transcriptDir)) (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, codebasePath, theCodebase) -> do - TR.withTranscriptRunner Verbosity.Verbose (Version.gitDescribeWithDate version) nativeRtp (Just configFilePath) $ \runTranscript -> do + let isTest = False + TR.withTranscriptRunner isTest Verbosity.Verbose (Version.gitDescribeWithDate version) nativeRtp (Just configFilePath) $ \runTranscript -> do for markdownFiles $ \(MarkdownFile fileName) -> do transcriptSrc <- readUtf8 fileName result <- runTranscript fileName transcriptSrc (codebasePath, theCodebase) diff --git a/unison-cli/transcripts/Transcripts.hs b/unison-cli/transcripts/Transcripts.hs index 56a3394086..5810df590f 100644 --- a/unison-cli/transcripts/Transcripts.hs +++ b/unison-cli/transcripts/Transcripts.hs @@ -47,7 +47,8 @@ testBuilder :: Test () testBuilder expectFailure recordFailure runtimePath dir prelude transcript = scope transcript $ do outputs <- io . withTemporaryUcmCodebase SC.init Verbosity.Silent "transcript" SC.DoLock $ \(codebasePath, codebase) -> do - withTranscriptRunner Verbosity.Silent "TODO: pass version here" runtimePath Nothing \runTranscript -> do + let isTest = True + withTranscriptRunner isTest Verbosity.Silent "TODO: pass version here" runtimePath Nothing \runTranscript -> do for files \filePath -> do transcriptSrc <- readUtf8 filePath out <- silence $ runTranscript filePath transcriptSrc (codebasePath, codebase) From 6fe6d673d2585039c3ea3e52a33a8f9d1d06c37f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 9 Jul 2024 14:45:11 -0700 Subject: [PATCH 422/631] Omit times from project reflogs --- .../Codebase/Editor/HandleInput/Reflogs.hs | 8 +++- .../src/Unison/Codebase/Editor/Output.hs | 5 ++- .../src/Unison/CommandLine/OutputMessages.hs | 15 +++++-- unison-src/transcripts/reflog.output.md | 44 +++++++++---------- unison-src/transcripts/reset.output.md | 12 ++--- 5 files changed, 49 insertions(+), 35 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs index 23c0841d39..f2006dca7e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Reflogs.hs @@ -6,6 +6,7 @@ module Unison.Codebase.Editor.HandleInput.Reflogs ) where +import Control.Monad.Reader import Data.Time (getCurrentTime) import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.Project (Project) @@ -52,5 +53,8 @@ reflogHelper getEntries = do if length entries == numEntriesToShow then Output.MoreEntriesThanShown else Output.AllEntriesShown - now <- liftIO getCurrentTime - Cli.respondNumbered $ Output.ShowProjectBranchReflog now moreEntriesToLoad entries + mayNow <- + asks Cli.isTranscriptTest >>= \case + True -> pure Nothing + False -> Just <$> liftIO getCurrentTime + Cli.respondNumbered $ Output.ShowProjectBranchReflog mayNow moreEntriesToLoad entries diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 330a350a11..03c3519937 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -154,7 +154,10 @@ data NumberedOutput PPE.PrettyPrintEnv -- PPE containing names for everything from the root namespace. ProjectPath -- The namespace we're checking dependencies for. (Map LabeledDependency (Set Name)) -- Mapping of external dependencies to their local dependents. - | ShowProjectBranchReflog UTCTime {- current time -} MoreEntriesThanShown [ProjectReflog.Entry Project ProjectBranch (CausalHash, SCH.ShortCausalHash)] + | ShowProjectBranchReflog + (Maybe UTCTime {- current time, omitted in transcript tests to be more deterministic -}) + MoreEntriesThanShown + [ProjectReflog.Entry Project ProjectBranch (CausalHash, SCH.ShortCausalHash)] data TodoOutput = TodoOutput { dependentsOfTodo :: !(Set TermReferenceId), diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 95d58d9262..3a05508c25 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -3389,19 +3389,19 @@ listDependentsOrDependencies ppe labelStart label lds types terms = c = P.syntaxToColor displayProjectBranchReflogEntries :: - UTCTime -> + Maybe UTCTime -> E.MoreEntriesThanShown -> [ProjectReflog.Entry Project ProjectBranch (CausalHash, ShortCausalHash)] -> (Pretty, NumberedArgs) displayProjectBranchReflogEntries _ _ [] = (P.warnCallout "The reflog is empty", mempty) -displayProjectBranchReflogEntries now _ entries = +displayProjectBranchReflogEntries mayNow _ entries = let (entryRows, numberedArgs) = foldMap renderEntry entries rendered = P.lines [ header, "", - P.numberedColumnNHeader ["Branch", "When", "Hash", "Description"] entryRows + P.numberedColumnNHeader (["Branch"] <> Monoid.whenM (isJust mayNow) ["When"] <> ["Hash", "Description"]) entryRows ] in (rendered, numberedArgs) where @@ -3416,7 +3416,14 @@ displayProjectBranchReflogEntries now _ entries = ] renderEntry :: ProjectReflog.Entry Project ProjectBranch (CausalHash, SCH.ShortCausalHash) -> ([[Pretty]], NumberedArgs) renderEntry ProjectReflog.Entry {time, project, branch, toRootCausalHash = (toCH, toSCH), reason} = - ([[prettyProjectAndBranchName $ ProjectAndBranch project.name branch.name, prettyHumanReadableTime now time, P.blue (prettySCH toSCH), P.text $ truncateReason reason]], [SA.Namespace toCH]) + ( [ [prettyProjectAndBranchName $ ProjectAndBranch project.name branch.name] + <> ( mayNow + & foldMap (\now -> [prettyHumanReadableTime now time]) + ) + <> [P.blue (prettySCH toSCH), P.text $ truncateReason reason] + ], + [SA.Namespace toCH] + ) truncateReason :: Text -> Text truncateReason txt = case Text.splitAt 60 txt of (short, "") -> short diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index 22e359c0f6..05d59d0f2d 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -81,11 +81,11 @@ scratch/main> reflog Tip: Use `diff.namespace 1 7` to compare between points in history. - Branch When Hash Description - 1. scratch/main now #6mdl5gruh5 add - 2. scratch/main now #3rqf1hbev7 add - 3. scratch/main now #ms9lggs2rg builtins.merge scratch/main:.lib.builtins - 4. scratch/main now #sg60bvjo91 Project Created + Branch Hash Description + 1. scratch/main #6mdl5gruh5 add + 2. scratch/main #3rqf1hbev7 add + 3. scratch/main #ms9lggs2rg builtins.merge scratch/main:.lib.builtins + 4. scratch/main #sg60bvjo91 Project Created ``` Should see reflog entries from the current project @@ -100,13 +100,13 @@ scratch/main> project.reflog Tip: Use `diff.namespace 1 7` to compare between points in history. - Branch When Hash Description - 1. scratch/other now #148flqs4b1 alias.term scratch/other:..y scratch/other:.z - 2. scratch/other now #6mdl5gruh5 Branch created from scratch/main - 3. scratch/main now #6mdl5gruh5 add - 4. scratch/main now #3rqf1hbev7 add - 5. scratch/main now #ms9lggs2rg builtins.merge scratch/main:.lib.builtins - 6. scratch/main now #sg60bvjo91 Project Created + Branch Hash Description + 1. scratch/other #148flqs4b1 alias.term scratch/other:..y scratch/other:.z + 2. scratch/other #6mdl5gruh5 Branch created from scratch/main + 3. scratch/main #6mdl5gruh5 add + 4. scratch/main #3rqf1hbev7 add + 5. scratch/main #ms9lggs2rg builtins.merge scratch/main:.lib.builtins + 6. scratch/main #sg60bvjo91 Project Created ``` Should see reflog entries from all projects @@ -121,15 +121,15 @@ scratch/main> reflog.global Tip: Use `diff.namespace 1 7` to compare between points in history. - Branch When Hash Description - 1. newproject/main now #2rjhs2vq43 alias.term newproject/main:.lib.builtins.Nat newproject/main... - 2. newproject/main now #ms9lggs2rg builtins.merge newproject/main:.lib.builtins - 3. newproject/main now #sg60bvjo91 Branch Created - 4. scratch/other now #148flqs4b1 alias.term scratch/other:..y scratch/other:.z - 5. scratch/other now #6mdl5gruh5 Branch created from scratch/main - 6. scratch/main now #6mdl5gruh5 add - 7. scratch/main now #3rqf1hbev7 add - 8. scratch/main now #ms9lggs2rg builtins.merge scratch/main:.lib.builtins - 9. scratch/main now #sg60bvjo91 Project Created + Branch Hash Description + 1. newproject/main #2rjhs2vq43 alias.term newproject/main:.lib.builtins.Nat newproject/main... + 2. newproject/main #ms9lggs2rg builtins.merge newproject/main:.lib.builtins + 3. newproject/main #sg60bvjo91 Branch Created + 4. scratch/other #148flqs4b1 alias.term scratch/other:..y scratch/other:.z + 5. scratch/other #6mdl5gruh5 Branch created from scratch/main + 6. scratch/main #6mdl5gruh5 add + 7. scratch/main #3rqf1hbev7 add + 8. scratch/main #ms9lggs2rg builtins.merge scratch/main:.lib.builtins + 9. scratch/main #sg60bvjo91 Project Created ``` diff --git a/unison-src/transcripts/reset.output.md b/unison-src/transcripts/reset.output.md index 7cfac62e4e..c77269deaf 100644 --- a/unison-src/transcripts/reset.output.md +++ b/unison-src/transcripts/reset.output.md @@ -83,12 +83,12 @@ scratch/main> reflog Tip: Use `diff.namespace 1 7` to compare between points in history. - Branch When Hash Description - 1. scratch/main now #ujvq6e87kp reset ujvq6e87kp4288eq3al9v5luctic0ocd7ug1fu0go5bicrr2vfnrb0... - 2. scratch/main now #5vq851j3hg update - 3. scratch/main now #ujvq6e87kp update - 4. scratch/main now #4bigcpnl7t builtins.merge - 5. scratch/main now #sg60bvjo91 Project Created + Branch Hash Description + 1. scratch/main #ujvq6e87kp reset ujvq6e87kp4288eq3al9v5luctic0ocd7ug1fu0go5bicrr2vfnrb0... + 2. scratch/main #5vq851j3hg update + 3. scratch/main #ujvq6e87kp update + 4. scratch/main #4bigcpnl7t builtins.merge + 5. scratch/main #sg60bvjo91 Project Created -- Reset the current branch to the first history element scratch/main> reset 2 From 1e5b925bcab2662eefd3b943a0b51e4a23d0fc66 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 9 Jul 2024 18:19:32 -0400 Subject: [PATCH 423/631] adjust some output --- .../src/Unison/CommandLine/OutputMessages.hs | 77 +++++++++++++------ unison-src/transcripts/todo.output.md | 18 +++-- 2 files changed, 65 insertions(+), 30 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index d2684f1906..4bc0ea47ab 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2686,7 +2686,7 @@ handleTodoOutput todo & P.syntaxToColor pure (formatNum n <> name) pure $ - P.wrap "These terms call `todo`." + P.wrap "These terms call `todo`:" <> P.newline <> P.newline <> P.indentN 2 (P.lines terms) @@ -2700,7 +2700,7 @@ handleTodoOutput todo n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term))) pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen term)) pure $ - P.wrap "These terms do not have any names in the current namespace." + P.wrap "These terms do not have any names in the current namespace:" <> P.newline <> P.newline <> P.indentN 2 (P.lines terms) @@ -2714,7 +2714,7 @@ handleTodoOutput todo n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ))) pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen typ)) pure $ - P.wrap "These types do not have any names in the current namespace." + P.wrap "These types do not have any names in the current namespace:" <> P.newline <> P.newline <> P.indentN 2 (P.lines types) @@ -2765,33 +2765,47 @@ handleTodoOutput todo & map ( \(typeName, prettyCon1, prettyCon2) -> -- Note [ConstructorAliasMessage] If you change this, also change the other similar one - P.wrap - ( "The type" - <> prettyName typeName - <> "has a constructor with multiple names. Please delete all but one name for each" - <> "constructor." - ) + P.wrap ("The type" <> prettyName typeName <> "has a constructor with multiple names.") <> P.newline <> P.newline <> P.indentN 2 (P.lines [prettyCon1, prettyCon2]) + <> P.newline + <> P.newline + <> P.wrap "Please delete all but one name for each constructor." ) & P.sep "\n\n" prettyMissingConstructorNames <- - case todo.incoherentDeclReasons.missingConstructorNames of - [] -> pure mempty - types0 -> do - types1 <- + case NEList.nonEmpty todo.incoherentDeclReasons.missingConstructorNames of + Nothing -> pure mempty + Just types0 -> do + stuff <- for types0 \typ -> do n <- addNumberedArg (SA.Name typ) - pure (formatNum n <> prettyName typ) + pure (n, typ) -- Note [MissingConstructorNameMessage] If you change this, also change the other similar one pure $ P.wrap "These types have some constructors with missing names." <> P.newline <> P.newline - <> P.indentN 2 (P.lines types1) + <> P.indentN 2 (P.lines (fmap (\(n, typ) -> formatNum n <> prettyName typ) stuff)) + <> P.newline + <> P.newline + <> P.wrap + ( "You can use" + <> IP.makeExample + IP.view + [ let firstNum = fst (NEList.head stuff) + lastNum = fst (NEList.last stuff) + in if firstNum == lastNum + then P.string (show firstNum) + else P.string (show firstNum) <> "-" <> P.string (show lastNum) + ] + <> "and" + <> IP.makeExample IP.aliasTerm ["", "."] + <> "to give names to each unnamed constructor." + ) prettyNestedDeclAliases <- case todo.incoherentDeclReasons.nestedDeclAliases of @@ -2820,20 +2834,33 @@ handleTodoOutput todo prettyStrayConstructors <- case todo.incoherentDeclReasons.strayConstructors of [] -> pure mempty - constructors0 -> do - constructors1 <- - for constructors0 \constructor -> do - n <- addNumberedArg (SA.Name constructor) - pure (formatNum n <> prettyName constructor) + constructors -> do + nums <- + for constructors \constructor -> do + addNumberedArg (SA.Name constructor) -- Note [StrayConstructorMessage] If you change this, also change the other similar one pure $ - P.wrap - ( "These constructors are not nested beneath their corresponding type names. Please either move or" - <> "delete them." - ) + P.wrap "These constructors are not nested beneath their corresponding type names:" <> P.newline <> P.newline - <> P.indentN 2 (P.lines constructors1) + <> P.indentN + 2 + ( P.lines + ( zipWith + (\n constructor -> formatNum n <> prettyName constructor) + nums + constructors + ) + ) + <> P.newline + <> P.newline + <> P.wrap + ( "For each one, please either use" + <> IP.makeExample' IP.moveAll + <> "to move if, or if it's an extra copy, you can simply" + <> IP.makeExample' IP.delete + <> "it." + ) (pure . P.sep "\n\n" . P.nonEmpty) [ prettyDependentsOfTodo, diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index 38c6cdb560..dbc5de7220 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -44,7 +44,7 @@ scratch/main> add scratch/main> todo - These terms call `todo`. + These terms call `todo`: 1. foo @@ -95,7 +95,7 @@ scratch/main> delete.namespace.force foo scratch/main> todo - These terms do not have any names in the current namespace. + These terms do not have any names in the current namespace: 1. #1jujb8oelv @@ -215,11 +215,12 @@ scratch/main> alias.term Foo.One Foo.Two scratch/main> todo - The type Foo has a constructor with multiple names. Please - delete all but one name for each constructor. + The type Foo has a constructor with multiple names. 1. Foo.One 2. Foo.Two + + Please delete all but one name for each constructor. ``` # Missing constructor names @@ -259,6 +260,10 @@ scratch/main> todo These types have some constructors with missing names. 1. Foo + + You can use `view 1` and + `alias.term .` to give names + to each unnamed constructor. ``` # Nested decl aliases @@ -336,8 +341,11 @@ scratch/main> alias.term Foo.Bar Baz scratch/main> todo These constructors are not nested beneath their corresponding - type names. Please either move or delete them. + type names: 1. Baz + + For each one, please either use `move` to move if, or if it's + an extra copy, you can simply `delete` it. ``` From 951f31867d78f66ca196f18464e24e2ca65e6ef0 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 9 Jul 2024 14:52:38 -0700 Subject: [PATCH 424/631] preload branches into the branch cache when switching projects --- parser-typechecker/src/Unison/Codebase.hs | 9 ++++++ .../src/Unison/Codebase/SqliteCodebase.hs | 17 ++++++++++- .../SqliteCodebase/ProjectRootCache.hs | 28 +++++++++++++++++++ .../src/Unison/Codebase/Type.hs | 7 ++++- .../unison-parser-typechecker.cabal | 1 + unison-cli/src/Unison/Cli/Monad.hs | 10 ++----- unison-cli/tests/Unison/Test/Cli/Monad.hs | 3 +- 7 files changed, 63 insertions(+), 12 deletions(-) create mode 100644 parser-typechecker/src/Unison/Codebase/SqliteCodebase/ProjectRootCache.hs diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index d8b372f81c..6187f05648 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -59,6 +59,7 @@ module Unison.Codebase getShallowProjectRootByNames, expectProjectBranchRoot, getBranchAtProjectPath, + preloadProjectBranch, -- * Root branch SqliteCodebase.Operations.namesAtPath, @@ -579,3 +580,11 @@ resolveProjectPathIds (PP.ProjectPath projectId projectBranchId path) = do proj <- Q.expectProject projectId projBranch <- Q.expectProjectBranch projectId projectBranchId pure $ PP.ProjectPath proj projBranch path + +-- | Starts loading the given project branch into cache in a background thread without blocking. +preloadProjectBranch :: (MonadUnliftIO m) => Codebase m v a -> ProjectAndBranch Db.ProjectId Db.ProjectBranchId -> m () +preloadProjectBranch codebase (ProjectAndBranch projectId branchId) = do + ch <- runTransaction codebase $ do + causalHashId <- Q.expectProjectBranchHead projectId branchId + Q.expectCausalHash causalHashId + preloadProjectRoot codebase ch diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs index 1b15f79677..045a310199 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs @@ -39,6 +39,7 @@ import Unison.Codebase.SqliteCodebase.Branch.Dependencies qualified as BD import Unison.Codebase.SqliteCodebase.Migrations qualified as Migrations import Unison.Codebase.SqliteCodebase.Operations qualified as CodebaseOps import Unison.Codebase.SqliteCodebase.Paths +import Unison.Codebase.SqliteCodebase.ProjectRootCache qualified as ProjectRootCache import Unison.Codebase.SqliteCodebase.SyncEphemeral qualified as SyncEphemeral import Unison.Codebase.Type (LocalOrRemote (..)) import Unison.Codebase.Type qualified as C @@ -57,6 +58,8 @@ import Unison.Type (Type) import Unison.Util.Timing (time) import Unison.WatchKind qualified as UF import UnliftIO (UnliftIO (..), finally) +import UnliftIO qualified as UnliftIO +import UnliftIO.Concurrent qualified as UnliftIO import UnliftIO.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist) import UnliftIO.STM @@ -162,6 +165,7 @@ sqliteCodebase :: m (Either Codebase1.OpenCodebaseError r) sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action = handleLockOption do branchCache <- newBranchCache + projectRootCache <- ProjectRootCache.newProjectRootCache 5 {- Cache the last n project roots for quick switching. -} getDeclType <- CodebaseOps.makeCachedTransaction 2048 CodebaseOps.getDeclType -- The v1 codebase interface has operations to read and write individual definitions -- whereas the v2 codebase writes them as complete components. These two fields buffer @@ -242,6 +246,16 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action withRunInIO \runInIO -> runInIO (runTransaction (CodebaseOps.putBranch (Branch.transform (Sqlite.unsafeIO . runInIO) branch))) + preloadProjectRoot :: CausalHash -> m () + preloadProjectRoot h = do + void . UnliftIO.forkIO $ void $ do + getBranchForHash h >>= \case + Nothing -> pure () + Just b -> do + ProjectRootCache.stashBranch projectRootCache b + UnliftIO.evaluate b + pure () + syncFromDirectory :: Codebase1.CodebasePath -> Branch m -> m () syncFromDirectory srcRoot b = withConnection (debugName ++ ".sync.src") srcRoot \srcConn -> @@ -307,7 +321,8 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action filterTermsByReferentIdHavingTypeImpl, termReferentsByPrefix = referentsByPrefix, withConnection = withConn, - withConnectionIO = withConnection debugName root + withConnectionIO = withConnection debugName root, + preloadProjectRoot } Right <$> action codebase where diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/ProjectRootCache.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/ProjectRootCache.hs new file mode 100644 index 0000000000..9dd6f604aa --- /dev/null +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/ProjectRootCache.hs @@ -0,0 +1,28 @@ +-- | Simple cache which just keeps the last n relevant project branches in memory. +-- The Branch Cache handles all the lookups of the actual branch data by hash, this cache serves only to keep the last +-- n accessed branches in memory so they don't get garbage collected. See the Branch Cache for more context. +-- +-- This speeds up switching back and forth between project branches, and also serves to keep the current project branch +-- in memory so it won't be cleaned up by the Branch Cache, since the Branch Cache only keeps +-- a weak reference to the current branch and we no longer keep the actual branch in LoopState. +module Unison.Codebase.SqliteCodebase.ProjectRootCache + ( newProjectRootCache, + stashBranch, + ) +where + +import Control.Concurrent.STM +import Unison.Codebase.Branch +import Unison.Prelude + +data ProjectRootCache m = ProjectRootCache {capacity :: Int, cached :: TVar [Branch m]} + +newProjectRootCache :: (MonadIO m) => Int -> m (ProjectRootCache n) +newProjectRootCache capacity = do + var <- liftIO $ newTVarIO [] + pure (ProjectRootCache capacity var) + +stashBranch :: (MonadIO n) => ProjectRootCache m -> Branch m -> n () +stashBranch ProjectRootCache {capacity, cached} branch = do + liftIO . atomically $ do + modifyTVar cached $ \branches -> take capacity (branch : filter (/= branch) branches) diff --git a/parser-typechecker/src/Unison/Codebase/Type.hs b/parser-typechecker/src/Unison/Codebase/Type.hs index c177dde4ae..f89fe8381c 100644 --- a/parser-typechecker/src/Unison/Codebase/Type.hs +++ b/parser-typechecker/src/Unison/Codebase/Type.hs @@ -80,7 +80,12 @@ data Codebase m v a = Codebase -- | Acquire a new connection to the same underlying database file this codebase object connects to. withConnection :: forall x. (Sqlite.Connection -> m x) -> m x, -- | Acquire a new connection to the same underlying database file this codebase object connects to. - withConnectionIO :: forall x. (Sqlite.Connection -> IO x) -> IO x + withConnectionIO :: forall x. (Sqlite.Connection -> IO x) -> IO x, + -- | This optimization allows us to pre-fetch a branch from SQLite into the branch cache when we know we'll need it + -- soon, but not immediately. E.g. the user has switched a branch, but hasn't run any commands on it yet. + -- + -- This combinator returns immediately, but warms the cache in the background with the desired branch. + preloadProjectRoot :: CausalHash -> m () } -- | Whether a codebase is local or remote. diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 7139bd1d02..43f2b17634 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -81,6 +81,7 @@ library Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema7To8 Unison.Codebase.SqliteCodebase.Operations Unison.Codebase.SqliteCodebase.Paths + Unison.Codebase.SqliteCodebase.ProjectRootCache Unison.Codebase.SqliteCodebase.SyncEphemeral Unison.Codebase.TermEdit Unison.Codebase.TermEdit.Typing diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index 2dae6a07f7..398982889c 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -94,8 +94,6 @@ import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Type (Type) import Unison.UnisonFile qualified as UF -import UnliftIO qualified -import UnliftIO.Concurrent qualified as UnliftIO import Unsafe.Coerce (unsafeCoerce) -- | The main command-line app monad. @@ -392,17 +390,13 @@ cd path = do #projectPathStack %= NonEmpty.cons newPP switchProject :: ProjectAndBranch ProjectId ProjectBranchId -> Cli () -switchProject (ProjectAndBranch projectId branchId) = do +switchProject pab@(ProjectAndBranch projectId branchId) = do Env {codebase} <- ask let newPP = PP.ProjectPath projectId branchId Path.absoluteEmpty #projectPathStack %= NonEmpty.cons newPP runTransaction $ do Q.setMostRecentBranch projectId branchId setMostRecentProjectPath newPP - -- Prime the cache with the new project branch root so it's ready when a command needs it. - void . liftIO . UnliftIO.forkIO $ do - b <- Codebase.expectProjectBranchRoot codebase projectId branchId - -- Force the branch in the background thread to avoid delays later. - void $ UnliftIO.evaluate b + liftIO $ Codebase.preloadProjectBranch codebase pab -- | Pop the latest path off the stack, if it's not the only path in the stack. -- diff --git a/unison-cli/tests/Unison/Test/Cli/Monad.hs b/unison-cli/tests/Unison/Test/Cli/Monad.hs index 7aa02dd69b..ba541e49f8 100644 --- a/unison-cli/tests/Unison/Test/Cli/Monad.hs +++ b/unison-cli/tests/Unison/Test/Cli/Monad.hs @@ -36,8 +36,7 @@ dummyEnv = undefined dummyLoopState :: Cli.LoopState dummyLoopState = Cli.LoopState - { currentProjectRoot = undefined, - projectPathStack = undefined, + { projectPathStack = undefined, latestFile = Nothing, latestTypecheckedFile = Nothing, lastInput = Nothing, From d78154d7c186c967a9eb12c0b661bd15427b663c Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 9 Jul 2024 18:58:42 -0400 Subject: [PATCH 425/631] better rendering of conflicted names in `todo` --- .../src/Unison/CommandLine/OutputMessages.hs | 25 ++++++++++--------- unison-src/transcripts/todo.output.md | 6 +++-- 2 files changed, 17 insertions(+), 14 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 4bc0ea47ab..ef088071d4 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2593,20 +2593,20 @@ unsafePrettyTermResultSig' ppe = \case head (TypePrinter.prettySignaturesCT ppe [(r, name, typ)]) _ -> error "Don't pass Nothing" -renderNameConflicts :: PPE.PrettyPrintEnv -> Names -> Numbered Pretty -renderNameConflicts ppe conflictedNames = do +renderNameConflicts :: Int -> Names -> Numbered Pretty +renderNameConflicts hashLen conflictedNames = do let conflictedTypeNames :: Map Name [HQ.HashQualified Name] conflictedTypeNames = conflictedNames & Names.types & R.domain - & fmap (foldMap (pure @[] . PPE.typeName ppe)) + & Map.mapWithKey \name -> map (HQ.take hashLen . HQ.HashQualified name . Reference.toShortHash) . Set.toList let conflictedTermNames :: Map Name [HQ.HashQualified Name] conflictedTermNames = conflictedNames & Names.terms & R.domain - & fmap (foldMap (pure @[] . PPE.termName ppe)) + & Map.mapWithKey \name -> map (HQ.take hashLen . HQ.HashQualified name . Referent.toShortHash) . Set.toList let allConflictedNames :: [Name] allConflictedNames = Set.toList (Map.keysSet conflictedTermNames <> Map.keysSet conflictedTypeNames) prettyConflictedTypes <- showConflictedNames "type" conflictedTypeNames @@ -2639,13 +2639,14 @@ renderNameConflicts ppe conflictedNames = do prettyConflicts <- for hashes \hash -> do n <- addNumberedArg $ SA.HashQualified hash pure $ formatNum n <> (P.blue . P.syntaxToColor . prettyHashQualified $ hash) - pure . P.wrap $ - ( "The " - <> thingKind - <> " " - <> P.green (prettyName name) - <> " has conflicting definitions:" - ) + pure $ + P.wrap + ( "The " + <> thingKind + <> " " + <> P.green (prettyName name) + <> " has conflicting definitions:" + ) <> P.newline <> P.newline <> P.indentN 2 (P.lines prettyConflicts) @@ -2722,7 +2723,7 @@ handleTodoOutput todo prettyConflicts <- if todo.nameConflicts == mempty then pure mempty - else renderNameConflicts todo.ppe.unsuffixifiedPPE todo.nameConflicts + else renderNameConflicts todo.hashLen todo.nameConflicts let prettyDefnsInLib = if todo.defnsInLib diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index dbc5de7220..639de4e524 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -139,8 +139,10 @@ scratch/main> todo ❓ - The term bar has conflicting definitions: 1. foo 2. - bar#cq22mm4sca + The term bar has conflicting definitions: + + 1. bar#14ibahkll6 + 2. bar#cq22mm4sca Tip: Use `move.term` or `delete.term` to resolve the conflicts. From 09ecc74ce0440a3bfe89702630da4926bb3ebe19 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 9 Jul 2024 15:54:22 -0700 Subject: [PATCH 426/631] Fix test build --- unison-cli/tests/Unison/Test/Ucm.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/unison-cli/tests/Unison/Test/Ucm.hs b/unison-cli/tests/Unison/Test/Ucm.hs index 54655cfe29..7fdca8710b 100644 --- a/unison-cli/tests/Unison/Test/Ucm.hs +++ b/unison-cli/tests/Unison/Test/Ucm.hs @@ -66,7 +66,8 @@ runTranscript :: Codebase -> Transcript -> IO TranscriptOutput runTranscript (Codebase codebasePath fmt) transcript = do let err e = fail $ "Parse error: \n" <> show e cbInit = case fmt of CodebaseFormat2 -> SC.init - TR.withTranscriptRunner Verbosity.Silent "Unison.Test.Ucm.runTranscript Invalid Version String" rtp configFile $ \runner -> do + let isTest = True + TR.withTranscriptRunner isTest Verbosity.Silent "Unison.Test.Ucm.runTranscript Invalid Version String" rtp configFile $ \runner -> do result <- Codebase.Init.withOpenCodebase cbInit "transcript" codebasePath SC.DoLock SC.DontMigrate \codebase -> do Codebase.runTransaction codebase (Codebase.installUcmDependencies codebase) let transcriptSrc = stripMargin . Text.pack $ unTranscript transcript From 15431602ac03b5d6323b736b43f5725d75bb83ea Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 10 Jul 2024 09:52:23 -0700 Subject: [PATCH 427/631] Revive move-branch confirmations --- .../src/Unison/Codebase/Editor/HandleInput.hs | 6 ++++-- .../Unison/Codebase/Editor/HandleInput/MoveAll.hs | 6 +++--- .../Codebase/Editor/HandleInput/MoveBranch.hs | 15 +++++++++------ 3 files changed, 16 insertions(+), 11 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index b124a69516..fe04d2cf0f 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -328,8 +328,9 @@ loop e = do (ppe, diff) <- diffHelper beforeBranch0 afterBranch0 Cli.respondNumbered (ShowDiffNamespace beforeLoc afterLoc ppe diff) MoveBranchI src' dest' -> do + hasConfirmed <- confirmedCommand input description <- inputDescription input - doMoveBranch description src' dest' + doMoveBranch description hasConfirmed src' dest' SwitchBranchI path' -> do path <- Cli.resolvePath' path' branchExists <- Cli.branchExistsAtPath' path' @@ -566,8 +567,9 @@ loop e = do MoveTermI src' dest' -> doMoveTerm src' dest' =<< inputDescription input MoveTypeI src' dest' -> doMoveType src' dest' =<< inputDescription input MoveAllI src' dest' -> do + hasConfirmed <- confirmedCommand input desc <- inputDescription input - handleMoveAll src' dest' desc + handleMoveAll hasConfirmed src' dest' desc DeleteI dtarget -> do pp <- Cli.getCurrentProjectPath let getTerms (absPath, seg) = Cli.getTermsAt (set PP.absPath_ absPath pp, seg) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs index 69b435529e..f8068a67f2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveAll.hs @@ -11,9 +11,9 @@ import Unison.Codebase.Path qualified as Path import Unison.HashQualified' qualified as HQ' import Unison.Prelude -handleMoveAll :: Path.Path' -> Path.Path' -> Text -> Cli () -handleMoveAll src' dest' description = do - moveBranchFunc <- moveBranchFunc src' dest' +handleMoveAll :: Bool -> Path.Path' -> Path.Path' -> Text -> Cli () +handleMoveAll hasConfirmed src' dest' description = do + moveBranchFunc <- moveBranchFunc hasConfirmed src' dest' moveTermTypeSteps <- case (,) <$> Path.toSplit' src' <*> Path.toSplit' dest' of Nothing -> pure [] Just (fmap HQ'.NameOnly -> src, dest) -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs index dc5b31cf80..eb6b3effbf 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveBranch.hs @@ -12,12 +12,15 @@ import Unison.Prelude -- | Note: Currently only allows moving within the same project-branch, should be easy to change in the future if -- needed. -moveBranchFunc :: Path.Path' -> Path.Path' -> Cli (Maybe (Path.Absolute, Branch IO -> Branch IO)) -moveBranchFunc src' dest' = do +moveBranchFunc :: Bool -> Path.Path' -> Path.Path' -> Cli (Maybe (Path.Absolute, Branch IO -> Branch IO)) +moveBranchFunc hasConfirmed src' dest' = do -- We currently only support moving within the same project branch. srcPP@(PP.ProjectPath _proj _projBranch srcAbs) <- Cli.resolvePath' src' PP.ProjectPath _ _ destAbs <- Cli.resolvePath' dest' destBranchExists <- Cli.branchExistsAtPath' dest' + let isRootMove = (Path.isRoot srcAbs || Path.isRoot destAbs) + when (isRootMove && not hasConfirmed) do + Cli.returnEarly MoveRootBranchConfirmation Cli.getMaybeBranchFromProjectPath srcPP >>= traverse \srcBranch -> do -- We want the move to appear as a single step in the root namespace, but we need to make -- surgical changes in both the root and the destination, so we make our modifications at the shared parent of @@ -27,16 +30,16 @@ moveBranchFunc src' dest' = do changeRoot & Branch.modifyAt srcLoc (const Branch.empty) & Branch.modifyAt destLoc (const srcBranch) - if destBranchExists + if (destBranchExists && not isRootMove) then Cli.respond (MovedOverExistingBranch dest') else pure () pure (Path.Absolute changeRootPath, doMove) -- | Moves a branch and its history from one location to another, and saves the new root -- branch. -doMoveBranch :: Text -> Path.Path' -> Path.Path' -> Cli () -doMoveBranch actionDescription src' dest' = do - moveBranchFunc src' dest' >>= \case +doMoveBranch :: Text -> Bool -> Path.Path' -> Path.Path' -> Cli () +doMoveBranch actionDescription hasConfirmed src' dest' = do + moveBranchFunc hasConfirmed src' dest' >>= \case Nothing -> Cli.respond (BranchNotFound src') Just (absPath, func) -> do pp <- Cli.resolvePath' (Path.AbsolutePath' absPath) From 67a41cdaf1067e7b8fe80b150e85db1e2827702a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 10 Jul 2024 10:06:53 -0700 Subject: [PATCH 428/631] Docs and transcripts --- .gitignore | 1 + .../src/Unison/Codebase/Editor/HandleInput/Branch.hs | 8 ++++---- .../Unison/Codebase/Editor/HandleInput/DeleteBranch.hs | 2 +- .../src/Unison/Server/Local/Endpoints/Current.hs | 6 +++--- unison-src/transcripts-round-trip/main.md | 1 + unison-src/transcripts-round-trip/main.output.md | 4 ++-- 6 files changed, 12 insertions(+), 10 deletions(-) diff --git a/.gitignore b/.gitignore index b182f70b40..94b29b69e8 100644 --- a/.gitignore +++ b/.gitignore @@ -24,6 +24,7 @@ dist-newstyle # GHC *.hie *.prof +*.prof.html /.direnv/ /.envrc diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs index 06335337e0..6df6178d5a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs @@ -85,15 +85,15 @@ handleBranch sourceI projectAndBranchNames@(ProjectAndBranch mayProjectName newB ) (projectAndBranchNames & #project .~ projectName) --- | @createBranchFromParent createFrom project branch description@: +-- | @createBranch description createFrom project getNewBranchName@: -- --- 1. Creates a new branch row for @branch@ in project @project@ (failing if @branch@ already exists in @project@). --- 3. Switches to the new branch. +-- 1. Creates a new branch row in @project@ at the name from @getNewBranchName@ (failing if branch already exists in @project@). +-- 2. Switches to the new branch. -- -- This bit of functionality is factored out from the main 'handleBranch' handler because it is also called by the -- @release.draft@ command, which essentially just creates a branch, but with some different output for the user. -- --- Returns the branch id of the newly-created branch. +-- Returns the branch id and name of the newly-created branch. createBranch :: Text -> CreateFrom -> diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs index 516215e93b..ccbcfcb267 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs @@ -42,7 +42,7 @@ handleDeleteBranch projectAndBranchNamesToDelete = do -- 1. cd to parent branch, if it exists -- 2. cd to "main", if it exists -- 3. Any other branch in the codebase - -- 4. Create a dummy project and go to /main + -- 4. Create a new branch in the current project when (branchToDelete ^. #branchId == currentBranch ^. #branchId) do mayNextLocation <- Cli.runTransaction . runMaybeT $ diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs index 48805f5b46..7d082b8149 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/Current.hs @@ -34,7 +34,7 @@ instance ToSample Current where Current (Just $ UnsafeProjectName "@unison/base") (Just $ UnsafeProjectBranchName "main") - (Path.Absolute $ Path.unsafeParseText ".my.namespace") + (Path.Absolute $ Path.unsafeParseText "my.path") ) ] @@ -46,10 +46,10 @@ instance ToJSON Current where "path" .= path ] -serveCurrent :: MonadIO m => Codebase m v a -> Backend m Current +serveCurrent :: (MonadIO m) => Codebase m v a -> Backend m Current serveCurrent = lift . getCurrentProjectBranch -getCurrentProjectBranch :: MonadIO m => Codebase m v a -> m Current +getCurrentProjectBranch :: (MonadIO m) => Codebase m v a -> m Current getCurrentProjectBranch codebase = do pp <- Codebase.runTransaction codebase Codebase.expectCurrentProjectPath let (PP.ProjectPath projName branchName path) = PP.toNames pp diff --git a/unison-src/transcripts-round-trip/main.md b/unison-src/transcripts-round-trip/main.md index 3ce811c295..7824c9cfe1 100644 --- a/unison-src/transcripts-round-trip/main.md +++ b/unison-src/transcripts-round-trip/main.md @@ -1,6 +1,7 @@ This transcript verifies that the pretty-printer produces code that can be successfully parsed, for a variety of examples. Terms or types that fail to round-trip can be added to either `reparses-with-same-hash.u` or `reparses.u` as regression tests. ```ucm:hide +scratch/main> builtins.mergeio lib.builtins scratch/a1> builtins.mergeio lib.builtins scratch/a2> builtins.mergeio lib.builtins ``` diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index 7f8c0067d1..f8fcb3964e 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -824,9 +824,9 @@ scratch/main> diff.namespace /a3_new:. /a3:. Updates: - 1. sloppyDocEval : #ej86si0ur1 + 1. sloppyDocEval : Doc2 ↓ - 2. sloppyDocEval : #ej86si0ur1 + 2. sloppyDocEval : Doc2 ``` ## Other regression tests not covered by above From 1cd3f3cff8428ecc5d8b4e36c43fa230e45b4f07 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 10 Jul 2024 10:37:08 -0700 Subject: [PATCH 429/631] Fix move-namespace transcript --- unison-src/transcripts/move-namespace.md | 3 +++ unison-src/transcripts/move-namespace.output.md | 16 ++++++++++++---- 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/unison-src/transcripts/move-namespace.md b/unison-src/transcripts/move-namespace.md index 6de80330e8..e547fdfa21 100644 --- a/unison-src/transcripts/move-namespace.md +++ b/unison-src/transcripts/move-namespace.md @@ -11,6 +11,8 @@ foo = 1 ```ucm scratch/main> add +-- Should request confirmation +scratch/main> move.namespace . .root.at.path scratch/main> move.namespace . .root.at.path scratch/main> ls scratch/main> history @@ -26,6 +28,7 @@ I should be able to move a sub namespace _over_ the root. ```ucm -- Should request confirmation scratch/main> move.namespace .root.at.path . +scratch/main> move.namespace .root.at.path . scratch/main> ls scratch/main> history ``` diff --git a/unison-src/transcripts/move-namespace.output.md b/unison-src/transcripts/move-namespace.output.md index b5bc79e03b..54a8c3f7b9 100644 --- a/unison-src/transcripts/move-namespace.output.md +++ b/unison-src/transcripts/move-namespace.output.md @@ -16,6 +16,14 @@ scratch/main> add foo : ##Nat +-- Should request confirmation +scratch/main> move.namespace . .root.at.path + + ⚠️ + + Moves which affect the root branch cannot be undone, are you sure? + Re-run the same command to proceed. + scratch/main> move.namespace . .root.at.path Done. @@ -57,10 +65,10 @@ scratch/main> move.namespace .root.at.path . ⚠️ - A branch existed at the destination: . so I over-wrote it. - - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Moves which affect the root branch cannot be undone, are you sure? + Re-run the same command to proceed. + +scratch/main> move.namespace .root.at.path . Done. From fa6c59e68ad048eef82fc6dff369651c5f18b209 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 10 Jul 2024 10:37:08 -0700 Subject: [PATCH 430/631] Fix merge transcript --- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 4 +++- unison-src/transcripts/merge.md | 6 +----- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index d829100bc6..fd3b51d979 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -225,7 +225,9 @@ notifyNumbered = \case <> IP.makeExample' IP.undo <> " or use a hash from " <> IP.makeExample' IP.branchReflog - <> " to undo the results of this merge." + <> " with " + <> IP.makeExample' IP.reset + <> " to reset to a previous state." ] ) (showDiffNamespace ShowNumbers ppe (BranchAtProjectPath destAbs) (BranchAtProjectPath destAbs) diffOutput) diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 90ad8955e1..1d28320c84 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -1645,7 +1645,7 @@ project/carol> history ``` ```ucm:hide -.> project.delete project +scratch/main> project.delete project ``` ### Variables named `_` @@ -1701,7 +1701,3 @@ scratch/alice> update ```ucm scratch/alice> merge /bob ``` - -```ucm:hide -.> project.delete scratch -``` From f725bf218baad7b7ed41a597e95cc5ded07ac526 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 10 Jul 2024 10:54:15 -0700 Subject: [PATCH 431/631] Fix names transcript --- unison-src/transcripts/names.md | 2 +- unison-src/transcripts/names.output.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-src/transcripts/names.md b/unison-src/transcripts/names.md index 492e32353f..7780292f42 100644 --- a/unison-src/transcripts/names.md +++ b/unison-src/transcripts/names.md @@ -28,7 +28,7 @@ scratch/main> add scratch/main> names x -- We can search by hash, and see all aliases of that hash scratch/main> names #gjmq673r1v --- Works with global names too +-- Works with absolute names too scratch/main> names .some.place.x ``` diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index 498cab0a28..697dc38f22 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -71,7 +71,7 @@ scratch/main> names #gjmq673r1v Tip: Use `names.global` to see more results. --- Works with global names too +-- Works with absolute names too scratch/main> names .some.place.x Term From 9e2fa2bbe74e72b2e751986f83cbead4b3848754 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 10 Jul 2024 08:11:59 -0600 Subject: [PATCH 432/631] Replace transcript parser with `cmark` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit We don’t need a very rich parser for transcripts, but we _do_ need to reliably identify fenced code blocks, and that implies a number of subtle cases. Using a polished CommonMark parser/printer handles those subtleties for us. I chose `cmark` for a few reasons: - it’s a wrapper around `libcmark`, which is the reference implementation of CommonMark, so it should be correct; - it provides both a parser and a printer (unlike MMark); and - it is extremely fast (about 20x faster than MMark), so the fact that our home-rolled parser got to skip over everything that’s not a block isn’t an issue.). This only _partially_ uses the `cmark` printer. I think it should use it entirely, but for the cases where we do streaming output (processing UCM commands, etc.) it’s a more involved change. So I think it should be handled separately. --- unison-cli/package.yaml | 1 + .../src/Unison/Codebase/TranscriptParser.hs | 133 +++++++----------- unison-cli/unison-cli.cabal | 3 + 3 files changed, 56 insertions(+), 81 deletions(-) diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index d64ed16ae0..23b18fa9d9 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -19,6 +19,7 @@ dependencies: - base - bytes - bytestring + - cmark - co-log-core - code-page - concurrent-output diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/TranscriptParser.hs index b9e82f7ed5..ebabe7b4d7 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/unison-cli/src/Unison/Codebase/TranscriptParser.hs @@ -18,6 +18,7 @@ module Unison.Codebase.TranscriptParser ) where +import CMark qualified import Control.Lens (use, (?~)) import Crypto.Random qualified as Random import Data.Aeson qualified as Aeson @@ -121,12 +122,14 @@ instance Show APIRequest where show (GetRequest txt) = "GET " <> Text.unpack txt show (APIComment txt) = "-- " <> Text.unpack txt +pattern CMarkCodeBlock :: (Maybe CMark.PosInfo) -> Text -> Text -> CMark.Node +pattern CMarkCodeBlock pos info body = CMark.Node pos (CMark.CODE_BLOCK info body) [] + data Stanza = Ucm Hidden ExpectingError [UcmLine] | Unison Hidden ExpectingError (Maybe ScratchFileName) Text | API [APIRequest] - | UnprocessedFence FenceType Text - | Unfenced Text + | UnprocessedBlock CMark.Node instance Show UcmLine where show = \case @@ -138,43 +141,34 @@ instance Show UcmLine where UcmContextProject projectAndBranch -> Text.unpack (into @Text projectAndBranch) instance Show Stanza where - show s = case s of + show s = (<> "\n") . Text.unpack . CMark.nodeToCommonmark [] Nothing $ stanzaToNode s + +stanzaToNode :: Stanza -> CMark.Node +stanzaToNode = + \case Ucm _ _ cmds -> - unlines - [ "```ucm", - foldl (\x y -> x ++ show y) "" cmds, - "```" - ] + CMarkCodeBlock Nothing "ucm" . Text.pack $ + foldl (\x y -> x ++ show y) "" cmds Unison _hide _ fname txt -> - unlines - [ "```unison", - case fname of - Nothing -> Text.unpack txt <> "```\n" - Just fname -> - unlines - [ "---", - "title: " <> Text.unpack fname, - "---", - Text.unpack txt, - "```", - "" - ] - ] + CMarkCodeBlock Nothing "unison" . Text.pack $ + unlines + [ case fname of + Nothing -> Text.unpack txt + Just fname -> + unlines + [ "---", + "title: " <> Text.unpack fname, + "---", + Text.unpack txt + ] + ] API apiRequests -> - "```api\n" - <> ( apiRequests - & fmap show - & unlines - ) - <> "```\n" - UnprocessedFence typ txt -> - unlines - [ "```" <> Text.unpack typ, - Text.unpack txt, - "```", - "" - ] - Unfenced txt -> Text.unpack txt + CMarkCodeBlock Nothing "api" . Text.pack $ + ( apiRequests + & fmap show + & unlines + ) + UnprocessedBlock node -> node parseFile :: FilePath -> IO (Either TranscriptError [Stanza]) parseFile filePath = do @@ -186,7 +180,7 @@ parseFile filePath = do else pure . Left . TranscriptParseError . Text.pack $ filePath <> " does not exist" parse :: String -> Text -> Either TranscriptError [Stanza] -parse srcName txt = case P.parse (stanzas <* P.eof) srcName txt of +parse srcName txt = case stanzas srcName txt of Right a -> Right a Left e -> Left . TranscriptParseError . Text.pack . P.errorBundlePretty $ e @@ -337,7 +331,7 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion for (reverse scratchFileUpdates) \(fp, contents) -> do let fenceDescription = "unison:added-by-ucm " <> fp -- Output blocks for any scratch file updates the ucm block triggered. - Q.undequeue inputQueue (UnprocessedFence fenceDescription contents, Nothing) + Q.undequeue inputQueue (UnprocessedBlock $ CMarkCodeBlock Nothing fenceDescription contents, Nothing) awaitInput -- ucm command to run Just (Just ucmLine) -> do @@ -420,10 +414,7 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion ++ "." IO.hFlush IO.stdout case s of - Unfenced _ -> do - liftIO (output $ show s) - awaitInput - UnprocessedFence _ _ -> do + UnprocessedBlock _ -> do liftIO (output $ show s) awaitInput Unison hide errOk filename txt -> do @@ -593,8 +584,12 @@ transcriptFailure out msg = do type P = P.Parsec Void Text -stanzas :: P [Stanza] -stanzas = P.many (fenced <|> unfenced) +stanzas :: String -> Text -> Either (P.ParseErrorBundle Text Void) [Stanza] +stanzas srcName = (\(CMark.Node _ _DOCUMENT blocks) -> traverse stanzaFromBlock blocks) . CMark.commonmarkToNode [] + where + stanzaFromBlock block = case block of + CMarkCodeBlock _ info body -> fromMaybe (UnprocessedBlock block) <$> P.parse (fenced info) srcName body + _ -> pure $ UnprocessedBlock block ucmLine :: P UcmLine ucmLine = ucmCommand <|> ucmComment @@ -636,18 +631,21 @@ apiRequest = do spaces pure (APIComment comment) -fenced :: P Stanza -fenced = do - fence +-- | Produce the correct parser for the code block based on the provided info string. +fenced :: Text -> P (Maybe Stanza) +fenced info = do + body <- P.getInput + P.setInput info fenceType <- lineToken (word "ucm" <|> word "unison" <|> word "api" <|> language) stanza <- case fenceType of "ucm" -> do hide <- hidden err <- expectingError + P.setInput body _ <- spaces cmds <- many ucmLine - pure $ Ucm hide err cmds + pure . pure $ Ucm hide err cmds "unison" -> do -- todo: this has to be more interesting @@ -657,44 +655,17 @@ fenced = do hide <- lineToken hidden err <- lineToken expectingError fileName <- optional untilSpace1 - blob <- spaces *> untilFence - pure $ Unison hide err fileName blob + P.setInput body + blob <- spaces *> (Text.init <$> P.getInput) + pure . pure $ Unison hide err fileName blob "api" -> do + P.setInput body _ <- spaces apiRequests <- many apiRequest - pure $ API apiRequests - _ -> UnprocessedFence fenceType <$> untilFence - fence + pure . pure $ API apiRequests + _ -> pure Nothing pure stanza --- Three backticks, consumes trailing spaces too --- ``` -fence :: P () -fence = P.try $ do void (word "```"); spaces - --- Parses up until next fence -unfenced :: P Stanza -unfenced = Unfenced <$> untilFence - -untilFence :: P Text -untilFence = do - _ <- P.lookAhead (P.takeP Nothing 1) - go mempty - where - go :: Seq Text -> P Text - go !acc = do - f <- P.lookAhead (P.optional fence) - case f of - Nothing -> do - oneOrTwoBackticks <- optional (word' "``" <|> word' "`") - let start = fromMaybe "" oneOrTwoBackticks - txt <- P.takeWhileP (Just "unfenced") (/= '`') - eof <- P.lookAhead (P.optional P.eof) - case eof of - Just _ -> pure $ fold (acc <> pure txt) - Nothing -> go (acc <> pure start <> pure txt) - Just _ -> pure $ fold acc - word' :: Text -> P Text word' txt = P.try $ do chs <- P.takeP (Just $ show txt) (Text.length txt) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index d0b19db6a8..dc7b8f2b81 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -196,6 +196,7 @@ library , base , bytes , bytestring + , cmark , co-log-core , code-page , concurrent-output @@ -337,6 +338,7 @@ executable transcripts , base , bytes , bytestring + , cmark , co-log-core , code-page , concurrent-output @@ -485,6 +487,7 @@ test-suite cli-tests , base , bytes , bytestring + , cmark , co-log-core , code-page , concurrent-output From 1dc181b99aedbac9b8e64da3a88ca3dc3db6d8bb Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 10 Jul 2024 08:46:18 -0600 Subject: [PATCH 433/631] Update the transcripts with `cmark` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `cmark`’s pretty-printer matches our output pretty well, with a few differences: - it puts a space between the fence and the info string for in code blocks; - it prefers `-` over `*` for bulleted lists (as do I) and it indents them; - it `\`-escapes certain chars very conservatively; - it prefers indented/unfenced code blocks if there is no info string; and - it prefers `*` over `_` (unlike any sane person). This also shows how the change fixes a number of issues: - fix2158-1.output.md also illustrates how this change fixes #1809; - alias-many.output.md and input-parse-errors.output.md show how fenced code blocks without an info string would use the beginning of the content as the info string; - transcripts-round-trip/main.output.md shows how output blocks for generated `unison` stanzas (which could contain nested fenced blocks) might not have long-enough fences; and - error-messages.output.md and generic-parse-errors.output.md show how Unison errors were reported on the wrong line number (and thus the printed error lines were also incorrect). --- .../IntegrationTests/transcript.output.md | 2 +- .../transcripts-manual/docs.to-html.output.md | 2 +- .../transcripts-manual/rewrites.output.md | 25 +- .../transcripts-round-trip/main.output.md | 12 +- .../transcripts-using-base/_base.output.md | 4 +- .../binary-encoding-nats.output.md | 2 +- .../transcripts-using-base/codeops.output.md | 9 +- .../transcripts-using-base/doc.output.md | 15 +- .../failure-tests.output.md | 2 +- .../fix2158-1.output.md | 5 +- .../transcripts-using-base/fix2297.output.md | 3 +- .../transcripts-using-base/fix2358.output.md | 3 +- .../transcripts-using-base/fix3166.output.md | 6 +- .../transcripts-using-base/fix3542.output.md | 2 +- .../transcripts-using-base/fix3939.output.md | 2 +- .../transcripts-using-base/fix4746.output.md | 2 +- .../transcripts-using-base/fix5129.output.md | 6 +- .../transcripts-using-base/hashing.output.md | 12 +- .../transcripts-using-base/mvar.output.md | 3 +- .../nat-coersion.output.md | 2 +- .../transcripts-using-base/net.output.md | 17 +- .../random-deserial.output.md | 2 +- .../ref-promise.output.md | 10 +- .../serial-test-00.output.md | 2 +- .../serial-test-01.output.md | 2 +- .../serial-test-02.output.md | 2 +- .../serial-test-03.output.md | 2 +- .../serial-test-04.output.md | 2 +- .../transcripts-using-base/stm.output.md | 5 +- .../test-watch-dependencies.output.md | 8 +- .../transcripts-using-base/thread.output.md | 6 +- .../transcripts-using-base/tls.output.md | 6 +- .../transcripts-using-base/utf8.output.md | 10 +- unison-src/transcripts/abilities.output.md | 3 +- ...ability-order-doesnt-affect-hash.output.md | 2 +- ...ability-term-conflicts-on-update.output.md | 14 +- unison-src/transcripts/add-run.output.md | 19 +- .../add-test-watch-roundtrip.output.md | 4 +- .../transcripts/addupdatemessages.output.md | 8 +- unison-src/transcripts/alias-many.output.md | 20 +- unison-src/transcripts/anf-tests.output.md | 5 +- unison-src/transcripts/any-extract.output.md | 2 +- .../transcripts/api-doc-rendering.output.md | 2 +- unison-src/transcripts/api-find.output.md | 2 +- .../transcripts/api-getDefinition.output.md | 4 +- .../api-namespace-details.output.md | 2 +- .../transcripts/api-namespace-list.output.md | 2 +- .../transcripts/api-summaries.output.md | 2 +- .../block-on-required-update.output.md | 4 +- unison-src/transcripts/blocks.output.md | 34 +-- .../boolean-op-pretty-print-2819.output.md | 2 +- .../transcripts/branch-command.output.md | 2 +- .../branch-relative-path.output.md | 4 +- unison-src/transcripts/bug-fix-4354.output.md | 2 +- .../transcripts/bug-strange-closure.output.md | 5 +- unison-src/transcripts/builtins.output.md | 24 +- .../transcripts/bytesFromList.output.md | 3 +- unison-src/transcripts/check763.output.md | 2 +- unison-src/transcripts/check873.output.md | 4 +- .../constructor-applied-to-unit.output.md | 2 +- .../transcripts/contrabilities.output.md | 2 +- .../transcripts/cycle-update-1.output.md | 4 +- .../transcripts/cycle-update-2.output.md | 4 +- .../transcripts/cycle-update-3.output.md | 4 +- .../transcripts/cycle-update-4.output.md | 4 +- .../transcripts/cycle-update-5.output.md | 7 +- .../transcripts/debug-definitions.output.md | 2 +- .../transcripts/debug-name-diffs.output.md | 2 +- unison-src/transcripts/deep-names.output.md | 7 +- .../transcripts/definition-diff-api.output.md | 4 +- ...elete-namespace-dependents-check.output.md | 4 +- .../transcripts/delete-namespace.output.md | 2 +- .../transcripts/delete-silent.output.md | 2 +- unison-src/transcripts/delete.output.md | 24 +- ...ependents-dependencies-debugfile.output.md | 7 +- .../transcripts/destructuring-binds.output.md | 10 +- .../transcripts/diff-namespace.output.md | 107 +++---- .../transcripts/doc-formatting.output.md | 28 +- .../doc-type-link-keywords.output.md | 2 +- unison-src/transcripts/doc1.output.md | 16 +- unison-src/transcripts/doc2.output.md | 4 +- unison-src/transcripts/doc2markdown.output.md | 4 +- ...t-upgrade-refs-that-exist-in-old.output.md | 4 +- .../transcripts/duplicate-names.output.md | 10 +- .../duplicate-term-detection.output.md | 8 +- unison-src/transcripts/ed25519.output.md | 3 +- unison-src/transcripts/edit-command.output.md | 7 +- .../transcripts/edit-namespace.output.md | 6 +- .../transcripts/empty-namespaces.output.md | 7 +- .../transcripts/emptyCodebase.output.md | 7 +- .../transcripts/error-messages.output.md | 47 +-- .../errors/missing-result-typed.output.md | 3 +- .../errors/missing-result.output.md | 3 +- .../errors/ucm-hide-all-error.output.md | 6 +- .../transcripts/errors/ucm-hide-all.output.md | 6 +- .../errors/ucm-hide-error.output.md | 6 +- .../transcripts/errors/ucm-hide.output.md | 6 +- .../errors/unison-hide-all-error.output.md | 3 +- .../errors/unison-hide-all.output.md | 3 +- .../errors/unison-hide-error.output.md | 3 +- .../transcripts/errors/unison-hide.output.md | 3 +- .../transcripts/escape-sequences.output.md | 2 +- unison-src/transcripts/find-by-type.output.md | 2 +- unison-src/transcripts/find-command.output.md | 2 +- .../fix-1381-excess-propagate.output.md | 8 +- .../fix-2258-if-as-list-element.output.md | 2 +- .../transcripts/fix-big-list-crash.output.md | 2 +- unison-src/transcripts/fix-ls.output.md | 2 +- unison-src/transcripts/fix1063.output.md | 2 +- unison-src/transcripts/fix1334.output.md | 2 +- unison-src/transcripts/fix1390.output.md | 5 +- unison-src/transcripts/fix1532.output.md | 2 +- unison-src/transcripts/fix1578.output.md | 22 +- unison-src/transcripts/fix1696.output.md | 3 +- unison-src/transcripts/fix1709.output.md | 4 +- unison-src/transcripts/fix1731.output.md | 5 +- unison-src/transcripts/fix1800.output.md | 9 +- unison-src/transcripts/fix1844.output.md | 3 +- unison-src/transcripts/fix1926.output.md | 4 +- unison-src/transcripts/fix2026.output.md | 2 +- unison-src/transcripts/fix2027.output.md | 4 +- unison-src/transcripts/fix2049.output.md | 4 +- unison-src/transcripts/fix2156.output.md | 3 +- unison-src/transcripts/fix2167.output.md | 3 +- unison-src/transcripts/fix2187.output.md | 2 +- unison-src/transcripts/fix2231.output.md | 2 +- unison-src/transcripts/fix2238.output.md | 3 +- unison-src/transcripts/fix2254.output.md | 9 +- unison-src/transcripts/fix2268.output.md | 2 +- unison-src/transcripts/fix2334.output.md | 3 +- unison-src/transcripts/fix2344.output.md | 3 +- unison-src/transcripts/fix2350.output.md | 3 +- unison-src/transcripts/fix2353.output.md | 2 +- unison-src/transcripts/fix2354.output.md | 3 +- unison-src/transcripts/fix2355.output.md | 3 +- unison-src/transcripts/fix2378.output.md | 3 +- unison-src/transcripts/fix2423.output.md | 2 +- unison-src/transcripts/fix2474.output.md | 23 +- unison-src/transcripts/fix2628.output.md | 2 +- unison-src/transcripts/fix2663.output.md | 5 +- unison-src/transcripts/fix2693.output.md | 7 +- unison-src/transcripts/fix2712.output.md | 4 +- unison-src/transcripts/fix2840.output.md | 13 +- unison-src/transcripts/fix2970.output.md | 4 +- unison-src/transcripts/fix3037.output.md | 4 +- unison-src/transcripts/fix3171.output.md | 2 +- unison-src/transcripts/fix3196.output.md | 3 +- unison-src/transcripts/fix3215.output.md | 2 +- unison-src/transcripts/fix3244.output.md | 2 +- unison-src/transcripts/fix3265.output.md | 15 +- unison-src/transcripts/fix3634.output.md | 2 +- unison-src/transcripts/fix3678.output.md | 3 +- unison-src/transcripts/fix3752.output.md | 2 +- unison-src/transcripts/fix3759.output.md | 5 +- unison-src/transcripts/fix3773.output.md | 3 +- unison-src/transcripts/fix4172.output.md | 5 +- unison-src/transcripts/fix4280.output.md | 2 +- unison-src/transcripts/fix4397.output.md | 2 +- unison-src/transcripts/fix4415.output.md | 3 +- unison-src/transcripts/fix4424.output.md | 4 +- unison-src/transcripts/fix4482.output.md | 4 +- unison-src/transcripts/fix4498.output.md | 2 +- unison-src/transcripts/fix4515.output.md | 4 +- unison-src/transcripts/fix4528.output.md | 2 +- unison-src/transcripts/fix4556.output.md | 4 +- unison-src/transcripts/fix4592.output.md | 2 +- unison-src/transcripts/fix4618.output.md | 4 +- unison-src/transcripts/fix4722.output.md | 5 +- unison-src/transcripts/fix4780.output.md | 2 +- unison-src/transcripts/fix4898.output.md | 2 +- unison-src/transcripts/fix5055.output.md | 2 +- unison-src/transcripts/fix5080.output.md | 2 +- unison-src/transcripts/fix614.output.md | 10 +- unison-src/transcripts/fix689.output.md | 2 +- unison-src/transcripts/fix693.output.md | 11 +- unison-src/transcripts/fix845.output.md | 11 +- unison-src/transcripts/fix849.output.md | 3 +- unison-src/transcripts/fix942.output.md | 8 +- unison-src/transcripts/fix987.output.md | 6 +- unison-src/transcripts/formatter.output.md | 6 +- .../transcripts/fuzzy-options.output.md | 3 +- .../generic-parse-errors.output.md | 18 +- unison-src/transcripts/hello.output.md | 23 +- unison-src/transcripts/help.output.md | 1 + unison-src/transcripts/higher-rank.output.md | 11 +- .../transcripts/input-parse-errors.output.md | 18 +- .../transcripts/io-test-command.output.md | 4 +- unison-src/transcripts/io.output.md | 60 ++-- .../transcripts/keyword-identifiers.output.md | 88 +++--- .../transcripts/kind-inference.output.md | 52 ++-- unison-src/transcripts/lambdacase.output.md | 14 +- .../transcripts/lsp-fold-ranges.output.md | 2 +- .../transcripts/lsp-name-completion.output.md | 3 +- unison-src/transcripts/merge.output.md | 270 +++++++++++------- unison-src/transcripts/move-all.output.md | 8 +- .../transcripts/move-namespace.output.md | 17 +- .../transcripts/name-selection.output.md | 14 +- unison-src/transcripts/names.output.md | 3 +- .../namespace-dependencies.output.md | 2 +- .../transcripts/numbered-args.output.md | 2 +- .../transcripts/old-fold-right.output.md | 2 +- .../pattern-match-coverage.output.md | 127 ++++---- .../pattern-pretty-print-2345.output.md | 3 +- .../transcripts/patternMatchTls.output.md | 4 +- unison-src/transcripts/patterns.output.md | 2 +- unison-src/transcripts/propagate.output.md | 12 +- unison-src/transcripts/records.output.md | 16 +- unison-src/transcripts/reflog.output.md | 5 +- .../release-draft-command.output.md | 2 +- unison-src/transcripts/reset.output.md | 14 +- .../transcripts/resolution-failures.output.md | 10 +- unison-src/transcripts/rsa.output.md | 3 +- unison-src/transcripts/scope-ref.output.md | 3 +- unison-src/transcripts/suffixes.output.md | 12 +- .../sum-type-update-conflicts.output.md | 6 +- .../transcripts/switch-command.output.md | 2 +- .../transcripts/tab-completion.output.md | 8 +- unison-src/transcripts/test-command.output.md | 4 +- .../transcripts/text-literals.output.md | 3 +- .../transcripts/todo-bug-builtins.output.md | 13 +- unison-src/transcripts/todo.output.md | 4 +- .../top-level-exceptions.output.md | 5 +- .../transcript-parser-commands.output.md | 17 +- unison-src/transcripts/type-deps.output.md | 5 +- .../type-modifier-are-optional.output.md | 2 +- .../transcripts/unique-type-churn.output.md | 8 +- .../transcripts/unitnamespace.output.md | 2 +- .../transcripts/universal-cmp.output.md | 5 +- .../transcripts/unsafe-coerce.output.md | 3 +- .../update-ignores-lib-namespace.output.md | 4 +- .../transcripts/update-on-conflict.output.md | 4 +- .../update-suffixifies-properly.output.md | 6 +- ...e-term-aliases-in-different-ways.output.md | 4 +- .../update-term-to-different-type.output.md | 4 +- .../update-term-with-alias.output.md | 4 +- ...with-dependent-to-different-type.output.md | 6 +- .../update-term-with-dependent.output.md | 4 +- unison-src/transcripts/update-term.output.md | 4 +- .../update-test-to-non-test.output.md | 4 +- .../update-test-watch-roundtrip.output.md | 7 +- .../update-type-add-constructor.output.md | 4 +- .../update-type-add-field.output.md | 4 +- .../update-type-add-new-record.output.md | 2 +- .../update-type-add-record-field.output.md | 4 +- .../update-type-constructor-alias.output.md | 4 +- ...elete-constructor-with-dependent.output.md | 6 +- .../update-type-delete-constructor.output.md | 4 +- .../update-type-delete-record-field.output.md | 6 +- .../update-type-missing-constructor.output.md | 4 +- .../update-type-nested-decl-aliases.output.md | 6 +- .../update-type-no-op-record.output.md | 2 +- ...ate-type-stray-constructor-alias.output.md | 4 +- .../update-type-stray-constructor.output.md | 4 +- ...nstructor-into-smart-constructor.output.md | 4 +- ...type-turn-non-record-into-record.output.md | 4 +- .../update-type-with-dependent-term.output.md | 6 +- ...dependent-type-to-different-kind.output.md | 6 +- .../update-type-with-dependent-type.output.md | 4 +- unison-src/transcripts/update-watch.output.md | 2 +- .../transcripts/upgrade-happy-path.output.md | 2 +- .../transcripts/upgrade-sad-path.output.md | 6 +- .../upgrade-suffixifies-properly.output.md | 4 +- .../upgrade-with-old-alias.output.md | 2 +- unison-src/transcripts/view.output.md | 2 +- .../transcripts/watch-expressions.output.md | 6 +- 265 files changed, 1117 insertions(+), 1060 deletions(-) diff --git a/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md index c74133f4ba..09def16163 100644 --- a/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md +++ b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md @@ -1,6 +1,6 @@ # Integration test: transcript -```unison +``` unison use .builtin unique type MyBool = MyTrue | MyFalse diff --git a/unison-src/transcripts-manual/docs.to-html.output.md b/unison-src/transcripts-manual/docs.to-html.output.md index 7755e2e2de..e59537da20 100644 --- a/unison-src/transcripts-manual/docs.to-html.output.md +++ b/unison-src/transcripts-manual/docs.to-html.output.md @@ -4,7 +4,7 @@ test-html-docs/main> builtins.mergeio lib.builtins Done. ``` -```unison +``` unison {{A doc directly in the namespace.}} some.ns.direct = 1 diff --git a/unison-src/transcripts-manual/rewrites.output.md b/unison-src/transcripts-manual/rewrites.output.md index d1ab897dc2..91d1272ec3 100644 --- a/unison-src/transcripts-manual/rewrites.output.md +++ b/unison-src/transcripts-manual/rewrites.output.md @@ -1,9 +1,8 @@ - ## Structural find and replace Here's a scratch file with some rewrite rules: -```unison +``` unison ex1 = List.map (x -> x + 1) [1,2,3,4,5,6,7] eitherToOptional e a = @@ -49,7 +48,7 @@ scratch/main> rewrite eitherToOptional The rewritten file has been added to the top of scratch.u ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): ex1 @@ -79,7 +78,7 @@ type Optional2 a = Some2 a | None2 rule2 x = @rewrite signature Optional ==> Optional2 ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): Either.mapRight @@ -137,7 +136,7 @@ scratch/main> view ex1 Either.mapRight rule1 ``` Another example, showing that we can rewrite to definitions that only exist in the file: -```unison +``` unison unique ability Woot1 where woot1 : () -> Nat unique ability Woot2 where woot2 : () -> Nat @@ -167,7 +166,7 @@ scratch/main> rewrite woot1to2 The rewritten file has been added to the top of scratch.u ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): wootEx @@ -204,7 +203,7 @@ scratch/main> view wootEx ``` This example shows that rewrite rules can to refer to term definitions that only exist in the file: -```unison +``` unison foo1 = b = "b" 123 @@ -246,7 +245,7 @@ scratch/main> view foo1 foo2 sameFileEx ``` ## Capture avoidance -```unison +``` unison bar1 = b = "bar" 123 @@ -276,7 +275,7 @@ scratch/main> rewrite rule The rewritten file has been added to the top of scratch.u ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): sameFileEx @@ -321,7 +320,7 @@ scratch/main> load ``` In this example, the `a` is locally bound by the rule, so it shouldn't capture the `a = 39494` binding which is in scope at the point of the replacement: -```unison +``` unison bar2 = a = 39494 233 @@ -341,7 +340,7 @@ scratch/main> rewrite rule The rewritten file has been added to the top of scratch.u ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): bar2 @@ -378,11 +377,11 @@ scratch/main> load ``` ## Structural find -```unison +``` unison eitherEx = Left ("hello", "there") ``` -```unison +``` unison findEitherEx x = @rewrite term Left ("hello", x) ==> Left ("hello" Text.++ x) findEitherFailure = @rewrite signature a . Either Failure a ==> () ``` diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index 2ece57588c..05d85375e6 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -1,6 +1,6 @@ This transcript verifies that the pretty-printer produces code that can be successfully parsed, for a variety of examples. Terms or types that fail to round-trip can be added to either `reparses-with-same-hash.u` or `reparses.u` as regression tests. -```unison +``` unison x = () ``` @@ -30,7 +30,7 @@ So we can see the pretty-printed output: definitions currently in this namespace. ``` -```unison:added-by-ucm scratch.u +````` unison:added-by-ucm scratch.u structural ability Abort where abort : {Abort} a structural ability Ask a where ask : {Ask a} a @@ -766,7 +766,7 @@ UUID.randomUUIDBytes = do (|>) : a -> (a ->{e} b) ->{e} b a |> f = f a -``` +````` This diff should be empty if the two namespaces are equivalent. If it's nonempty, the diff will show us the hashes that differ. @@ -780,7 +780,7 @@ Now check that definitions in 'reparses.u' at least parse on round trip: This just makes 'roundtrip.u' the latest scratch file. -```unison +``` unison x = () ``` @@ -795,7 +795,7 @@ x = () definitions currently in this namespace. ``` -```unison:added-by-ucm scratch.u +```` unison:added-by-ucm scratch.u explanationOfThisFile : Text explanationOfThisFile = """ @@ -815,7 +815,7 @@ sloppyDocEval = 1 + 1 ``` }} -``` +```` These are currently all expected to have different hashes on round trip. diff --git a/unison-src/transcripts-using-base/_base.output.md b/unison-src/transcripts-using-base/_base.output.md index ebc131c831..ef2da4b888 100644 --- a/unison-src/transcripts-using-base/_base.output.md +++ b/unison-src/transcripts-using-base/_base.output.md @@ -11,7 +11,7 @@ transcripts which contain less boilerplate. The test shows that `hex (fromHex str) == str` as expected. -```unison +``` unison test> hex.tests.ex1 = checks let s = "3984af9b" [hex (fromHex s) == s] @@ -20,7 +20,7 @@ test> hex.tests.ex1 = checks let Lets do some basic testing of our test harness to make sure its working. -```unison +``` unison testAutoClean : '{io2.IO}[Result] testAutoClean _ = go: '{Stream Result, Exception, io2.IO, TempDirs} Text diff --git a/unison-src/transcripts-using-base/binary-encoding-nats.output.md b/unison-src/transcripts-using-base/binary-encoding-nats.output.md index a0602ce7ce..5f4b4c889b 100644 --- a/unison-src/transcripts-using-base/binary-encoding-nats.output.md +++ b/unison-src/transcripts-using-base/binary-encoding-nats.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type EncDec = EncDec Text (Nat -> Bytes) (Bytes -> Optional (Nat, Bytes)) BE64 = EncDec "64 bit Big Endian" encodeNat64be decodeNat64be diff --git a/unison-src/transcripts-using-base/codeops.output.md b/unison-src/transcripts-using-base/codeops.output.md index 4cae121f3c..4a4671c537 100644 --- a/unison-src/transcripts-using-base/codeops.output.md +++ b/unison-src/transcripts-using-base/codeops.output.md @@ -1,10 +1,9 @@ - Test for code serialization operations. Define a function, serialize it, then deserialize it back to an actual function. Also ask for its dependencies for display later. -```unison +``` unison save : a -> Bytes save x = Value.serialize (Value.value x) @@ -241,7 +240,7 @@ scratch/main> add ->{Throw Text} () ``` -```unison +``` unison structural ability Zap where zap : Three Nat Nat Nat @@ -393,7 +392,7 @@ scratch/main> io.test badLoad Tip: Use view 1 to view the source of a test. ``` -```unison +``` unison codeTests : '{io2.IO} [Result] codeTests = '[ idempotence "idem f" (termLink f) @@ -489,7 +488,7 @@ scratch/main> io.test codeTests Tip: Use view 1 to view the source of a test. ``` -```unison +``` unison validateTest : Link.Term ->{IO} Result validateTest l = match Code.lookup l with None -> Fail "Couldn't look up link" diff --git a/unison-src/transcripts-using-base/doc.output.md b/unison-src/transcripts-using-base/doc.output.md index e47d8d0737..12a284c079 100644 --- a/unison-src/transcripts-using-base/doc.output.md +++ b/unison-src/transcripts-using-base/doc.output.md @@ -2,18 +2,18 @@ Unison documentation is written in Unison and has some neat features: -* The documentation type provides a rich vocabulary of elements that go beyond markdown, including asides, callouts, tooltips, and more. -* Docs may contain Unison code which is parsed and typechecked to ensure validity. No more out of date examples that don't compile or assume a bunch of implicit context! -* Embeded examples are live and can show the results of evaluation. This uses the same evaluation cache as Unison's scratch files, allowing Unison docs to function like well-commented spreadsheets or notebooks. -* Links to other definitions are typechecked to ensure they point to valid definitions. The links are resolved to hashes and won't be broken by name changes or moving definitions around. -* Docs can be included in other docs and you can assemble documentation programmatically, using Unison code. -* There's a powerful textual syntax for all of the above, which we'll introduce next. + - The documentation type provides a rich vocabulary of elements that go beyond markdown, including asides, callouts, tooltips, and more. + - Docs may contain Unison code which is parsed and typechecked to ensure validity. No more out of date examples that don't compile or assume a bunch of implicit context\! + - Embeded examples are live and can show the results of evaluation. This uses the same evaluation cache as Unison's scratch files, allowing Unison docs to function like well-commented spreadsheets or notebooks. + - Links to other definitions are typechecked to ensure they point to valid definitions. The links are resolved to hashes and won't be broken by name changes or moving definitions around. + - Docs can be included in other docs and you can assemble documentation programmatically, using Unison code. + - There's a powerful textual syntax for all of the above, which we'll introduce next. ## Introduction Documentation blocks start with `{{` and end with a matching `}}`. You can introduce doc blocks anywhere you'd use an expression, and you can also have anonymous documentation blocks immediately before a top-level term or type. -```unison +``` unison name = {{Alice}} d1 = {{ Hello there {{name}}! }} @@ -769,3 +769,4 @@ scratch/main> display doc.guide ``` 🌻 THE END + diff --git a/unison-src/transcripts-using-base/failure-tests.output.md b/unison-src/transcripts-using-base/failure-tests.output.md index 7d33aad456..adbf9bc53a 100644 --- a/unison-src/transcripts-using-base/failure-tests.output.md +++ b/unison-src/transcripts-using-base/failure-tests.output.md @@ -6,7 +6,7 @@ Exception ability directly, and the last is code validation. I don't have an easy way to test the last at the moment, but the other two are tested here. -```unison +``` unison test1 : '{IO, Exception} [Result] test1 = do _ = fromUtf8 0xsee diff --git a/unison-src/transcripts-using-base/fix2158-1.output.md b/unison-src/transcripts-using-base/fix2158-1.output.md index e8014f284a..2099749bc9 100644 --- a/unison-src/transcripts-using-base/fix2158-1.output.md +++ b/unison-src/transcripts-using-base/fix2158-1.output.md @@ -1,6 +1,6 @@ This transcript tests an ability check failure regression. -```unison +``` unison structural ability Async t g where fork : '{Async t g, g} a -> t a await : t a -> a @@ -36,6 +36,7 @@ some subtyping. However, the ability handling was just processing rows in whatever order they occurred, and during inference it happened that `g` -occurred in the row before `Async t g. Processing the stricter parts +occurred in the row before `Async t g`. Processing the stricter parts first is better, becauase it can solve things more precisely and avoid ambiguities relating to subtyping. + diff --git a/unison-src/transcripts-using-base/fix2297.output.md b/unison-src/transcripts-using-base/fix2297.output.md index 575c5a73af..3d8ca7d623 100644 --- a/unison-src/transcripts-using-base/fix2297.output.md +++ b/unison-src/transcripts-using-base/fix2297.output.md @@ -1,7 +1,6 @@ This tests a case where a function was somehow discarding abilities. - -```unison +``` unison structural ability Trivial where trivial : () diff --git a/unison-src/transcripts-using-base/fix2358.output.md b/unison-src/transcripts-using-base/fix2358.output.md index d20a06e163..8c8582c273 100644 --- a/unison-src/transcripts-using-base/fix2358.output.md +++ b/unison-src/transcripts-using-base/fix2358.output.md @@ -1,7 +1,6 @@ - Tests a former error due to bad calling conventions on delay.impl -```unison +``` unison timingApp2 : '{IO, Exception} () timingApp2 _ = printLine "Hello" diff --git a/unison-src/transcripts-using-base/fix3166.output.md b/unison-src/transcripts-using-base/fix3166.output.md index 4787e17672..35e5815f93 100644 --- a/unison-src/transcripts-using-base/fix3166.output.md +++ b/unison-src/transcripts-using-base/fix3166.output.md @@ -1,7 +1,7 @@ This file tests some obscure issues involved with abilities and over-applied functions. -```unison +``` unison Stream.fromList : [a] -> '{Stream a} () Stream.fromList l _ = _ = List.map (x -> emit x) l @@ -62,7 +62,7 @@ increment n = 1 + n [100, 200, 300, 400] ``` -```unison +``` unison structural ability E where eff : () -> () @@ -105,7 +105,7 @@ foo _ = 7 ``` -```unison +``` unison structural ability Over where over : Nat ->{Over} (Nat -> Nat) diff --git a/unison-src/transcripts-using-base/fix3542.output.md b/unison-src/transcripts-using-base/fix3542.output.md index e2d1e7c6a9..5d6fe4b533 100644 --- a/unison-src/transcripts-using-base/fix3542.output.md +++ b/unison-src/transcripts-using-base/fix3542.output.md @@ -1,4 +1,4 @@ -```unison +``` unison arrayList v n = do use ImmutableByteArray read8 ma = Scope.bytearrayOf v n diff --git a/unison-src/transcripts-using-base/fix3939.output.md b/unison-src/transcripts-using-base/fix3939.output.md index ca4e6d909e..75c0dcbea2 100644 --- a/unison-src/transcripts-using-base/fix3939.output.md +++ b/unison-src/transcripts-using-base/fix3939.output.md @@ -1,4 +1,4 @@ -```unison +``` unison {{ A simple doc. }} diff --git a/unison-src/transcripts-using-base/fix4746.output.md b/unison-src/transcripts-using-base/fix4746.output.md index fd158585e3..62f7632c0b 100644 --- a/unison-src/transcripts-using-base/fix4746.output.md +++ b/unison-src/transcripts-using-base/fix4746.output.md @@ -1,7 +1,7 @@ Test case for a variable capture problem during let floating. The encloser wasn't accounting for variables bound by matches. -```unison +``` unison ability Issue t where one : '{Issue t} () -> {Issue t} () two : '{Issue t} () -> {Issue t} () diff --git a/unison-src/transcripts-using-base/fix5129.output.md b/unison-src/transcripts-using-base/fix5129.output.md index af189d5a8f..90f205bd4a 100644 --- a/unison-src/transcripts-using-base/fix5129.output.md +++ b/unison-src/transcripts-using-base/fix5129.output.md @@ -1,7 +1,7 @@ Checks for some bad type checking behavior. Some ability subtyping was too lenient when higher-order functions were involved. -```unison +``` unison foreach : (a ->{g} ()) -> [a] ->{g} () foreach f = cases [] -> () @@ -38,9 +38,9 @@ go = do ``` -This comes from issue #3513 +This comes from issue \#3513 -```unison +``` unison (<<) : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c (<<) f g x = f (g x) diff --git a/unison-src/transcripts-using-base/hashing.output.md b/unison-src/transcripts-using-base/hashing.output.md index e5d1be2799..721c1ec3c7 100644 --- a/unison-src/transcripts-using-base/hashing.output.md +++ b/unison-src/transcripts-using-base/hashing.output.md @@ -45,7 +45,7 @@ Notice the `fromBase16` and `toBase16` functions. Here's some convenience functi Here's a few usage examples: -```unison +``` unison ex1 = fromHex "2947db" |> crypto.hashBytes Sha3_512 |> hex @@ -155,7 +155,7 @@ scratch/main> find-in builtin.crypto ``` Note that the universal versions of `hash` and `hmac` are currently unimplemented and will bomb at runtime: -```unison +``` unison > hash Sha3_256 (fromHex "3849238492") ``` @@ -177,9 +177,9 @@ Note that the universal versions of `hash` and `hmac` are currently unimplemente ``` ## Hashing tests -Here are some test vectors (taken from [here](https://www.di-mgt.com.au/sha_testvectors.html) and [here](https://en.wikipedia.org/wiki/BLAKE_(hash_function))) for the various hashing algorithms: +Here are some test vectors (taken from [here](https://www.di-mgt.com.au/sha_testvectors.html) and [here](https://en.wikipedia.org/wiki/BLAKE_\(hash_function\))) for the various hashing algorithms: -```unison +``` unison ex alg input expected = checks [hashBytes alg (ascii input) == fromHex expected] test> sha3_512.tests.ex1 = @@ -351,7 +351,7 @@ scratch/main> test These test vectors are taken from [RFC 4231](https://tools.ietf.org/html/rfc4231#section-4.3). -```unison +``` unison ex' alg secret msg expected = checks [hmacBytes alg (fromHex secret) (ascii msg) == fromHex expected] test> hmac_sha2_256.tests.ex1 = @@ -422,7 +422,7 @@ test> hmac_sha2_512.tests.ex2 = Test vectors here pulled from [Wikipedia's writeup](https://en.wikipedia.org/wiki/MD5). -```unison +``` unison ex alg input expected = checks [hashBytes alg (ascii input) == fromHex expected] test> md5.tests.ex1 = diff --git a/unison-src/transcripts-using-base/mvar.output.md b/unison-src/transcripts-using-base/mvar.output.md index 7d92d90c55..466291ead1 100644 --- a/unison-src/transcripts-using-base/mvar.output.md +++ b/unison-src/transcripts-using-base/mvar.output.md @@ -9,8 +9,7 @@ MVars are the building block on which many other concurrency primitives can be built, such as Futures, Run at most once initializer blocks, Queues, etc. - -```unison +``` unison eitherCk : (a -> Boolean) -> Either e a -> Boolean eitherCk f = cases Left _ -> false diff --git a/unison-src/transcripts-using-base/nat-coersion.output.md b/unison-src/transcripts-using-base/nat-coersion.output.md index d4aaf5ef6f..dac858429e 100644 --- a/unison-src/transcripts-using-base/nat-coersion.output.md +++ b/unison-src/transcripts-using-base/nat-coersion.output.md @@ -1,4 +1,4 @@ -```unison +``` unison testNat: Nat -> Optional Int -> Optional Float -> {Stream Result}() testNat n expectInt expectFloat = float = Float.fromRepresentation n diff --git a/unison-src/transcripts-using-base/net.output.md b/unison-src/transcripts-using-base/net.output.md index cae0958240..702be91bbf 100644 --- a/unison-src/transcripts-using-base/net.output.md +++ b/unison-src/transcripts-using-base/net.output.md @@ -1,4 +1,4 @@ -```unison +``` unison serverSocket = compose2 reraise IO.serverSocket.impl socketPort = compose reraise socketPort.impl listen = compose reraise listen.impl @@ -16,14 +16,13 @@ socketAccept = compose reraise socketAccept.impl This section tests functions in the IO builtin related to binding to TCP server socket, as to be able to accept incoming TCP connections. -```builtin -.io2.IO.serverSocket : Optional Text -> Text ->{io2.IO} Either Failure io2.Socket - +``` + builtin.io2.IO.serverSocket : Optional Text -> Text ->{io2.IO} Either Failure io2.Socket ``` This function takes two parameters, The first is the Hostname. If None is provided, We will attempt to bind to 0.0.0.0 (All ipv4 -addresses). We currently only support IPV4 (we should fix this!) +addresses). We currently only support IPV4 (we should fix this\!) The second is the name of the port to bind to. This can be a decimal representation of a port number between 1-65535. This can be a named port like "ssh" (for port 22) or "kermit" (for port 1649), @@ -34,11 +33,11 @@ stored in `/etc/services` and queried with the `getent` tool: # map number to name $ getent services 22 ssh 22/tcp - + # map name to number $ getent services finger finger 79/tcp - + # get a list of all known names $ getent services | head tcpmux 1/tcp @@ -54,7 +53,7 @@ stored in `/etc/services` and queried with the `getent` tool: Below shows different examples of how we might specify the server coordinates. -```unison +``` unison testExplicitHost : '{io2.IO} [Result] testExplicitHost _ = test = 'let @@ -130,7 +129,7 @@ scratch/main> io.test testDefaultPort ``` This example demonstrates connecting a TCP client socket to a TCP server socket. A thread is started for both client and server. The server socket asks for any availalbe port (by passing "0" as the port number). The server thread then queries for the actual assigned port number, and puts that into an MVar which the client thread can read. The client thread then reads a string from the server and reports it back to the main thread via a different MVar. -```unison +``` unison serverThread: MVar Nat -> Text -> '{io2.IO}() serverThread portVar toSend = 'let go : '{io2.IO, Exception}() diff --git a/unison-src/transcripts-using-base/random-deserial.output.md b/unison-src/transcripts-using-base/random-deserial.output.md index 2606511bac..66d6354d5b 100644 --- a/unison-src/transcripts-using-base/random-deserial.output.md +++ b/unison-src/transcripts-using-base/random-deserial.output.md @@ -1,4 +1,4 @@ -```unison +``` unison directory = "unison-src/transcripts-using-base/serialized-cases/" availableCases : '{IO,Exception} [Text] diff --git a/unison-src/transcripts-using-base/ref-promise.output.md b/unison-src/transcripts-using-base/ref-promise.output.md index 9f4c700b1a..bcc4487c3f 100644 --- a/unison-src/transcripts-using-base/ref-promise.output.md +++ b/unison-src/transcripts-using-base/ref-promise.output.md @@ -3,7 +3,7 @@ Ref support a CAS operation that can be used as a building block to change state atomically without locks. -```unison +``` unison casTest: '{io2.IO} [Result] casTest = do test = do @@ -52,7 +52,7 @@ scratch/main> io.test casTest ``` Promise is a simple one-shot awaitable condition. -```unison +``` unison promiseSequentialTest : '{IO} [Result] promiseSequentialTest = do test = do @@ -126,7 +126,7 @@ scratch/main> io.test promiseConcurrentTest ``` CAS can be used to write an atomic update function. -```unison +``` unison atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () atomicUpdate ref f = ticket = Ref.readForCas ref @@ -158,7 +158,7 @@ scratch/main> add Promise can be used to write an operation that spawns N concurrent tasks and collects their results -```unison +``` unison spawnN : Nat -> '{IO} a ->{IO} [a] spawnN n fa = use Nat eq drop @@ -198,7 +198,7 @@ We can use these primitives to write a more interesting example, where multiple threads repeatedly update an atomic counter, we check that the value of the counter is correct after all threads are done. -```unison +``` unison fullTest : '{IO} [Result] fullTest = do use Nat * + eq drop diff --git a/unison-src/transcripts-using-base/serial-test-00.output.md b/unison-src/transcripts-using-base/serial-test-00.output.md index 88a18a7059..019289ccdb 100644 --- a/unison-src/transcripts-using-base/serial-test-00.output.md +++ b/unison-src/transcripts-using-base/serial-test-00.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural type Tree a = Leaf | Node (Tree a) a (Tree a) foldMap : r -> (r -> r -> r) -> (a -> r) -> Tree a -> r diff --git a/unison-src/transcripts-using-base/serial-test-01.output.md b/unison-src/transcripts-using-base/serial-test-01.output.md index 5825b36ff5..a1a9668c1a 100644 --- a/unison-src/transcripts-using-base/serial-test-01.output.md +++ b/unison-src/transcripts-using-base/serial-test-01.output.md @@ -1,4 +1,4 @@ -```unison +``` unison l1 = [1.0,2.0,3.0] l2 = [+1,+2,+3] l3 = [?a, ?b, ?c] diff --git a/unison-src/transcripts-using-base/serial-test-02.output.md b/unison-src/transcripts-using-base/serial-test-02.output.md index ecbe82ebee..3a352b88b5 100644 --- a/unison-src/transcripts-using-base/serial-test-02.output.md +++ b/unison-src/transcripts-using-base/serial-test-02.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural ability Exit a where exit : a -> b diff --git a/unison-src/transcripts-using-base/serial-test-03.output.md b/unison-src/transcripts-using-base/serial-test-03.output.md index f21afcbbb5..a1ca50f908 100644 --- a/unison-src/transcripts-using-base/serial-test-03.output.md +++ b/unison-src/transcripts-using-base/serial-test-03.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural ability DC r where shift : ((a -> r) -> r) -> a diff --git a/unison-src/transcripts-using-base/serial-test-04.output.md b/unison-src/transcripts-using-base/serial-test-04.output.md index 044eabd264..0b0b6230e4 100644 --- a/unison-src/transcripts-using-base/serial-test-04.output.md +++ b/unison-src/transcripts-using-base/serial-test-04.output.md @@ -1,4 +1,4 @@ -```unison +``` unison mutual0 = cases 0 -> "okay" n -> diff --git a/unison-src/transcripts-using-base/stm.output.md b/unison-src/transcripts-using-base/stm.output.md index f54199f8ee..fd8fb97280 100644 --- a/unison-src/transcripts-using-base/stm.output.md +++ b/unison-src/transcripts-using-base/stm.output.md @@ -1,6 +1,7 @@ Loops that access a shared counter variable, accessed in transactions. Some thread delaying is just accomplished by counting in a loop. -```unison + +``` unison count : Nat -> () count = cases 0 -> () @@ -56,7 +57,7 @@ scratch/main> add ``` Test case. -```unison +``` unison spawn : Nat ->{io2.IO} Result spawn k = let out1 = TVar.newIO None diff --git a/unison-src/transcripts-using-base/test-watch-dependencies.output.md b/unison-src/transcripts-using-base/test-watch-dependencies.output.md index 7b71b244be..b38e4373ad 100644 --- a/unison-src/transcripts-using-base/test-watch-dependencies.output.md +++ b/unison-src/transcripts-using-base/test-watch-dependencies.output.md @@ -4,13 +4,13 @@ https://github.com/unisonweb/unison/issues/2195 We add a simple definition. -```unison +``` unison x = 999 ``` Now, we update that definition and define a test-watch which depends on it. -```unison +``` unison x = 1000 test> mytest = checks [x + 1 == 1001] ``` @@ -54,9 +54,9 @@ scratch/main> add Tip: Use `help filestatus` to learn more. ``` ---- +----- -```unison +``` unison y = 42 test> useY = checks [y + 1 == 43] ``` diff --git a/unison-src/transcripts-using-base/thread.output.md b/unison-src/transcripts-using-base/thread.output.md index 6fe4e8800c..bab82e7eb1 100644 --- a/unison-src/transcripts-using-base/thread.output.md +++ b/unison-src/transcripts-using-base/thread.output.md @@ -1,6 +1,6 @@ Lets just make sure we can start a thread -```unison +``` unison otherThread : '{io2.IO}() otherThread = 'let watch "I'm the other Thread" () @@ -32,7 +32,7 @@ testBasicFork = 'let ``` See if we can get another thread to stuff a value into a MVar -```unison +``` unison thread1 : Nat -> MVar Nat -> '{io2.IO}() thread1 x mv = 'let go = 'let @@ -89,7 +89,7 @@ scratch/main> io.test testBasicMultiThreadMVar Tip: Use view 1 to view the source of a test. ``` -```unison +``` unison sendingThread: Nat -> MVar Nat -> '{io2.IO}() sendingThread toSend mv = 'let go = 'let diff --git a/unison-src/transcripts-using-base/tls.output.md b/unison-src/transcripts-using-base/tls.output.md index a584bdfa92..fc0362d8c6 100644 --- a/unison-src/transcripts-using-base/tls.output.md +++ b/unison-src/transcripts-using-base/tls.output.md @@ -1,6 +1,6 @@ # Tests for TLS builtins -```unison +``` unison -- generated with: -- openssl req -newkey rsa:2048 -subj '/CN=test.unison.cloud/O=Unison/C=US' -nodes -keyout key.pem -x509 -days 3650 -out cert.pem @@ -15,7 +15,7 @@ not_a_cert = "-----BEGIN SCHERMIFICATE-----\n-----END SCHERMIFICATE-----" First lets make sure we can load our cert and private key -```unison +``` unison this_should_work=match (decodeCert.impl (toUtf8 self_signed_cert_pem2) with Left (Failure _ t _) -> [Fail t] Right _ -> [Ok "succesfully decoded self_signed_pem"] @@ -71,7 +71,7 @@ We'll create a server and a client, and start threads for each. The server will report the port it is bound to via a passed MVar which the client can read. -```unison +``` unison serverThread: MVar Nat -> Text -> '{io2.IO}() serverThread portVar toSend = 'let go: '{io2.IO, Exception}() diff --git a/unison-src/transcripts-using-base/utf8.output.md b/unison-src/transcripts-using-base/utf8.output.md index c065222115..0cd3d4c0d5 100644 --- a/unison-src/transcripts-using-base/utf8.output.md +++ b/unison-src/transcripts-using-base/utf8.output.md @@ -1,4 +1,4 @@ -Test for new Text -> Bytes conversions explicitly using UTF-8 as the encoding +Test for new Text -\> Bytes conversions explicitly using UTF-8 as the encoding Unison has function for converting between `Text` and a UTF-8 `Bytes` encoding of the Text. @@ -13,7 +13,7 @@ scratch/main> find Utf8 ``` ascii characters are encoded as single bytes (in the range 0-127). -```unison +``` unison ascii: Text ascii = "ABCDE" @@ -44,7 +44,7 @@ ascii = "ABCDE" ``` non-ascii characters are encoded as multiple bytes. -```unison +``` unison greek: Text greek = "ΑΒΓΔΕ" @@ -73,7 +73,7 @@ greek = "ΑΒΓΔΕ" ``` We can check that encoding and then decoding should give us back the same `Text` we started with -```unison +``` unison checkRoundTrip: Text -> [Result] checkRoundTrip t = bytes = toUtf8 t @@ -110,7 +110,7 @@ test> greekTest = checkRoundTrip greek ``` If we try to decode an invalid set of bytes, we get back `Text` explaining the decoding error: -```unison +``` unison greek_bytes = Bytes.fromList [206, 145, 206, 146, 206, 147, 206, 148, 206] diff --git a/unison-src/transcripts/abilities.output.md b/unison-src/transcripts/abilities.output.md index 8fd69ddbc6..52428c98f8 100644 --- a/unison-src/transcripts/abilities.output.md +++ b/unison-src/transcripts/abilities.output.md @@ -1,7 +1,6 @@ - Some random ability stuff to ensure things work. -```unison +``` unison unique ability A where one : Nat ->{A} Nat two : Nat -> Nat ->{A} Nat diff --git a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md index 6f6eac30ed..7b98c2065e 100644 --- a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md +++ b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md @@ -1,6 +1,6 @@ The order of a set of abilities is normalized before hashing. -```unison +``` unison unique ability Foo where foo : () diff --git a/unison-src/transcripts/ability-term-conflicts-on-update.output.md b/unison-src/transcripts/ability-term-conflicts-on-update.output.md index 7ea11e01c0..a9bba9dbfe 100644 --- a/unison-src/transcripts/ability-term-conflicts-on-update.output.md +++ b/unison-src/transcripts/ability-term-conflicts-on-update.output.md @@ -5,7 +5,7 @@ https://github.com/unisonweb/unison/issues/2786 First we add an ability to the codebase. Note that this will create the name `Channels.send` as an ability constructor. -```unison +``` unison unique ability Channels where send : a -> {Channels} () ``` @@ -31,11 +31,11 @@ scratch/main> add ability Channels ``` -Now we update the ability, changing the name of the constructor, _but_, we simultaneously +Now we update the ability, changing the name of the constructor, *but*, we simultaneously add a new top-level term with the same name as the constructor which is being removed from Channels. -```unison +``` unison unique ability Channels where sends : [a] -> {Channels} () @@ -89,9 +89,9 @@ scratch/main> update.old patch thing ability Channels ``` -If however, `Channels.send` and `thing` _depend_ on `Channels`, updating them should succeed since it pulls in the ability as a dependency. +If however, `Channels.send` and `thing` *depend* on `Channels`, updating them should succeed since it pulls in the ability as a dependency. -```unison +``` unison unique ability Channels where sends : [a] -> {Channels} () @@ -165,7 +165,7 @@ scratch/main> update.old ``` # Constructor-term conflict -```unison +``` unison X.x = 1 ``` @@ -190,7 +190,7 @@ scratch/main2> add X.x : Nat ``` -```unison +``` unison structural ability X where x : () ``` diff --git a/unison-src/transcripts/add-run.output.md b/unison-src/transcripts/add-run.output.md index 53cc27b943..c1802922f6 100644 --- a/unison-src/transcripts/add-run.output.md +++ b/unison-src/transcripts/add-run.output.md @@ -2,7 +2,7 @@ ## Basic usage -```unison +``` unison even : Nat -> Boolean even x = if x == 0 then true else odd (drop x 1) @@ -47,6 +47,7 @@ scratch/main> run is2even ``` it errors if the desired result name conflicts with a name in the unison file + ```ucm scratch/main> add.run is2even @@ -57,6 +58,7 @@ scratch/main> add.run is2even ``` otherwise, the result is successfully persisted + ```ucm scratch/main> add.run foo.bar.baz @@ -74,7 +76,7 @@ scratch/main> view foo.bar.baz ``` ## It resolves references within the unison file -```unison +``` unison z b = b Nat.+ 12 y a b = a Nat.+ b Nat.+ z 10 @@ -115,7 +117,7 @@ scratch/main> add.run result ``` ## It resolves references within the codebase -```unison +``` unison inc : Nat -> Nat inc x = x + 1 ``` @@ -141,7 +143,7 @@ scratch/main> add inc inc : Nat -> Nat ``` -```unison +``` unison main : '(Nat -> Nat) main _ x = inc x ``` @@ -178,7 +180,7 @@ scratch/main> view natfoo ``` ## It captures scratch file dependencies at run time -```unison +``` unison x = 1 y = x + x main = 'y @@ -205,7 +207,7 @@ scratch/main> run main 2 ``` -```unison +``` unison x = 50 ``` @@ -223,6 +225,7 @@ x = 50 ``` this saves 2 to xres, rather than 100 + ```ucm scratch/main> add.run xres @@ -238,7 +241,7 @@ scratch/main> view xres ``` ## It fails with a message if add cannot complete cleanly -```unison +``` unison main = '5 ``` @@ -272,7 +275,7 @@ scratch/main> add.run xres ``` ## It works with absolute names -```unison +``` unison main = '5 ``` diff --git a/unison-src/transcripts/add-test-watch-roundtrip.output.md b/unison-src/transcripts/add-test-watch-roundtrip.output.md index 114d9399fd..e276eba244 100644 --- a/unison-src/transcripts/add-test-watch-roundtrip.output.md +++ b/unison-src/transcripts/add-test-watch-roundtrip.output.md @@ -1,9 +1,9 @@ -```unison +``` unison test> foo : [Test.Result] foo = [] ``` -Apparently when we add a test watch, we add a type annotation to it, even if it already has one. We don't want this to happen though! +Apparently when we add a test watch, we add a type annotation to it, even if it already has one. We don't want this to happen though\! ```ucm scratch/main> add diff --git a/unison-src/transcripts/addupdatemessages.output.md b/unison-src/transcripts/addupdatemessages.output.md index ffd7bbd804..813639f58d 100644 --- a/unison-src/transcripts/addupdatemessages.output.md +++ b/unison-src/transcripts/addupdatemessages.output.md @@ -2,7 +2,7 @@ Let's set up some definitions to start: -```unison +``` unison x = 1 y = 2 @@ -41,7 +41,7 @@ scratch/main> add ``` Let's add an alias for `1` and `One`: -```unison +``` unison z = 1 structural type Z = One Nat @@ -79,7 +79,7 @@ scratch/main> add ``` Let's update something that has an alias (to a value that doesn't have a name already): -```unison +``` unison x = 3 structural type X = Three Nat Nat Nat ``` @@ -118,7 +118,7 @@ scratch/main> update ``` Update it to something that already exists with a different name: -```unison +``` unison x = 2 structural type X = Two Nat Nat ``` diff --git a/unison-src/transcripts/alias-many.output.md b/unison-src/transcripts/alias-many.output.md index b12422e093..942539b629 100644 --- a/unison-src/transcripts/alias-many.output.md +++ b/unison-src/transcripts/alias-many.output.md @@ -1,17 +1,14 @@ The `alias.many` command can be used to copy definitions from the current namespace into your curated one. The names that will be used in the target namespace are the names you specify, relative to the current namespace: -```scratch -/main> help alias.many + scratch/main> help alias.many + + alias.many (or copy) + `alias.many [relative2...] ` creates aliases `relative1`, `relative2`, ... + in the namespace `namespace`. + `alias.many foo.foo bar.bar .quux` creates aliases `.quux.foo.foo` and `.quux.bar.bar`. - alias.many (or copy) - `alias.many [relative2...] ` creates aliases `relative1`, `relative2`, ... - in the namespace `namespace`. - `alias.many foo.foo bar.bar .quux` creates aliases `.quux.foo.foo` and `.quux.bar.bar`. - -``` - -Let's try it! +Let's try it\! ```ucm scratch/main> alias.many List.adjacentPairs List.all List.any List.chunk List.chunksOf List.dropWhile List.first List.init List.intersperse List.isEmpty List.last List.replicate List.splitAt List.tail List.takeWhile mylib @@ -62,4 +59,5 @@ scratch/main> find-in mylib ``` -Thanks, `alias.many! +Thanks, `alias.many`\! + diff --git a/unison-src/transcripts/anf-tests.output.md b/unison-src/transcripts/anf-tests.output.md index b9360ee4c3..b1dc2f599f 100644 --- a/unison-src/transcripts/anf-tests.output.md +++ b/unison-src/transcripts/anf-tests.output.md @@ -1,15 +1,14 @@ - This tests a variable related bug in the ANF compiler. The nested let would get flattened out, resulting in: bar = result -which would be handled by renaming. However, the _context_ portion of +which would be handled by renaming. However, the *context* portion of the rest of the code was not being renamed correctly, so `bar` would remain in the definition of `baz`. -```unison +``` unison foo _ = id x = x void x = () diff --git a/unison-src/transcripts/any-extract.output.md b/unison-src/transcripts/any-extract.output.md index c8fc99095b..8f3488cb49 100644 --- a/unison-src/transcripts/any-extract.output.md +++ b/unison-src/transcripts/any-extract.output.md @@ -2,7 +2,7 @@ Any.unsafeExtract is a way to extract the value contained in an Any. This is unsafe because it allows the programmer to coerce a value into any type, which would cause undefined behaviour if used to coerce a value to the wrong type. -```unison +``` unison test> Any.unsafeExtract.works = use Nat != checks [1 == Any.unsafeExtract (Any 1), diff --git a/unison-src/transcripts/api-doc-rendering.output.md b/unison-src/transcripts/api-doc-rendering.output.md index f767c14cf7..8afef59e8c 100644 --- a/unison-src/transcripts/api-doc-rendering.output.md +++ b/unison-src/transcripts/api-doc-rendering.output.md @@ -1,6 +1,6 @@ # Doc rendering -```unison +``` unison structural type Maybe a = Nothing | Just a otherTerm = "text" diff --git a/unison-src/transcripts/api-find.output.md b/unison-src/transcripts/api-find.output.md index d44200e7a2..aecfe603a2 100644 --- a/unison-src/transcripts/api-find.output.md +++ b/unison-src/transcripts/api-find.output.md @@ -1,6 +1,6 @@ # find api -```unison +``` unison rachel.filesystem.x = 42 ross.httpClient.y = 43 joey.httpServer.z = 44 diff --git a/unison-src/transcripts/api-getDefinition.output.md b/unison-src/transcripts/api-getDefinition.output.md index 5e854a440c..bf244e4a06 100644 --- a/unison-src/transcripts/api-getDefinition.output.md +++ b/unison-src/transcripts/api-getDefinition.output.md @@ -1,6 +1,6 @@ # Get Definitions Test -```unison +``` unison nested.names.x.doc = {{ Documentation }} nested.names.x = 42 ``` @@ -205,7 +205,7 @@ GET /api/projects/scratch/branches/main/getDefinition?names=%23qkhkl0n238&relati }, "typeDefinitions": {} } -``````unison +`````` unison doctest.thing.doc = {{ The correct docs for the thing }} doctest.thing = "A thing" doctest.thingalias.doc = {{ Docs for the alias, should not be displayed }} diff --git a/unison-src/transcripts/api-namespace-details.output.md b/unison-src/transcripts/api-namespace-details.output.md index 0cdf2e88be..593efac4fd 100644 --- a/unison-src/transcripts/api-namespace-details.output.md +++ b/unison-src/transcripts/api-namespace-details.output.md @@ -1,6 +1,6 @@ # Namespace Details Test -```unison +``` unison {{ Documentation }} nested.names.x = 42 diff --git a/unison-src/transcripts/api-namespace-list.output.md b/unison-src/transcripts/api-namespace-list.output.md index 4219aa1916..6116dad617 100644 --- a/unison-src/transcripts/api-namespace-list.output.md +++ b/unison-src/transcripts/api-namespace-list.output.md @@ -1,6 +1,6 @@ # Namespace list api -```unison +``` unison {{ Documentation }} nested.names.x = 42 diff --git a/unison-src/transcripts/api-summaries.output.md b/unison-src/transcripts/api-summaries.output.md index e9f93e624e..de7e14c3aa 100644 --- a/unison-src/transcripts/api-summaries.output.md +++ b/unison-src/transcripts/api-summaries.output.md @@ -1,6 +1,6 @@ # Definition Summary APIs -```unison +``` unison nat : Nat nat = 42 doc : Doc2 diff --git a/unison-src/transcripts/block-on-required-update.output.md b/unison-src/transcripts/block-on-required-update.output.md index 0935b7317a..49e1332464 100644 --- a/unison-src/transcripts/block-on-required-update.output.md +++ b/unison-src/transcripts/block-on-required-update.output.md @@ -2,7 +2,7 @@ Should block an `add` if it requires an update on an in-file dependency. -```unison +``` unison x = 1 ``` @@ -29,7 +29,7 @@ scratch/main> add ``` Update `x`, and add a new `y` which depends on the update -```unison +``` unison x = 10 y = x + 1 ``` diff --git a/unison-src/transcripts/blocks.output.md b/unison-src/transcripts/blocks.output.md index 687ca98067..b017e0cfc9 100644 --- a/unison-src/transcripts/blocks.output.md +++ b/unison-src/transcripts/blocks.output.md @@ -4,7 +4,7 @@ For example: -```unison +``` unison ex thing = thing y = y -- refers to `thing` in this block @@ -39,7 +39,7 @@ ex thing = The `thing` reference in `bar` refers to the one declared locally in the block that `bar` is part of. This is true even if the declaration which shadows the outer name appears later in the block, for instance: -```unison +``` unison ex thing = bar x = thing x + 1 thing y = y @@ -72,7 +72,7 @@ ex thing = This is just the normal lexical scoping behavior. For example: -```unison +``` unison ex thing = bar x = thing x + 1 -- references outer `thing` baz z = @@ -103,9 +103,9 @@ ex thing = 4201 ``` -Here's another example, showing that bindings cannot reference bindings declared in blocks nested in the _body_ (the final expression) of a block: +Here's another example, showing that bindings cannot reference bindings declared in blocks nested in the *body* (the final expression) of a block: -```unison +``` unison ex thing = bar x = thing x + 1 -- refers to outer thing let @@ -137,9 +137,9 @@ ex thing = ``` ### Blocks can define one or more functions which are recursive or mutually recursive -We call these groups of definitions that reference each other in a block _cycles_. For instance: +We call these groups of definitions that reference each other in a block *cycles*. For instance: -```unison +``` unison sumTo n = -- A recursive function, defined inside a block go acc n = @@ -174,7 +174,7 @@ The `go` function is a one-element cycle (it reference itself), and `ping` and ` For instance, this works: -```unison +``` unison ex n = ping x = pong + 1 + x pong = 42 @@ -198,7 +198,7 @@ Since the forward reference to `pong` appears inside `ping`. This, however, will not compile: -```unison +``` unison ex n = pong = ping + 1 ping = 42 @@ -217,7 +217,7 @@ ex n = ``` This also won't compile; it's a cyclic reference that isn't guarded: -```unison +``` unison ex n = loop = loop loop @@ -234,7 +234,7 @@ ex n = ``` This, however, will compile. This also shows that `'expr` is another way of guarding a definition. -```unison +``` unison ex n = loop = '(!loop) !loop @@ -253,13 +253,13 @@ ex n = ex : n -> r ``` -Just don't try to run it as it's an infinite loop! +Just don't try to run it as it's an infinite loop\! ### Cyclic definitions in a block don't have access to any abilities The reason is it's unclear what the order should be of any requests that are made. It can also be viewed of a special case of the restriction that elements of a cycle must all be guarded. Here's an example: -```unison +``` unison structural ability SpaceAttack where launchMissiles : Text -> Nat @@ -279,11 +279,11 @@ ex n = ``` -### The _body_ of recursive functions can certainly access abilities +### The *body* of recursive functions can certainly access abilities For instance, this works fine: -```unison +``` unison structural ability SpaceAttack where launchMissiles : Text -> Nat @@ -311,7 +311,7 @@ ex n = For instance, `zap` here isn't considered part of the cycle (it doesn't reference `ping` or `pong`), so this typechecks fine: -```unison +``` unison structural ability SpaceAttack where launchMissiles : Text -> Nat @@ -338,7 +338,7 @@ ex n = ``` This is actually parsed as if you moved `zap` after the cycle it find itself a part of: -```unison +``` unison structural ability SpaceAttack where launchMissiles : Text -> Nat diff --git a/unison-src/transcripts/boolean-op-pretty-print-2819.output.md b/unison-src/transcripts/boolean-op-pretty-print-2819.output.md index 48fbfecf68..7fe8f92cfe 100644 --- a/unison-src/transcripts/boolean-op-pretty-print-2819.output.md +++ b/unison-src/transcripts/boolean-op-pretty-print-2819.output.md @@ -1,6 +1,6 @@ Regression test for https://github.com/unisonweb/unison/pull/2819 -```unison +``` unison hangExample : Boolean hangExample = ("a long piece of text to hang the line" == "") diff --git a/unison-src/transcripts/branch-command.output.md b/unison-src/transcripts/branch-command.output.md index 28dd680d5c..569ab5d760 100644 --- a/unison-src/transcripts/branch-command.output.md +++ b/unison-src/transcripts/branch-command.output.md @@ -2,7 +2,7 @@ The `branch` command creates a new branch. First, we'll create a term to include in the branches. -```unison +``` unison someterm = 18 ``` diff --git a/unison-src/transcripts/branch-relative-path.output.md b/unison-src/transcripts/branch-relative-path.output.md index 4f2be5861a..591fa64f8e 100644 --- a/unison-src/transcripts/branch-relative-path.output.md +++ b/unison-src/transcripts/branch-relative-path.output.md @@ -1,4 +1,4 @@ -```unison +``` unison foo = 5 foo.bar = 1 ``` @@ -26,7 +26,7 @@ p0/main> add foo.bar : ##Nat ``` -```unison +``` unison bonk = 5 donk.bonk = 1 ``` diff --git a/unison-src/transcripts/bug-fix-4354.output.md b/unison-src/transcripts/bug-fix-4354.output.md index ca99d870dd..8ef9e7370f 100644 --- a/unison-src/transcripts/bug-fix-4354.output.md +++ b/unison-src/transcripts/bug-fix-4354.output.md @@ -1,4 +1,4 @@ -```unison +``` unison bonk : forall a. a -> a bonk x = zonk : forall a. a -> a diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md index 8b9f7fa75c..91f7ce9980 100644 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ b/unison-src/transcripts/bug-strange-closure.output.md @@ -1,4 +1,3 @@ - We can display the guide before and after adding it to the codebase: ```ucm @@ -414,7 +413,7 @@ We can display the guide before and after adding it to the codebase: ``` But we can't display this due to a decompilation problem. -```unison +``` unison rendered = Pretty.get (docFormatConsole doc.guide) ``` @@ -845,7 +844,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) ``` And then this sometimes generates a GHC crash "strange closure error" but doesn't seem deterministic. -```unison +``` unison rendered = Pretty.get (docFormatConsole doc.guide) > rendered diff --git a/unison-src/transcripts/builtins.output.md b/unison-src/transcripts/builtins.output.md index 4f8967ae09..5ddc4b7659 100644 --- a/unison-src/transcripts/builtins.output.md +++ b/unison-src/transcripts/builtins.output.md @@ -4,7 +4,7 @@ This transcript defines unit tests for builtin functions. There's a single `scra ## `Int` functions -```unison +``` unison use Int -- used for some take/drop tests later @@ -83,7 +83,7 @@ test> Int.tests.conversions = ## `Nat` functions -```unison +``` unison use Nat test> Nat.tests.arithmetic = @@ -153,7 +153,8 @@ test> Nat.tests.conversions = ``` ## `Boolean` functions -```unison + +``` unison test> Boolean.tests.orTable = checks [ true || true == true, @@ -177,7 +178,7 @@ test> Boolean.tests.notTable = ## `Text` functions -```unison +``` unison test> Text.tests.takeDropAppend = checks [ "yabba" ++ "dabba" == "yabbadabba", @@ -271,7 +272,7 @@ test> Text.tests.indexOfEmoji = ## `Bytes` functions -```unison +``` unison test> Bytes.tests.at = bs = Bytes.fromList [77, 13, 12] checks [ @@ -331,7 +332,7 @@ test> Bytes.tests.indexOf = ## `List` comparison -```unison +``` unison test> checks [ compare [] [1,2,3] == -1, compare [1,2,3] [1,2,3,4] == -1, @@ -345,7 +346,8 @@ test> checks [ ``` Other list functions -```unison + +``` unison test> checks [ List.take bigN [1,2,3] == [1,2,3], List.drop bigN [1,2,3] == [] @@ -354,7 +356,7 @@ test> checks [ ## `Any` functions -```unison +``` unison > [Any "hi", Any (41 + 1)] test> Any.test1 = checks [(Any "hi" == Any "hi")] @@ -392,7 +394,7 @@ test> Any.test2 = checks [(not (Any "hi" == Any 42))] ``` ## Sandboxing functions -```unison +``` unison openFile1 t = openFile t openFile2 t = openFile1 t @@ -453,7 +455,7 @@ openFile] ✅ Passed Passed ``` -```unison +``` unison openFilesIO = do checks [ not (validateSandboxedSimpl [] (value openFile)) @@ -501,7 +503,7 @@ scratch/main> io.test openFilesIO Just exercises the function -```unison +``` unison > Universal.murmurHash 1 test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Universal.murmurHash [1,2,3]] ``` diff --git a/unison-src/transcripts/bytesFromList.output.md b/unison-src/transcripts/bytesFromList.output.md index 7d28cfc07a..099a73cb59 100644 --- a/unison-src/transcripts/bytesFromList.output.md +++ b/unison-src/transcripts/bytesFromList.output.md @@ -1,7 +1,6 @@ - This should render as `Bytes.fromList [1,2,3,4]`, not `##Bytes.fromSequence [1,2,3,4]`: -```unison +``` unison > Bytes.fromList [1,2,3,4] ``` diff --git a/unison-src/transcripts/check763.output.md b/unison-src/transcripts/check763.output.md index fe50b6834d..0d5dcc0ba2 100644 --- a/unison-src/transcripts/check763.output.md +++ b/unison-src/transcripts/check763.output.md @@ -1,6 +1,6 @@ Regression test for https://github.com/unisonweb/unison/issues/763 -```unison +``` unison (+-+) : Nat -> Nat -> Nat (+-+) x y = x * y ``` diff --git a/unison-src/transcripts/check873.output.md b/unison-src/transcripts/check873.output.md index 5f21cec202..cc952accaf 100644 --- a/unison-src/transcripts/check873.output.md +++ b/unison-src/transcripts/check873.output.md @@ -1,6 +1,6 @@ See [this ticket](https://github.com/unisonweb/unison/issues/873); the point being, this shouldn't crash the runtime. :) -```unison +``` unison (-) = builtin.Nat.sub ``` @@ -25,7 +25,7 @@ scratch/main> add - : Nat -> Nat -> Int ``` -```unison +``` unison baz x = x - 1 ``` diff --git a/unison-src/transcripts/constructor-applied-to-unit.output.md b/unison-src/transcripts/constructor-applied-to-unit.output.md index 4acfdcd865..04cc3c417a 100644 --- a/unison-src/transcripts/constructor-applied-to-unit.output.md +++ b/unison-src/transcripts/constructor-applied-to-unit.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural type Zoink a b c = Zoink a b c > Any () diff --git a/unison-src/transcripts/contrabilities.output.md b/unison-src/transcripts/contrabilities.output.md index d8c725660c..f3b76a8c5e 100644 --- a/unison-src/transcripts/contrabilities.output.md +++ b/unison-src/transcripts/contrabilities.output.md @@ -1,4 +1,4 @@ -```unison +``` unison f : (() -> a) -> Nat f x = 42 ``` diff --git a/unison-src/transcripts/cycle-update-1.output.md b/unison-src/transcripts/cycle-update-1.output.md index 25cd6f3984..3cfeca6fc2 100644 --- a/unison-src/transcripts/cycle-update-1.output.md +++ b/unison-src/transcripts/cycle-update-1.output.md @@ -1,6 +1,6 @@ Update a member of a cycle, but retain the cycle. -```unison +``` unison ping : 'Nat ping _ = !pong + 1 @@ -31,7 +31,7 @@ scratch/main> add pong : 'Nat ``` -```unison +``` unison ping : 'Nat ping _ = !pong + 3 ``` diff --git a/unison-src/transcripts/cycle-update-2.output.md b/unison-src/transcripts/cycle-update-2.output.md index 89e740faa4..11b97f14d8 100644 --- a/unison-src/transcripts/cycle-update-2.output.md +++ b/unison-src/transcripts/cycle-update-2.output.md @@ -1,6 +1,6 @@ Update a member of a cycle with a type-preserving update, but sever the cycle. -```unison +``` unison ping : 'Nat ping _ = !pong + 1 @@ -31,7 +31,7 @@ scratch/main> add pong : 'Nat ``` -```unison +``` unison ping : 'Nat ping _ = 3 ``` diff --git a/unison-src/transcripts/cycle-update-3.output.md b/unison-src/transcripts/cycle-update-3.output.md index f21e3fe9d8..cf8c1c72ca 100644 --- a/unison-src/transcripts/cycle-update-3.output.md +++ b/unison-src/transcripts/cycle-update-3.output.md @@ -1,6 +1,6 @@ Update a member of a cycle with a type-changing update, thus severing the cycle. -```unison +``` unison ping : 'Nat ping _ = !pong + 1 @@ -31,7 +31,7 @@ scratch/main> add pong : 'Nat ``` -```unison +``` unison ping : Nat ping = 3 ``` diff --git a/unison-src/transcripts/cycle-update-4.output.md b/unison-src/transcripts/cycle-update-4.output.md index 0eb134f0f6..c3bcccbd1c 100644 --- a/unison-src/transcripts/cycle-update-4.output.md +++ b/unison-src/transcripts/cycle-update-4.output.md @@ -1,6 +1,6 @@ `update` properly discovers and establishes new cycles. -```unison +``` unison ping : 'Nat ping _ = 1 @@ -31,7 +31,7 @@ scratch/main> add pong : 'Nat ``` -```unison +``` unison ping : 'Nat ping _ = !clang + 1 diff --git a/unison-src/transcripts/cycle-update-5.output.md b/unison-src/transcripts/cycle-update-5.output.md index b6c1a07176..a022fbed62 100644 --- a/unison-src/transcripts/cycle-update-5.output.md +++ b/unison-src/transcripts/cycle-update-5.output.md @@ -1,6 +1,6 @@ Not yet working: properly updating nameless implicit terms. -```unison +``` unison inner.ping : 'Nat inner.ping _ = !pong + 1 @@ -34,7 +34,7 @@ scratch/main> add Here we queue up an update by saving in a namespace where `inner.ping` and `pong` both have names, but then apply the update in a namespace where only `ping` has a name. -```unison +``` unison inner.ping : 'Nat inner.ping _ = !pong + 3 ``` @@ -72,4 +72,5 @@ scratch/main> view inner.ping ``` The bug here is that `inner.ping` still refers to `pong` by name. But if we properly identified the nameless (in the context that the update was applied) `pong` as an implicit term to include in the new `ping`'s cycle, then `ping` would -be left referring to a nameless thing (namely, `pong`, but updated to refer to the new `ping). +be left referring to a nameless thing (namely, `pong`, but updated to refer to the new `ping`). + diff --git a/unison-src/transcripts/debug-definitions.output.md b/unison-src/transcripts/debug-definitions.output.md index 37d6591e25..8689d2d780 100644 --- a/unison-src/transcripts/debug-definitions.output.md +++ b/unison-src/transcripts/debug-definitions.output.md @@ -1,4 +1,4 @@ -```unison +``` unison x = 30 y : Nat diff --git a/unison-src/transcripts/debug-name-diffs.output.md b/unison-src/transcripts/debug-name-diffs.output.md index 9d15bfe476..0333dee6b9 100644 --- a/unison-src/transcripts/debug-name-diffs.output.md +++ b/unison-src/transcripts/debug-name-diffs.output.md @@ -1,4 +1,4 @@ -```unison +``` unison a.b.one = 1 a.two = 2 diff --git a/unison-src/transcripts/deep-names.output.md b/unison-src/transcripts/deep-names.output.md index 833ae613a9..dcaf16dbea 100644 --- a/unison-src/transcripts/deep-names.output.md +++ b/unison-src/transcripts/deep-names.output.md @@ -1,7 +1,8 @@ First we'll set up two libraries, and then we'll use them in some projects and show what `names` are deep-loaded for them. Our two "libraries": -```unison + +``` unison text.a = 1 text.b = 2 text.c = 3 @@ -12,6 +13,7 @@ http.z = 8 ``` Our `app1` project includes the text library twice and the http library twice as direct dependencies. + ```ucm scratch/app1> fork text lib.text_v1 @@ -39,6 +41,7 @@ scratch/app1> delete.namespace http ``` As such, we see two copies of `a` and two copies of `x` via these direct dependencies. + ```ucm scratch/app1> names a @@ -59,6 +62,7 @@ scratch/app1> names x ``` Our `app2` project includes the `http` library twice as direct dependencies, and once as an indirect dependency via `webutil`. It also includes the `text` library twice as indirect dependencies via `webutil` + ```ucm scratch/app2> fork http lib.http_v1 @@ -91,6 +95,7 @@ scratch/app2> delete.namespace text ``` Now we see two copies of `x` via direct dependencies on `http`, and one copy of `a` via indirect dependency on `text` via `webutil`. We see neither the second indirect copy of `a` nor the indirect copy of `x` via webutil because we already have names for them. + ```ucm scratch/app2> names a diff --git a/unison-src/transcripts/definition-diff-api.output.md b/unison-src/transcripts/definition-diff-api.output.md index 192367ff9f..460e84d807 100644 --- a/unison-src/transcripts/definition-diff-api.output.md +++ b/unison-src/transcripts/definition-diff-api.output.md @@ -4,7 +4,7 @@ diffs/main> builtins.merge Done. ``` -```unison +``` unison term = _ = "Here's some text" 1 + 1 @@ -42,7 +42,7 @@ diffs/main> branch.create new `switch /main` then `merge /new`. ``` -```unison +``` unison term = _ = "Here's some different text" 1 + 2 diff --git a/unison-src/transcripts/delete-namespace-dependents-check.output.md b/unison-src/transcripts/delete-namespace-dependents-check.output.md index 4ab6524093..ce131fcb71 100644 --- a/unison-src/transcripts/delete-namespace-dependents-check.output.md +++ b/unison-src/transcripts/delete-namespace-dependents-check.output.md @@ -2,9 +2,9 @@ # Delete namespace dependents check -This is a regression test, previously `delete.namespace` allowed a delete as long as the deletions had a name _anywhere_ in your codebase, it should only check the current project branch. +This is a regression test, previously `delete.namespace` allowed a delete as long as the deletions had a name *anywhere* in your codebase, it should only check the current project branch. -```unison +``` unison sub.dependency = 123 dependent = dependency + 99 diff --git a/unison-src/transcripts/delete-namespace.output.md b/unison-src/transcripts/delete-namespace.output.md index 563b98ad2c..a57094d9eb 100644 --- a/unison-src/transcripts/delete-namespace.output.md +++ b/unison-src/transcripts/delete-namespace.output.md @@ -1,6 +1,6 @@ # delete.namespace.force -```unison +``` unison no_dependencies.thing = "no dependents on this term" dependencies.term1 = 1 diff --git a/unison-src/transcripts/delete-silent.output.md b/unison-src/transcripts/delete-silent.output.md index 3ec5397fc6..899a38b3be 100644 --- a/unison-src/transcripts/delete-silent.output.md +++ b/unison-src/transcripts/delete-silent.output.md @@ -7,7 +7,7 @@ scratch/main> delete foo foo ``` -```unison +``` unison foo = 1 structural type Foo = Foo () ``` diff --git a/unison-src/transcripts/delete.output.md b/unison-src/transcripts/delete.output.md index 14ca930fe1..853f2ee386 100644 --- a/unison-src/transcripts/delete.output.md +++ b/unison-src/transcripts/delete.output.md @@ -17,7 +17,7 @@ exist. Now for some easy cases. Deleting an unambiguous term, then deleting an unambiguous type. -```unison +``` unison foo = 1 structural type Foo = Foo () ``` @@ -57,7 +57,7 @@ structural type Foo = Foo () ``` How about an ambiguous term? -```unison +``` unison foo = 1 bar = 2 ``` @@ -101,7 +101,7 @@ A delete should remove both versions of the term. ``` Let's repeat all that on a type, for completeness. -```unison +``` unison structural type Foo = Foo () structural type Bar = Bar ``` @@ -144,7 +144,7 @@ structural type Bar = Bar ``` Finally, let's try to delete a term and a type with the same name. -```unison +``` unison foo = 1 structural type foo = Foo () ``` @@ -169,7 +169,7 @@ structural type foo = Foo () ``` We want to be able to delete multiple terms at once -```unison +``` unison a = "a" b = "b" c = "c" @@ -197,7 +197,7 @@ c = "c" ``` We can delete terms and types in the same invocation of delete -```unison +``` unison structural type Foo = Foo () a = "a" b = "b" @@ -238,7 +238,7 @@ c = "c" ``` We can delete a type and its constructors -```unison +``` unison structural type Foo = Foo () ``` @@ -266,7 +266,7 @@ structural type Foo = Foo () ``` You should not be able to delete terms which are referenced by other terms -```unison +``` unison a = 1 b = 2 c = 3 @@ -299,7 +299,7 @@ d = a + b + c ``` But you should be able to delete all terms which reference each other in a single command -```unison +``` unison e = 11 f = 12 + e g = 13 + f @@ -330,7 +330,7 @@ h = e + f + g ``` You should be able to delete a type and all the functions that reference it in a single command -```unison +``` unison structural type Foo = Foo Nat incrementFoo : Foo -> Nat @@ -359,7 +359,7 @@ incrementFoo = cases ``` If you mess up on one of the names of your command, delete short circuits -```unison +``` unison e = 11 f = 12 + e g = 13 + f @@ -386,7 +386,7 @@ h = e + f + g ``` Cyclical terms which are guarded by a lambda are allowed to be deleted -```unison +``` unison ping _ = 1 Nat.+ !pong pong _ = 4 Nat.+ !ping ``` diff --git a/unison-src/transcripts/dependents-dependencies-debugfile.output.md b/unison-src/transcripts/dependents-dependencies-debugfile.output.md index 90f3fefbc8..19b2526d75 100644 --- a/unison-src/transcripts/dependents-dependencies-debugfile.output.md +++ b/unison-src/transcripts/dependents-dependencies-debugfile.output.md @@ -1,8 +1,10 @@ ### `debug.file` + I can use `debug.file` to see the hashes of the last typechecked file. Given this .u file: -```unison + +``` unison structural type outside.A = A Nat outside.B structural type outside.B = B Int outside.c = 3 @@ -30,7 +32,9 @@ scratch/main> debug.file This will help me make progress in some situations when UCM is being deficient or broken. ### `dependents` / `dependencies` + But wait, there's more. I can check the dependencies and dependents of a definition: + ```ucm scratch/main> add @@ -110,3 +114,4 @@ scratch/main> dependents d ``` We don't have an index for dependents of constructors, but iirc if you ask for that, it will show you dependents of the structural type that provided the constructor. + diff --git a/unison-src/transcripts/destructuring-binds.output.md b/unison-src/transcripts/destructuring-binds.output.md index 4185a71b91..ec7f39182e 100644 --- a/unison-src/transcripts/destructuring-binds.output.md +++ b/unison-src/transcripts/destructuring-binds.output.md @@ -2,7 +2,7 @@ Here's a couple examples: -```unison +``` unison ex0 : Nat -> Nat ex0 n = (a, _, (c,d)) = ("uno", "dos", (n, 7)) @@ -52,7 +52,7 @@ Notice that `ex0` is printed using the `cases` syntax (but `ex1` is not). The pr A destructuring bind is just syntax for a single branch pattern match. Notice that Unison detects this function as an alias of `ex1`: -```unison +``` unison ex2 : (a,b,(Nat,Nat)) -> Nat ex2 tup = match tup with (a, b, (c,d)) -> c + d @@ -76,7 +76,7 @@ ex2 tup = match tup with Destructuring binds can't be recursive: the left-hand side bound variables aren't available on the right hand side. For instance, this doesn't typecheck: -```unison +``` unison ex4 = (a,b) = (a Nat.+ b, 19) "Doesn't typecheck" @@ -104,7 +104,7 @@ ex4 = ``` Even though the parser accepts any pattern on the LHS of a bind, it looks pretty weird to see things like `12 = x`, so we avoid showing a destructuring bind when the LHS is a "literal" pattern (like `42` or "hi"). Again these examples wouldn't compile with coverage checking. -```unison +``` unison ex5 : 'Text ex5 _ = match 99 + 1 with 12 -> "Hi" @@ -155,7 +155,7 @@ Notice how it prints both an ordinary match. Also, for clarity, the pretty-printer shows a single-branch match if the match shadows free variables of the scrutinee, for example: -```unison +``` unison ex6 x = match x with (x, y) -> x Nat.+ y ``` diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md index 490fb3fa2c..2c327bc833 100644 --- a/unison-src/transcripts/diff-namespace.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -1,4 +1,4 @@ -```unison +``` unison b1.x = 23 b1.fslkdjflskdjflksjdf = 663 b2.x = 23 @@ -58,16 +58,16 @@ b2.abc = 23 ``` Things we want to test: -* Diffing identical namespaces -* Adds, removes, updates - * Adds with multiple names -* Moved and copied definitions - * Moves that have more that 1 initial or final name -* ... terms and types -* New patches, modified patches, deleted patches, moved patches -* With and without propagated updates + - Diffing identical namespaces + - Adds, removes, updates + - Adds with multiple names + - Moved and copied definitions + - Moves that have more that 1 initial or final name + - ... terms and types + - New patches, modified patches, deleted patches, moved patches + - With and without propagated updates -```unison +``` unison fromJust = 1 b = 2 bdependent = b @@ -122,7 +122,7 @@ Here's what we've done so far: The namespaces are identical. ``` -```unison +``` unison junk = "asldkfjasldkfj" ``` @@ -142,7 +142,7 @@ junk = "asldkfjasldkfj" Done. ``` -```unison +``` unison fromJust = 99 b = "oog" d = 4 @@ -283,7 +283,7 @@ unique type Y a b = Y a b 3. fromJust' ┘ 4. fromJust' (removed) ``` -```unison +``` unison bdependent = "banana" ``` @@ -316,7 +316,7 @@ bdependent = "banana" Currently, the auto-propagated name-conflicted definitions are not explicitly shown, only their also-conflicted dependency is shown. -```unison +``` unison a = 333 b = a + 1 ``` @@ -340,7 +340,7 @@ b = a + 1 Done. ``` -```unison +``` unison a = 444 ``` @@ -352,7 +352,7 @@ a = 444 a : ##Nat ``` -```unison +``` unison a = 555 ``` @@ -412,7 +412,7 @@ a = 555 ``` ## Should be able to diff a namespace hash from history. -```unison +``` unison x = 1 ``` @@ -439,7 +439,7 @@ x = 1 x : ##Nat ``` -```unison +``` unison y = 2 ``` @@ -483,49 +483,50 @@ y = 2 1. y : ##Nat ``` -## +## Updates: -- 1 to 1 New name conflicts: -- updates where RHS has multiple hashes (excluding when RHS=LHS) - 1. foo#jk19sm5bf8 : Nat - do we want to force a hashqualified? Arya thinks so - ↓ - 2. ┌ foo#0ja1qfpej6 : Nat - 3. └ foo#jk19sm5bf8 : Nat +1. foo\#jk19sm5bf8 : Nat - do we want to force a hashqualified? Arya thinks so + ↓ +2. ┌ foo\#0ja1qfpej6 : Nat +3. └ foo\#jk19sm5bf8 : Nat Resolved name conflicts: -- updates where LHS had multiple hashes and RHS has one - 4. ┌ bar#0ja1qfpej6 : Nat - 5. └ bar#jk19sm5bf8 : Nat - ↓ - 6. bar#jk19sm5bf8 : Nat +4. ┌ bar\#0ja1qfpej6 : Nat +5. └ bar\#jk19sm5bf8 : Nat + ↓ +6. bar\#jk19sm5bf8 : Nat ## Display issues to fixup -- [d] Do we want to surface new edit conflicts in patches? -- [t] two different auto-propagated changes creating a name conflict should show - up somewhere besides the auto-propagate count -- [t] Things look screwy when the type signature doesn't fit and has to get broken - up into multiple lines. Maybe just disallow that? -- [d] Delete blank line in between copies / renames entries if all entries are 1 to 1 - see todo in the code -- [x] incorrectly calculated bracket alignment on hashqualified "Name changes" (delete.output.md) -- [x] just handle deletion of isPropagated in propagate function, leave HandleInput alone (assuming this does the trick) -- [x] might want unqualified names to be qualified sometimes: -- [x] if a name is updated to a not-yet-named reference, it's shown as both an update and an add -- [x] similarly, if a conflicted name is resolved by deleting the last name to - a reference, I (arya) suspect it will show up as a Remove -- [d] Maybe group and/or add headings to the types, constructors, terms -- [x] add tagging of propagated updates to test propagated updates output -- [x] missing old names in deletion ppe (delete.output.md) (superseded by \#1143) -- [x] delete.term has some bonkers output -- [x] Make a decision about how we want to show constructors in the diff -- [x] 12.patch patch needs a space -- [x] This looks like garbage -- [x] Extra 2 blank lines at the end of the add section -- [x] Fix alignment issues with buildTable, convert to column3M (to be written) -- [x] adding an alias is showing up as an Add and a Copy; should just show as Copy -- [x] removing one of multiple aliases appears in removes + moves + copies section -- [x] some overlapping cases between Moves and Copies^ -- [x] Maybe don't list the type signature twice for aliases? + - \[d\] Do we want to surface new edit conflicts in patches? + - \[t\] two different auto-propagated changes creating a name conflict should show + up somewhere besides the auto-propagate count + - \[t\] Things look screwy when the type signature doesn't fit and has to get broken + up into multiple lines. Maybe just disallow that? + - \[d\] Delete blank line in between copies / renames entries if all entries are 1 to 1 + see todo in the code + - \[x\] incorrectly calculated bracket alignment on hashqualified "Name changes" (delete.output.md) + - \[x\] just handle deletion of isPropagated in propagate function, leave HandleInput alone (assuming this does the trick) + - \[x\] might want unqualified names to be qualified sometimes: + - \[x\] if a name is updated to a not-yet-named reference, it's shown as both an update and an add + - \[x\] similarly, if a conflicted name is resolved by deleting the last name to + a reference, I (arya) suspect it will show up as a Remove + - \[d\] Maybe group and/or add headings to the types, constructors, terms + - \[x\] add tagging of propagated updates to test propagated updates output + - \[x\] missing old names in deletion ppe (delete.output.md) (superseded by \#1143) + - \[x\] delete.term has some bonkers output + - \[x\] Make a decision about how we want to show constructors in the diff + - \[x\] 12.patch patch needs a space + - \[x\] This looks like garbage + - \[x\] Extra 2 blank lines at the end of the add section + - \[x\] Fix alignment issues with buildTable, convert to column3M (to be written) + - \[x\] adding an alias is showing up as an Add and a Copy; should just show as Copy + - \[x\] removing one of multiple aliases appears in removes + moves + copies section + - \[x\] some overlapping cases between Moves and Copies^ + - \[x\] Maybe don't list the type signature twice for aliases? + diff --git a/unison-src/transcripts/doc-formatting.output.md b/unison-src/transcripts/doc-formatting.output.md index b472f9177a..a99d2ca4ba 100644 --- a/unison-src/transcripts/doc-formatting.output.md +++ b/unison-src/transcripts/doc-formatting.output.md @@ -2,7 +2,7 @@ This transcript explains a few minor details about doc parsing and pretty-printi Docs can be used as inline code comments. -```unison +``` unison foo : Nat -> Nat foo n = _ = [: do the thing :] @@ -34,7 +34,7 @@ scratch/main> view foo ``` Note that `@` and `:]` must be escaped within docs. -```unison +``` unison escaping = [: Docs look [: like \@this \:] :] ``` @@ -60,7 +60,7 @@ scratch/main> view escaping ``` (Alas you can't have `\@` or `\:]` in your doc, as there's currently no way to 'unescape' them.) -```unison +``` unison -- Note that -- comments are preserved within doc literals. commented = [: example: @@ -98,7 +98,7 @@ scratch/main> view commented Handling of indenting in docs between the parser and pretty-printer is a bit fiddly. -```unison +``` unison -- The leading and trailing spaces are stripped from the stored Doc by the -- lexer, and one leading and trailing space is inserted again on view/edit -- by the pretty-printer. @@ -125,7 +125,7 @@ scratch/main> view doc1 doc1 = [: hi :] ``` -```unison +``` unison -- Lines (apart from the first line, i.e. the bit between the [: and the -- first newline) are unindented until at least one of -- them hits the left margin (by a post-processing step in the parser). @@ -161,7 +161,7 @@ scratch/main> view doc2 and the rest. :] ``` -```unison +``` unison doc3 = [: When Unison identifies a paragraph, it removes any newlines from it before storing it, and then reflows the paragraph text to fit the display window on display/view/edit. For these purposes, a paragraph is any sequence of non-empty lines that have zero indent (after the unindenting mentioned above.) @@ -215,7 +215,7 @@ scratch/main> view doc3 :] ``` -```unison +``` unison doc4 = [: Here's another example of some paragraphs. All these lines have zero indent. @@ -248,7 +248,7 @@ scratch/main> view doc4 - Apart from this one. :] ``` -```unison +``` unison -- The special treatment of the first line does mean that the following -- is pretty-printed not so prettily. To fix that we'd need to get the -- lexer to help out with interpreting doc literal indentation (because @@ -281,7 +281,7 @@ scratch/main> view doc5 and the rest. :] ``` -```unison +``` unison -- You can do the following to avoid that problem. doc6 = [: - foo @@ -316,7 +316,7 @@ scratch/main> view doc6 ``` ### More testing -```unison +``` unison -- Check empty doc works. empty = [::] @@ -344,7 +344,7 @@ scratch/main> view empty empty = [: :] ``` -```unison +``` unison test1 = [: The internal logic starts to get hairy when you use the \@ features, for example referencing a name like @List.take. Internally, the text between each such usage is its own blob (blob ends here --> @List.take), so paragraph reflow has to be aware of multiple blobs to do paragraph reflow (or, more accurately, to do the normalization step where newlines with a paragraph are removed.) @@ -460,7 +460,7 @@ scratch/main> view test1 :] ``` -```unison +``` unison -- Regression test for #1363 - preservation of spaces after @ directives in first line when unindenting reg1363 = [: `@List.take foo` bar baz :] @@ -486,7 +486,7 @@ scratch/main> view reg1363 reg1363 = [: `@List.take foo` bar baz :] ``` -```unison +``` unison -- Demonstrate doc display when whitespace follows a @[source] or @[evaluate] -- whose output spans multiple lines. @@ -510,6 +510,7 @@ test2 = [: ``` View is fine. + ```ucm scratch/main> view test2 @@ -521,6 +522,7 @@ scratch/main> view test2 ``` But note it's not obvious how display should best be handling this. At the moment it just does the simplest thing: + ```ucm scratch/main> display test2 diff --git a/unison-src/transcripts/doc-type-link-keywords.output.md b/unison-src/transcripts/doc-type-link-keywords.output.md index ed7b0b7b74..3229bed192 100644 --- a/unison-src/transcripts/doc-type-link-keywords.output.md +++ b/unison-src/transcripts/doc-type-link-keywords.output.md @@ -6,7 +6,7 @@ not the ability `Patterns`; the lexer should see this as a single identifier. See https://github.com/unisonweb/unison/issues/2642 for an example. -```unison +``` unison abilityPatterns : () abilityPatterns = () diff --git a/unison-src/transcripts/doc1.output.md b/unison-src/transcripts/doc1.output.md index 563932e2bc..bd5b5b2557 100644 --- a/unison-src/transcripts/doc1.output.md +++ b/unison-src/transcripts/doc1.output.md @@ -16,7 +16,7 @@ scratch/main> view lib.builtins.Doc ``` You can create these `Doc` values with ordinary code, or you can use the special syntax. A value of structural type `Doc` can be created via syntax like: -```unison +``` unison doc1 = [: This is some documentation. It can span multiple lines. @@ -43,17 +43,17 @@ Syntax: `[:` starts a documentation block; `:]` finishes it. Within the block: -* Links to definitions are done with `@List`. `\@` (and `\:]`) if you want to escape. -* `@[signature] List.take` expands to the type signature of `List.take` -* `@[source] List.map` expands to the full source of `List.map` -* `@[include] someOtherDoc`, inserts a value `someOtherDoc : Doc` here. -* `@[evaluate] someDefinition` expands to the result of evaluating `someDefinition`, which must be a pre-existing definition in the codebase (can't be an arbitrary expression). + - Links to definitions are done with `@List`. `\@` (and `\:]`) if you want to escape. + - `@[signature] List.take` expands to the type signature of `List.take` + - `@[source] List.map` expands to the full source of `List.map` + - `@[include] someOtherDoc`, inserts a value `someOtherDoc : Doc` here. + - `@[evaluate] someDefinition` expands to the result of evaluating `someDefinition`, which must be a pre-existing definition in the codebase (can't be an arbitrary expression). ### An example We are going to document `List.take` using some verbiage and a few examples. First we have to add the examples to the codebase: -```unison +``` unison List.take.ex1 = take 0 [1,2,3,4,5] List.take.ex2 = take 2 [1,2,3,4,5] ``` @@ -83,7 +83,7 @@ scratch/main> add ``` And now let's write our docs and reference these examples: -```unison +``` unison List.take.doc = [: `@List.take n xs` returns the first `n` elements of `xs`. (No need to add line breaks manually. The display command will do wrapping of text for you. Indent any lines where you don't want it to do this.) diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md index 7cb162400f..0d09b5618c 100644 --- a/unison-src/transcripts/doc2.output.md +++ b/unison-src/transcripts/doc2.output.md @@ -1,6 +1,6 @@ # Test parsing and round-trip of doc2 syntax elements -```unison +``` unison otherDoc : a -> Doc2 otherDoc _ = {{ yo }} @@ -113,7 +113,7 @@ Format it to check that everything pretty-prints in a valid way. scratch/main> debug.format ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u otherDoc : a -> Doc2 otherDoc _ = {{ yo }} diff --git a/unison-src/transcripts/doc2markdown.output.md b/unison-src/transcripts/doc2markdown.output.md index 5475c1cbf5..e670bff8cd 100644 --- a/unison-src/transcripts/doc2markdown.output.md +++ b/unison-src/transcripts/doc2markdown.output.md @@ -1,4 +1,4 @@ -```unison +``` unison otherDoc : a -> Doc2 otherDoc _ = {{ yo }} @@ -159,7 +159,7 @@ scratch/main> debug.doc-to-markdown fulldoc ``` You can add docs to a term or type with a top-level doc literal above the binding: -```unison +``` unison {{ This is a term doc }} myTerm = 10 diff --git a/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md b/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md index a256f4e45e..5bbf2fb0b2 100644 --- a/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md +++ b/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md @@ -1,7 +1,7 @@ If `foo#old` exists in old, and `foo#new` exists in new, you might think `upgrade old new` would rewrite references to -`#old` with references to `#new`. And it will... !!unless!! `#old` still exists in new. +`#old` with references to `#new`. And it will... \!\!unless\!\! `#old` still exists in new. -```unison +``` unison lib.old.foo = 18 lib.new.other = 18 lib.new.foo = 19 diff --git a/unison-src/transcripts/duplicate-names.output.md b/unison-src/transcripts/duplicate-names.output.md index 9a15abbb7b..a9d9f2ad0e 100644 --- a/unison-src/transcripts/duplicate-names.output.md +++ b/unison-src/transcripts/duplicate-names.output.md @@ -2,7 +2,7 @@ Term and ability constructor collisions should cause a parse error. -```unison +``` unison structural ability Stream where send : a -> () @@ -26,7 +26,7 @@ Stream.send _ = () ``` Term and type constructor collisions should cause a parse error. -```unison +``` unison structural type X = x X.x : a -> () @@ -49,7 +49,7 @@ X.x _ = () ``` Ability and type constructor collisions should cause a parse error. -```unison +``` unison structural type X = x structural ability X where x : () @@ -69,7 +69,7 @@ structural ability X where ``` Field accessors and terms with the same name should cause a parse error. -```unison +``` unison structural type X = {x : ()} X.x.modify = () X.x.set = () @@ -103,7 +103,7 @@ X.x = () ``` Types and terms with the same name are allowed. -```unison +``` unison structural type X = Z X = () diff --git a/unison-src/transcripts/duplicate-term-detection.output.md b/unison-src/transcripts/duplicate-term-detection.output.md index 35f4de11fc..3751e75f8f 100644 --- a/unison-src/transcripts/duplicate-term-detection.output.md +++ b/unison-src/transcripts/duplicate-term-detection.output.md @@ -2,7 +2,7 @@ Trivial duplicate terms should be detected: -```unison +``` unison x = 1 x = 2 ``` @@ -21,7 +21,7 @@ x = 2 ``` Equivalent duplicate terms should be detected: -```unison +``` unison x = 1 x = 1 ``` @@ -40,7 +40,7 @@ x = 1 ``` Duplicates from record accessors/setters should be detected -```unison +``` unison structural type Record = {x: Nat, y: Nat} Record.x = 1 Record.x.set = 2 @@ -74,7 +74,7 @@ Record.x.modify = 2 ``` Duplicate terms and constructors should be detected: -```unison +``` unison structural type SumType = X SumType.X = 1 diff --git a/unison-src/transcripts/ed25519.output.md b/unison-src/transcripts/ed25519.output.md index e204f75302..2679028d45 100644 --- a/unison-src/transcripts/ed25519.output.md +++ b/unison-src/transcripts/ed25519.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison up = 0xs0123456789abcdef down = 0xsfedcba9876543210 diff --git a/unison-src/transcripts/edit-command.output.md b/unison-src/transcripts/edit-command.output.md index 644db7ce70..8470de9484 100644 --- a/unison-src/transcripts/edit-command.output.md +++ b/unison-src/transcripts/edit-command.output.md @@ -4,7 +4,7 @@ scratch/main> builtins.merge Done. ``` -```unison +``` unison --- title: /private/tmp/scratch.u --- @@ -16,7 +16,6 @@ mytest = [Ok "ok"] ``` - ```ucm Loading changes detected in /private/tmp/scratch.u. @@ -60,7 +59,7 @@ scratch/main> edit mytest definitions currently in this namespace. ``` -```unison:added-by-ucm /private/tmp/scratch.u +``` unison:added-by-ucm /private/tmp/scratch.u bar : Nat bar = 456 @@ -68,7 +67,7 @@ foo : Nat foo = 123 ``` -```unison:added-by-ucm /private/tmp/scratch.u +``` unison:added-by-ucm /private/tmp/scratch.u test> mytest = [Ok "ok"] ``` diff --git a/unison-src/transcripts/edit-namespace.output.md b/unison-src/transcripts/edit-namespace.output.md index ab3bbbb54a..67e24e064f 100644 --- a/unison-src/transcripts/edit-namespace.output.md +++ b/unison-src/transcripts/edit-namespace.output.md @@ -1,4 +1,4 @@ -```unison +``` unison {{ ping doc }} nested.cycle.ping n = n Nat.+ pong n @@ -79,7 +79,7 @@ project/main> edit.namespace definitions currently in this namespace. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u type Foo = { bar : Nat, baz : Nat } nested.cycle.ping : Nat -> Nat @@ -121,7 +121,7 @@ project/main> edit.namespace nested simple definitions currently in this namespace. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u nested.cycle.ping : Nat -> Nat nested.cycle.ping n = use Nat + diff --git a/unison-src/transcripts/empty-namespaces.output.md b/unison-src/transcripts/empty-namespaces.output.md index 8eee1f1a13..4bea6f5b50 100644 --- a/unison-src/transcripts/empty-namespaces.output.md +++ b/unison-src/transcripts/empty-namespaces.output.md @@ -1,10 +1,11 @@ # Empty namespace behaviours -```unison +``` unison mynamespace.x = 1 ``` The deleted namespace shouldn't appear in `ls` output. + ```ucm scratch/main> ls @@ -57,7 +58,7 @@ scratch/main> history mynamespace ``` Add and then delete a term to add some history to a deleted namespace. -```unison +``` unison deleted.x = 1 stuff.thing = 2 ``` @@ -96,7 +97,7 @@ scratch/main> history deleted ``` ## move.namespace -```unison +``` unison moveoverme.x = 1 moveme.y = 2 ``` diff --git a/unison-src/transcripts/emptyCodebase.output.md b/unison-src/transcripts/emptyCodebase.output.md index bbb762a284..4a8b1cff18 100644 --- a/unison-src/transcripts/emptyCodebase.output.md +++ b/unison-src/transcripts/emptyCodebase.output.md @@ -2,9 +2,9 @@ The Unison codebase, when first initialized, contains no definitions in its namespace. -Not even `Nat` or `+`! +Not even `Nat` or `+`\! -BEHOLD!!! +BEHOLD\!\!\! ```ucm scratch/main> ls @@ -37,4 +37,5 @@ scratch/main> ls lib 2. builtinsio/ (643 terms, 92 types) ``` -More typically, you'd start out by pulling `base. +More typically, you'd start out by pulling `base`. + diff --git a/unison-src/transcripts/error-messages.output.md b/unison-src/transcripts/error-messages.output.md index 82ae8a88b9..694f20f4ce 100644 --- a/unison-src/transcripts/error-messages.output.md +++ b/unison-src/transcripts/error-messages.output.md @@ -1,4 +1,3 @@ - This file contains programs with parse errors and type errors, for visual inspection of error message quality and to check for regressions or changes to error reporting. ## Parse errors @@ -7,7 +6,7 @@ Some basic errors of literals. ### Floating point literals -```unison +``` unison x = 1. -- missing some digits after the decimal ``` @@ -23,7 +22,7 @@ x = 1. -- missing some digits after the decimal or `1.1e37`. ``` -```unison +``` unison x = 1e -- missing an exponent ``` @@ -39,7 +38,7 @@ x = 1e -- missing an exponent `1e37`. ``` -```unison +``` unison x = 1e- -- missing an exponent ``` @@ -55,7 +54,7 @@ x = 1e- -- missing an exponent `1e-37`. ``` -```unison +``` unison x = 1E+ -- missing an exponent ``` @@ -73,7 +72,7 @@ x = 1E+ -- missing an exponent ``` ### Hex, octal, and bytes literals -```unison +``` unison x = 0xoogabooga -- invalid hex chars ``` @@ -89,7 +88,7 @@ x = 0xoogabooga -- invalid hex chars 0123456789abcdefABCDEF) after the 0x. ``` -```unison +``` unison x = 0o987654321 -- 9 and 8 are not valid octal char ``` @@ -105,7 +104,7 @@ x = 0o987654321 -- 9 and 8 are not valid octal char the 0o. ``` -```unison +``` unison x = 0xsf -- odd number of hex chars in a bytes literal ``` @@ -121,7 +120,7 @@ x = 0xsf -- odd number of hex chars in a bytes literal of 0123456789abcdefABCDEF) after the 0xs. ``` -```unison +``` unison x = 0xsnotvalidhexchars -- invalid hex chars in a bytes literal ``` @@ -139,7 +138,7 @@ x = 0xsnotvalidhexchars -- invalid hex chars in a bytes literal ``` ### Layout errors -```unison +``` unison foo = else -- not matching if ``` @@ -153,7 +152,7 @@ foo = else -- not matching if ``` -```unison +``` unison foo = then -- unclosed ``` @@ -167,7 +166,7 @@ foo = then -- unclosed ``` -```unison +``` unison foo = with -- unclosed ``` @@ -183,7 +182,7 @@ foo = with -- unclosed ``` ### Matching -```unison +``` unison -- No cases foo = match 1 with ``` @@ -201,7 +200,7 @@ foo = match 1 with ``` -```unison +``` unison foo = match 1 with 2 -- no right-hand-side ``` @@ -212,7 +211,8 @@ foo = match 1 with I got confused here: - 3 | + 2 | 2 -- no right-hand-side + I was surprised to find an end of section here. I was expecting one of these instead: @@ -222,7 +222,7 @@ foo = match 1 with * pattern guard ``` -```unison +``` unison -- Mismatched arities foo = cases 1, 2 -> () @@ -243,7 +243,7 @@ foo = cases ``` -```unison +``` unison -- Missing a '->' x = match Some a with None -> @@ -258,7 +258,8 @@ x = match Some a with I got confused here: - 7 | + 6 | 2 + I was surprised to find an end of section here. I was expecting one of these instead: @@ -271,7 +272,7 @@ x = match Some a with * true ``` -```unison +``` unison -- Missing patterns x = match Some a with None -> 1 @@ -294,7 +295,7 @@ x = match Some a with * newline or semicolon ``` -```unison +``` unison -- Guards following an unguarded case x = match Some a with None -> 1 @@ -318,7 +319,7 @@ x = match Some a with ``` ### Watches -```unison +``` unison -- Empty watch > ``` @@ -335,7 +336,7 @@ x = match Some a with ``` ### Keywords -```unison +``` unison use.keyword.in.namespace = 1 ``` @@ -351,7 +352,7 @@ use.keyword.in.namespace = 1 or wrapping it in backticks (like `namespace` ). ``` -```unison +``` unison -- reserved operator a ! b = 1 ``` diff --git a/unison-src/transcripts/errors/missing-result-typed.output.md b/unison-src/transcripts/errors/missing-result-typed.output.md index 260b806172..2357371eca 100644 --- a/unison-src/transcripts/errors/missing-result-typed.output.md +++ b/unison-src/transcripts/errors/missing-result-typed.output.md @@ -1,11 +1,10 @@ - ### Transcript parser hidden errors When an error is encountered in a `unison:hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```unison +``` unison a : Nat a = b = 24 diff --git a/unison-src/transcripts/errors/missing-result.output.md b/unison-src/transcripts/errors/missing-result.output.md index c099e70080..608f5c589e 100644 --- a/unison-src/transcripts/errors/missing-result.output.md +++ b/unison-src/transcripts/errors/missing-result.output.md @@ -1,11 +1,10 @@ - ### Transcript parser hidden errors When an error is encountered in a `unison:hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```unison +``` unison x = y = 24 ``` diff --git a/unison-src/transcripts/errors/ucm-hide-all-error.output.md b/unison-src/transcripts/errors/ucm-hide-all-error.output.md index 9b8c0b43ee..de409c16f8 100644 --- a/unison-src/transcripts/errors/ucm-hide-all-error.output.md +++ b/unison-src/transcripts/errors/ucm-hide-all-error.output.md @@ -1,17 +1,17 @@ - ### Transcript parser hidden errors -Dangerous scary words! +Dangerous scary words\! When an expected error is not encountered in a `ucm:hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```ucm +``` ucm scratch/main> history ``` + 🛑 The transcript was expecting an error in the stanza above, but did not encounter one. diff --git a/unison-src/transcripts/errors/ucm-hide-all.output.md b/unison-src/transcripts/errors/ucm-hide-all.output.md index 56cf454d4c..34b9b974a4 100644 --- a/unison-src/transcripts/errors/ucm-hide-all.output.md +++ b/unison-src/transcripts/errors/ucm-hide-all.output.md @@ -1,17 +1,17 @@ - ### Transcript parser hidden errors -Dangerous scary words! +Dangerous scary words\! When an error is encountered in a `ucm:hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```ucm +``` ucm scratch/main> move.namespace foo bar ``` + 🛑 The transcript failed due to an error in the stanza above. The error is: diff --git a/unison-src/transcripts/errors/ucm-hide-error.output.md b/unison-src/transcripts/errors/ucm-hide-error.output.md index 3e80bd4a7b..893baf53e5 100644 --- a/unison-src/transcripts/errors/ucm-hide-error.output.md +++ b/unison-src/transcripts/errors/ucm-hide-error.output.md @@ -1,17 +1,17 @@ - ### Transcript parser hidden errors -Dangerous scary words! +Dangerous scary words\! When an expected error is not encountered in a `ucm:hide` block then the transcript parser should print the stanza and surface a helpful message. -```ucm +``` ucm scratch/main> history ``` + 🛑 The transcript was expecting an error in the stanza above, but did not encounter one. diff --git a/unison-src/transcripts/errors/ucm-hide.output.md b/unison-src/transcripts/errors/ucm-hide.output.md index 2c88db7f5a..2058708696 100644 --- a/unison-src/transcripts/errors/ucm-hide.output.md +++ b/unison-src/transcripts/errors/ucm-hide.output.md @@ -1,17 +1,17 @@ - ### Transcript parser hidden errors -Dangerous scary words! +Dangerous scary words\! When an error is encountered in a `ucm:hide` block then the transcript parser should print the stanza and surface a helpful message. -```ucm +``` ucm scratch/main> move.namespace foo bar ``` + 🛑 The transcript failed due to an error in the stanza above. The error is: diff --git a/unison-src/transcripts/errors/unison-hide-all-error.output.md b/unison-src/transcripts/errors/unison-hide-all-error.output.md index 3c3e6f3e5f..fbb8a35d63 100644 --- a/unison-src/transcripts/errors/unison-hide-all-error.output.md +++ b/unison-src/transcripts/errors/unison-hide-all-error.output.md @@ -1,11 +1,10 @@ - ### Transcript parser hidden errors When an expected error is not encountered in a `unison:hide:all:error` block then the transcript parser should print the stanza and surface a helpful message. -```unison +``` unison myVal = 3 ``` diff --git a/unison-src/transcripts/errors/unison-hide-all.output.md b/unison-src/transcripts/errors/unison-hide-all.output.md index 9b313c82a6..a093b5f5ec 100644 --- a/unison-src/transcripts/errors/unison-hide-all.output.md +++ b/unison-src/transcripts/errors/unison-hide-all.output.md @@ -1,11 +1,10 @@ - ### Transcript parser hidden errors When an error is encountered in a `unison:hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```unison +``` unison g 3 ``` diff --git a/unison-src/transcripts/errors/unison-hide-error.output.md b/unison-src/transcripts/errors/unison-hide-error.output.md index 30ab85dc58..bde72516fe 100644 --- a/unison-src/transcripts/errors/unison-hide-error.output.md +++ b/unison-src/transcripts/errors/unison-hide-error.output.md @@ -1,11 +1,10 @@ - ### Transcript parser hidden errors When an expected error is not encountered in a `unison:hide:error` block then the transcript parser should print the stanza and surface a helpful message. -```unison +``` unison myVal = 3 ``` diff --git a/unison-src/transcripts/errors/unison-hide.output.md b/unison-src/transcripts/errors/unison-hide.output.md index bf410ca30e..1a8a9c78a9 100644 --- a/unison-src/transcripts/errors/unison-hide.output.md +++ b/unison-src/transcripts/errors/unison-hide.output.md @@ -1,11 +1,10 @@ - ### Transcript parser hidden errors When an error is encountered in a `unison:hide` block then the transcript parser should print the stanza and surface a helpful message. -```unison +``` unison g 3 ``` diff --git a/unison-src/transcripts/escape-sequences.output.md b/unison-src/transcripts/escape-sequences.output.md index 46cb0e0459..0834375f17 100644 --- a/unison-src/transcripts/escape-sequences.output.md +++ b/unison-src/transcripts/escape-sequences.output.md @@ -1,4 +1,4 @@ -```unison +``` unison > "Rúnar" > "῎Ανδρα μοι ἔννεπε, Μοῦσα, πολύτροπον" > "古池や蛙飛びこむ水の音" diff --git a/unison-src/transcripts/find-by-type.output.md b/unison-src/transcripts/find-by-type.output.md index 4fcbf2d85a..476f6ff807 100644 --- a/unison-src/transcripts/find-by-type.output.md +++ b/unison-src/transcripts/find-by-type.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type A = A Text foo : A diff --git a/unison-src/transcripts/find-command.output.md b/unison-src/transcripts/find-command.output.md index f75da189b8..e4c4f6fe73 100644 --- a/unison-src/transcripts/find-command.output.md +++ b/unison-src/transcripts/find-command.output.md @@ -1,4 +1,4 @@ -```unison +``` unison foo = 1 lib.foo = 2 lib.bar = 3 diff --git a/unison-src/transcripts/fix-1381-excess-propagate.output.md b/unison-src/transcripts/fix-1381-excess-propagate.output.md index d35a892620..3732899702 100644 --- a/unison-src/transcripts/fix-1381-excess-propagate.output.md +++ b/unison-src/transcripts/fix-1381-excess-propagate.output.md @@ -1,7 +1,8 @@ We were seeing an issue where (it seemed) that every namespace that was visited during a propagate would get a new history node, even when it didn't contain any dependents. Example: -```unison + +``` unison a = "a term" X.foo = "a namespace" ``` @@ -16,7 +17,8 @@ scratch/main> add ``` Here is an update which should not affect `X`: -```unison + +``` unison a = "an update" ``` @@ -30,6 +32,7 @@ scratch/main> update ``` As of the time of this writing, the history for `X` should be a single node, `#4eeuo5bsfr`; + ```ucm scratch/main> history X @@ -42,6 +45,7 @@ scratch/main> history X ``` however, as of release/M1i, we saw an extraneous node appear. If your `ucm` is fixed, you won't see it below: + ```ucm scratch/main> history #7nl6ppokhg diff --git a/unison-src/transcripts/fix-2258-if-as-list-element.output.md b/unison-src/transcripts/fix-2258-if-as-list-element.output.md index 50c28c0046..0e136a6bee 100644 --- a/unison-src/transcripts/fix-2258-if-as-list-element.output.md +++ b/unison-src/transcripts/fix-2258-if-as-list-element.output.md @@ -1,6 +1,6 @@ Tests that `if` statements can appear as list and tuple elements. -```unison +``` unison > [ if true then 1 else 0 ] > [ if true then 1 else 0, 1] diff --git a/unison-src/transcripts/fix-big-list-crash.output.md b/unison-src/transcripts/fix-big-list-crash.output.md index 1d14e77d7b..5661b03392 100644 --- a/unison-src/transcripts/fix-big-list-crash.output.md +++ b/unison-src/transcripts/fix-big-list-crash.output.md @@ -2,7 +2,7 @@ Big lists have been observed to crash, while in the garbage collection step. -```unison +``` unison unique type Direction = U | D | L | R x = [(R,1005),(U,563),(R,417),(U,509),(L,237),(U,555),(R,397),(U,414),(L,490),(U,336),(L,697),(D,682),(L,180),(U,951),(L,189),(D,547),(R,697),(U,583),(L,172),(D,859),(L,370),(D,114),(L,519),(U,829),(R,389),(U,608),(R,66),(D,634),(L,320),(D,49),(L,931),(U,137),(L,349),(D,689),(L,351),(D,829),(R,819),(D,138),(L,118),(D,849),(R,230),(U,858),(L,509),(D,311),(R,815),(U,217),(R,359),(U,840),(R,77),(U,230),(R,361),(U,322),(R,300),(D,646),(R,348),(U,815),(R,793),(D,752),(R,967),(U,128),(R,948),(D,499),(R,359),(U,572),(L,566),(U,815),(R,630),(D,290),(L,829),(D,736),(R,358),(U,778),(R,891),(U,941),(R,544),(U,889),(L,920),(U,913),(L,447),(D,604),(R,538),(U,818),(L,215),(D,437),(R,447),(U,576),(R,452),(D,794),(R,864),(U,269),(L,325),(D,35),(L,268),(D,639),(L,101),(U,777),(L,776),(U,958),(R,105),(U,517),(R,667),(D,423),(R,603),(U,469),(L,125),(D,919),(R,879),(U,994),(R,665),(D,377),(R,456),(D,570),(L,685),(U,291),(R,261),(U,846),(R,840),(U,418),(L,974),(D,270),(L,312),(D,426),(R,621),(D,334),(L,855),(D,378),(R,694),(U,845),(R,481),(U,895),(L,362),(D,840),(L,712),(U,57),(R,276),(D,643),(R,566),(U,348),(R,361),(D,144),(L,287),(D,864),(L,556),(U,610),(L,927),(U,322),(R,271),(D,90),(L,741),(U,446),(R,181),(D,527),(R,56),(U,805),(L,907),(D,406),(L,286),(U,873),(L,79),(D,280),(L,153),(D,377),(R,253),(D,61),(R,475),(D,804),(R,788),(U,393),(L,660),(U,314),(R,489),(D,491),(L,234),(D,712),(L,253),(U,651),(L,777),(D,726),(R,146),(U,47),(R,630),(U,517),(R,226),(U,624),(L,834),(D,153),(L,513),(U,799),(R,287),(D,868),(R,982),(U,390),(L,296),(D,373),(R,9),(U,994),(R,105),(D,673),(L,657),(D,868),(R,738),(D,277),(R,374),(U,828),(R,860),(U,247),(R,484),(U,986),(L,723),(D,847),(L,578),(U,487),(L,51),(D,865),(L,328),(D,199),(R,812),(D,726),(R,355),(D,463),(R,761),(U,69),(R,508),(D,753),(L,81),(D,50),(L,345),(D,66),(L,764),(D,466),(L,975),(U,619),(R,59),(D,788),(L,737),(D,360),(R,14),(D,253),(L,512),(D,417),(R,828),(D,188),(L,394),(U,212),(R,658),(U,369),(R,920),(U,927),(L,339),(U,552),(R,856),(D,458),(R,407),(U,41),(L,930),(D,460),(R,809),(U,467),(L,410),(D,800),(L,135),(D,596),(R,678),(D,4),(L,771),(D,637),(L,876),(U,192),(L,406),(D,136),(R,666),(U,730),(R,711),(D,291),(L,586),(U,845),(R,606),(U,2),(L,228),(D,759),(R,244),(U,946),(R,948),(U,160),(R,397),(U,134),(R,188),(U,850),(R,623),(D,315),(L,219),(D,450),(R,489),(U,374),(R,299),(D,474),(L,767),(D,679),(L,160),(D,403),(L,708)] diff --git a/unison-src/transcripts/fix-ls.output.md b/unison-src/transcripts/fix-ls.output.md index 56277c6925..abf280b23d 100644 --- a/unison-src/transcripts/fix-ls.output.md +++ b/unison-src/transcripts/fix-ls.output.md @@ -4,7 +4,7 @@ test-ls/main> builtins.merge Done. ``` -```unison +``` unison foo.bar.add x y = x Int.+ y foo.bar.subtract x y = x Int.- y diff --git a/unison-src/transcripts/fix1063.output.md b/unison-src/transcripts/fix1063.output.md index d9d2e8380f..ca9f0ad573 100644 --- a/unison-src/transcripts/fix1063.output.md +++ b/unison-src/transcripts/fix1063.output.md @@ -1,6 +1,6 @@ Tests that functions named `.` are rendered correctly. -```unison +``` unison (`.`) f g x = f (g x) use Boolean not diff --git a/unison-src/transcripts/fix1334.output.md b/unison-src/transcripts/fix1334.output.md index 4e08c294b9..b9b6f6a89c 100644 --- a/unison-src/transcripts/fix1334.output.md +++ b/unison-src/transcripts/fix1334.output.md @@ -1,4 +1,4 @@ -Previously, the `alias.term` and `alias.type` would fail if the source argument was hash-only, and there was no way to create an alias for a definition that didn't already have a name. Also, the `replace.term` and `replace.type` _only_ worked on hashes, and they had to be _full_ hashes. +Previously, the `alias.term` and `alias.type` would fail if the source argument was hash-only, and there was no way to create an alias for a definition that didn't already have a name. Also, the `replace.term` and `replace.type` *only* worked on hashes, and they had to be *full* hashes. With this PR, the source of an alias can be a short hash (even of a definition that doesn't currently have a name in the namespace) along with a name or hash-qualified name from the current namespace as usual. diff --git a/unison-src/transcripts/fix1390.output.md b/unison-src/transcripts/fix1390.output.md index 164f3a8a61..4d50e86afc 100644 --- a/unison-src/transcripts/fix1390.output.md +++ b/unison-src/transcripts/fix1390.output.md @@ -1,11 +1,10 @@ - ```ucm scratch/main> builtins.merge Done. ``` -```unison +``` unison -- List.map : (a -> b) -> [a] -> [b] List.map f = go acc = cases @@ -44,7 +43,7 @@ scratch/main> view List.map go [] ``` -```unison +``` unison List.map2 : (g -> g2) -> [g] -> [g2] List.map2 f = unused = "just to give this a different hash" diff --git a/unison-src/transcripts/fix1532.output.md b/unison-src/transcripts/fix1532.output.md index 6b856b35e9..41ea7b2b94 100644 --- a/unison-src/transcripts/fix1532.output.md +++ b/unison-src/transcripts/fix1532.output.md @@ -6,7 +6,7 @@ scratch/main> builtins.merge ``` First, lets create two namespaces. `foo` and `bar`, and add some definitions. -```unison +``` unison foo.x = 42 foo.y = 100 bar.z = x + y diff --git a/unison-src/transcripts/fix1578.output.md b/unison-src/transcripts/fix1578.output.md index 1b57bcabd6..0645dae519 100644 --- a/unison-src/transcripts/fix1578.output.md +++ b/unison-src/transcripts/fix1578.output.md @@ -4,7 +4,7 @@ This transcript shows how suffix-based name resolution works when definitions in As setup, we'll add a data type `Day` and a definition `foo.bar : Nat`. -```unison +``` unison unique type Day = Sun | Mon | Tue | Wed | Thu | Fri | Sat foo.bar : Nat @@ -13,15 +13,15 @@ foo.bar = 23 Suffix-based name resolution prefers to use names locally defined in the current file, then checks for matches in the codebase. Here are the precise rules, which will be explained below with examples: -* If a symbol, `s`, is a suffix of exactly one definition `d` in the file, then `s` refers to `d`. -* Otherwise, if `s` is a suffix of exactly one definition `d` in the codebase, then `s` refers to `d`. -* Otherwise, if `s` is a suffix of multiple definitions in the file or the codebase, then (at least for terms) type-directed name resolution will be attempted to figure out which definition `s` refers to. + - If a symbol, `s`, is a suffix of exactly one definition `d` in the file, then `s` refers to `d`. + - Otherwise, if `s` is a suffix of exactly one definition `d` in the codebase, then `s` refers to `d`. + - Otherwise, if `s` is a suffix of multiple definitions in the file or the codebase, then (at least for terms) type-directed name resolution will be attempted to figure out which definition `s` refers to. ## Example 1: local file term definitions shadow codebase term definitions This should typecheck, using the file's `bar : Text` rather than the codebase `foo.bar : Nat`: -```unison +``` unison use Text ++ bar : Text @@ -32,9 +32,9 @@ baz = bar ++ ", world!" ## Example 2: any locally unique term suffix shadows codebase term definitions -This should also typecheck, using the file's `oog.bar`. This shows you can refer to a definition in the file by any suffix that is unique to definitions in the file (even if that suffix may match other definitions in the _codebase_). See example 4 below for overriding this behavior. +This should also typecheck, using the file's `oog.bar`. This shows you can refer to a definition in the file by any suffix that is unique to definitions in the file (even if that suffix may match other definitions in the *codebase*). See example 4 below for overriding this behavior. -```unison +``` unison use Text ++ oog.bar = "hello" @@ -44,7 +44,7 @@ baz = bar ++ ", world!" This subtle test establishes that we aren't using type-directed name resolution (TDNR) for the local term references in the file. If this were using TDNR, it would fail with an ambiguity as there's nothing that pins down the expected type of `bar` here: -```unison +``` unison use Text ++ oog.bar = "hello" @@ -54,7 +54,7 @@ baz = (bar, 42) This subtle test establishes that locally introduced variables (within a function, say) correctly shadow definitions introduced at the file top level: -```unison +``` unison use Text ++ oog.bar = "hello" @@ -67,7 +67,7 @@ baz bar = (bar, 42) -- here, `bar` refers to the parameter This should also typecheck, using the local `Sun`, and not `Day.Sun` which exists in the codebase, and the local `Day`, not the codebase `Day`. -```unison +``` unison structural type Zoot = Zonk | Sun structural type Day = Day Int @@ -87,7 +87,7 @@ day1 = Day +1 Even though local definitions are preferred, you can refer to definitions in the codebase via any unique suffix that doesn't also exist in the file. -```unison +``` unison structural type Zoot = Zonk | Sun use Zoot Zonk diff --git a/unison-src/transcripts/fix1696.output.md b/unison-src/transcripts/fix1696.output.md index c0a9ccce85..47c1159a37 100644 --- a/unison-src/transcripts/fix1696.output.md +++ b/unison-src/transcripts/fix1696.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison structural ability Ask where ask : Nat ability Zoot where diff --git a/unison-src/transcripts/fix1709.output.md b/unison-src/transcripts/fix1709.output.md index 8523d4e27b..3aacb9753e 100644 --- a/unison-src/transcripts/fix1709.output.md +++ b/unison-src/transcripts/fix1709.output.md @@ -1,4 +1,4 @@ -```unison +``` unison id x = x id2 x = @@ -29,7 +29,7 @@ scratch/main> add id2 : x -> x ``` -```unison +``` unison > id2 "hi" ``` diff --git a/unison-src/transcripts/fix1731.output.md b/unison-src/transcripts/fix1731.output.md index f3fc1c35d1..8c8a7610a4 100644 --- a/unison-src/transcripts/fix1731.output.md +++ b/unison-src/transcripts/fix1731.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison structural ability CLI where print : Text ->{CLI} () input : {CLI} Text @@ -7,7 +6,7 @@ structural ability CLI where The `input` here should parse as a wildcard, not as `CLI.input`. -```unison +``` unison repro : Text -> () repro = cases input -> () diff --git a/unison-src/transcripts/fix1800.output.md b/unison-src/transcripts/fix1800.output.md index 915f50e70a..8fb9e9297e 100644 --- a/unison-src/transcripts/fix1800.output.md +++ b/unison-src/transcripts/fix1800.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison printLine : Text ->{IO} () printLine msg = _ = putBytes.impl (stdHandle StdOut) (Text.toUtf8 (msg ++ "\n")) @@ -18,8 +17,8 @@ main3 _ = printLine "🦄 ☁️ 🌈" Testing a few variations here: -* Should be able to run annotated and unannotated main functions in the current file. -* Should be able to run annotated and unannotated main functions from the codebase. + - Should be able to run annotated and unannotated main functions in the current file. + - Should be able to run annotated and unannotated main functions from the codebase. ```ucm scratch/main> run main1 @@ -74,7 +73,7 @@ scratch/main> run code.main3 ``` Now testing a few variations that should NOT typecheck. -```unison +``` unison main4 : Nat ->{IO} Nat main4 n = n diff --git a/unison-src/transcripts/fix1844.output.md b/unison-src/transcripts/fix1844.output.md index 571daa8b9a..bbc28208c0 100644 --- a/unison-src/transcripts/fix1844.output.md +++ b/unison-src/transcripts/fix1844.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison structural type One a = One a unique type Woot a b c = Woot a b c unique type Z = Z diff --git a/unison-src/transcripts/fix1926.output.md b/unison-src/transcripts/fix1926.output.md index a325470e95..6326666d2d 100644 --- a/unison-src/transcripts/fix1926.output.md +++ b/unison-src/transcripts/fix1926.output.md @@ -4,7 +4,7 @@ scratch/main> builtins.merge Done. ``` -```unison +``` unison > 'sq sq = 2934892384 @@ -30,7 +30,7 @@ sq = 2934892384 do sq ``` -```unison +``` unison > 'sq sq = 2934892384 diff --git a/unison-src/transcripts/fix2026.output.md b/unison-src/transcripts/fix2026.output.md index e4f9d8d17b..5718d9516e 100644 --- a/unison-src/transcripts/fix2026.output.md +++ b/unison-src/transcripts/fix2026.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural ability Exception where raise : Failure -> x ex = unsafeRun! '(printLine "hello world") diff --git a/unison-src/transcripts/fix2027.output.md b/unison-src/transcripts/fix2027.output.md index 2a7b30deca..cb959dcc5d 100644 --- a/unison-src/transcripts/fix2027.output.md +++ b/unison-src/transcripts/fix2027.output.md @@ -1,6 +1,4 @@ - - -```unison +``` unison structural ability Exception where raise : Failure -> x reraise = cases diff --git a/unison-src/transcripts/fix2049.output.md b/unison-src/transcripts/fix2049.output.md index 3db4fa2f2f..492729b03e 100644 --- a/unison-src/transcripts/fix2049.output.md +++ b/unison-src/transcripts/fix2049.output.md @@ -1,4 +1,4 @@ -```unison +``` unison id x = x structural ability Stream a where @@ -87,7 +87,7 @@ Fold.Stream.fold = ``` Tests some capabilities for catching runtime exceptions. -```unison +``` unison catcher : '{IO} () ->{IO} Result catcher act = handle tryEval act with cases diff --git a/unison-src/transcripts/fix2156.output.md b/unison-src/transcripts/fix2156.output.md index c4eed7557a..acad8adb9e 100644 --- a/unison-src/transcripts/fix2156.output.md +++ b/unison-src/transcripts/fix2156.output.md @@ -1,8 +1,7 @@ - Tests for a case where bad eta reduction was causing erroneous watch output/caching. -```unison +``` unison sqr : Nat -> Nat sqr n = n * n diff --git a/unison-src/transcripts/fix2167.output.md b/unison-src/transcripts/fix2167.output.md index 3d8c3251f6..0a5c34eb10 100644 --- a/unison-src/transcripts/fix2167.output.md +++ b/unison-src/transcripts/fix2167.output.md @@ -1,7 +1,7 @@ This is just a simple transcript to regression check an ability inference/checking issue. -```unison +``` unison structural ability R t where die : () -> x near.impl : Nat -> Either () [Nat] @@ -37,3 +37,4 @@ fail because the type was invalid. The fix was to avoid dropping certain existential variables out of scope. + diff --git a/unison-src/transcripts/fix2187.output.md b/unison-src/transcripts/fix2187.output.md index 8f499449e2..45fb5de8b4 100644 --- a/unison-src/transcripts/fix2187.output.md +++ b/unison-src/transcripts/fix2187.output.md @@ -1,4 +1,4 @@ -```unison +``` unison lexicalScopeEx: [Text] lexicalScopeEx = parent = "outer" diff --git a/unison-src/transcripts/fix2231.output.md b/unison-src/transcripts/fix2231.output.md index b94ff2c9db..5dfb0b791c 100644 --- a/unison-src/transcripts/fix2231.output.md +++ b/unison-src/transcripts/fix2231.output.md @@ -6,7 +6,7 @@ and while they are all valid and some may be equivalently general, the choices may not work equally well with the type checking strategies. -```unison +``` unison (<<) : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c (<<) f g x = f (g x) diff --git a/unison-src/transcripts/fix2238.output.md b/unison-src/transcripts/fix2238.output.md index b9594f0150..0133809e1f 100644 --- a/unison-src/transcripts/fix2238.output.md +++ b/unison-src/transcripts/fix2238.output.md @@ -1,7 +1,6 @@ - This should not typecheck - the inline `@eval` expression uses abilities. -```unison +``` unison structural ability Abort where abort : x ex = {{ @eval{abort} }} diff --git a/unison-src/transcripts/fix2254.output.md b/unison-src/transcripts/fix2254.output.md index eed5075c10..7abb352337 100644 --- a/unison-src/transcripts/fix2254.output.md +++ b/unison-src/transcripts/fix2254.output.md @@ -1,7 +1,6 @@ - This transcript checks that updates to data types propagate successfully to dependent types and dependent terms that do pattern matching. First let's create some types and terms: -```unison +``` unison unique type A a b c d = A a | B b @@ -55,7 +54,7 @@ scratch/a> branch a2 ``` First let's edit the `A` type, adding another constructor `E`. Note that the functions written against the old type have a wildcard in their pattern match, so they should work fine after the update. -```unison +``` unison unique type A a b c d = A a | B b @@ -116,7 +115,7 @@ scratch/a2> todo Here's a test of updating a record: -```unison +``` unison structural type Rec = { uno : Nat, dos : Nat } combine r = uno r + dos r @@ -164,7 +163,7 @@ scratch/r1> branch r2 `switch /r1` then `merge /r2`. ``` -```unison +``` unison structural type Rec = { uno : Nat, dos : Nat, tres : Text } ``` diff --git a/unison-src/transcripts/fix2268.output.md b/unison-src/transcripts/fix2268.output.md index bfb65920fd..1c170dd548 100644 --- a/unison-src/transcripts/fix2268.output.md +++ b/unison-src/transcripts/fix2268.output.md @@ -2,7 +2,7 @@ Tests for a TDNR case that wasn't working. The code wasn't 'relaxing' inferred types that didn't contain arrows, so effects that just yield a value weren't getting disambiguated. -```unison +``` unison unique ability A where a : Nat diff --git a/unison-src/transcripts/fix2334.output.md b/unison-src/transcripts/fix2334.output.md index 669017cd88..03e65bdcde 100644 --- a/unison-src/transcripts/fix2334.output.md +++ b/unison-src/transcripts/fix2334.output.md @@ -1,8 +1,7 @@ - Tests an issue where pattern matching matrices involving built-in types was discarding default cases in some branches. -```unison +``` unison f = cases 0, 0 -> 0 _, 1 -> 2 diff --git a/unison-src/transcripts/fix2344.output.md b/unison-src/transcripts/fix2344.output.md index 6d0ae41c4f..4c35e7211d 100644 --- a/unison-src/transcripts/fix2344.output.md +++ b/unison-src/transcripts/fix2344.output.md @@ -1,10 +1,9 @@ - Checks a corner case with type checking involving destructuring binds. The binds were causing some sequences of lets to be unnecessarily recursive. -```unison +``` unison unique ability Nate where nate: (Boolean, Nat) antiNate: () diff --git a/unison-src/transcripts/fix2350.output.md b/unison-src/transcripts/fix2350.output.md index d8f6bf43b1..4fcf50790f 100644 --- a/unison-src/transcripts/fix2350.output.md +++ b/unison-src/transcripts/fix2350.output.md @@ -1,4 +1,3 @@ - This tests an issue where ability variables were being defaulted over eagerly. In general, we want to avoid collecting up variables from the use of definitions with types like: @@ -17,7 +16,7 @@ abilities being collected aren't in the context, so types like: were a corner case. We would add `S e` to the wanted abilities, then not realize that `e` shouldn't be defaulted. -```unison +``` unison unique ability Storage d g where save.impl : a ->{Storage d g} ('{g} (d a)) diff --git a/unison-src/transcripts/fix2353.output.md b/unison-src/transcripts/fix2353.output.md index 74c9da016f..72d0c465eb 100644 --- a/unison-src/transcripts/fix2353.output.md +++ b/unison-src/transcripts/fix2353.output.md @@ -1,4 +1,4 @@ -```unison +``` unison use builtin Scope unique ability Async t g where async : {g} Nat unique ability Exception where raise : Nat -> x diff --git a/unison-src/transcripts/fix2354.output.md b/unison-src/transcripts/fix2354.output.md index 7fcfce26a9..4dab203483 100644 --- a/unison-src/transcripts/fix2354.output.md +++ b/unison-src/transcripts/fix2354.output.md @@ -1,8 +1,7 @@ - Tests that delaying an un-annotated higher-rank type gives a normal type error, rather than an internal compiler error. -```unison +``` unison f : (forall a . a -> a) -> Nat f id = id 0 diff --git a/unison-src/transcripts/fix2355.output.md b/unison-src/transcripts/fix2355.output.md index 0bc382663e..27337dbd65 100644 --- a/unison-src/transcripts/fix2355.output.md +++ b/unison-src/transcripts/fix2355.output.md @@ -1,7 +1,6 @@ - Tests for a loop that was previously occurring in the type checker. -```unison +``` unison structural ability A t g where fork : '{g, A t g} a -> t a await : t a -> a diff --git a/unison-src/transcripts/fix2378.output.md b/unison-src/transcripts/fix2378.output.md index 5acef2316d..73c63de736 100644 --- a/unison-src/transcripts/fix2378.output.md +++ b/unison-src/transcripts/fix2378.output.md @@ -1,9 +1,8 @@ - Tests for an ability failure that was caused by order dependence of checking wanted vs. provided abilities. It was necessary to re-check rows until a fixed point is reached. -```unison +``` unison unique ability C c where new : c a receive : c a -> a diff --git a/unison-src/transcripts/fix2423.output.md b/unison-src/transcripts/fix2423.output.md index 6deb34d734..cc17ad15cb 100644 --- a/unison-src/transcripts/fix2423.output.md +++ b/unison-src/transcripts/fix2423.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural ability Split where skip! : x both : a -> a -> a diff --git a/unison-src/transcripts/fix2474.output.md b/unison-src/transcripts/fix2474.output.md index f023e162b8..4a0d8a08ee 100644 --- a/unison-src/transcripts/fix2474.output.md +++ b/unison-src/transcripts/fix2474.output.md @@ -1,21 +1,20 @@ - Tests an issue with a lack of generality of handlers. In general, a set of cases: - { e ... -> k } +{ e ... -\> k } should be typed in the following way: - 1. The scrutinee has type `Request {E, g} r -> s` where `E` is all - the abilities being handled. `g` is a slack variable, because all - abilities that are used in the handled expression pass through - the handler. Previously this was being inferred as merely - `Request {E} r -> s` - 2. The continuation variable `k` should have type `o ->{E, g} r`, - matching the above types (`o` is the result type of `e`). - Previously this was being checked as `o ->{E0} r`, where `E0` is - the ability that contains `e`. +1. The scrutinee has type `Request {E, g} r -> s` where `E` is all + the abilities being handled. `g` is a slack variable, because all + abilities that are used in the handled expression pass through + the handler. Previously this was being inferred as merely + `Request {E} r -> s` +2. The continuation variable `k` should have type `o ->{E, g} r`, + matching the above types (`o` is the result type of `e`). + Previously this was being checked as `o ->{E0} r`, where `E0` is + the ability that contains `e`. ```ucm scratch/main> builtins.merge @@ -23,7 +22,7 @@ scratch/main> builtins.merge Done. ``` -```unison +``` unison structural ability Stream a where emit : a -> () diff --git a/unison-src/transcripts/fix2628.output.md b/unison-src/transcripts/fix2628.output.md index 6dba18bfaf..cb51cf0d72 100644 --- a/unison-src/transcripts/fix2628.output.md +++ b/unison-src/transcripts/fix2628.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type foo.bar.baz.MyRecord = { value : Nat } diff --git a/unison-src/transcripts/fix2663.output.md b/unison-src/transcripts/fix2663.output.md index c250fb403e..fcb73c75db 100644 --- a/unison-src/transcripts/fix2663.output.md +++ b/unison-src/transcripts/fix2663.output.md @@ -1,13 +1,12 @@ - Tests a variable capture problem. After pattern compilation, the match would end up: - T p1 p3 p3 +T p1 p3 p3 and z would end up referring to the first p3 rather than the second. -```unison +``` unison structural type Trip = T Nat Nat Nat bad : Nat -> (Nat, Nat) diff --git a/unison-src/transcripts/fix2693.output.md b/unison-src/transcripts/fix2693.output.md index 7bb6d60889..94961fc9e3 100644 --- a/unison-src/transcripts/fix2693.output.md +++ b/unison-src/transcripts/fix2693.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison loop : List Nat -> Nat -> List Nat loop l = cases 0 -> l @@ -32,7 +31,7 @@ scratch/main> add range : Nat -> [Nat] ``` -```unison +``` unison > range 2000 ``` @@ -2054,7 +2053,7 @@ scratch/main> add ``` Should be cached: -```unison +``` unison > range 2000 ``` diff --git a/unison-src/transcripts/fix2712.output.md b/unison-src/transcripts/fix2712.output.md index f691d22dca..04c8c46e3e 100644 --- a/unison-src/transcripts/fix2712.output.md +++ b/unison-src/transcripts/fix2712.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Map k v = Tip | Bin Nat k v (Map k v) (Map k v) mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b @@ -28,7 +28,7 @@ scratch/main> add mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b ``` -```unison +``` unison naiomi = susan: Nat -> Nat -> () susan a b = () diff --git a/unison-src/transcripts/fix2840.output.md b/unison-src/transcripts/fix2840.output.md index ab59e8f1eb..a84e33e4df 100644 --- a/unison-src/transcripts/fix2840.output.md +++ b/unison-src/transcripts/fix2840.output.md @@ -1,6 +1,6 @@ This bugfix addresses an issue where embedded Unison code in UCM was expected to be present in the active codebase when the `display` command was used render `Doc` values. -First, a few \[hidden] definitions necessary for typechecking a simple Doc2. +First, a few \[hidden\] definitions necessary for typechecking a simple Doc2. ```ucm scratch/main> add @@ -18,7 +18,8 @@ scratch/main> add ``` Next, define and display a simple Doc: -```unison + +``` unison README = {{ Hi }} @@ -32,10 +33,8 @@ scratch/main> display README ``` Previously, the error was: -``` -⚙️ Processing stanza 5 of 7.ucm: PE [("die",SrcLoc {srcLocPackage = "unison-parser-typechecker-0.0.0-He2Hp1llokT2nN4MnUfUXz", srcLocModule = "Unison.Runtime.Interface", srcLocFile = "src/Unison/Runtime/Interface.hs", srcLocStartLine = 118, srcLocStartCol = 18, srcLocEndLine = 118, srcLocEndCol = 60})] Lit - AnnotatedText (fromList [Segment {segment = "Unknown term reference: #4522d", annotation = Nothing}]) - -``` + ⚙️ Processing stanza 5 of 7.ucm: PE [("die",SrcLoc {srcLocPackage = "unison-parser-typechecker-0.0.0-He2Hp1llokT2nN4MnUfUXz", srcLocModule = "Unison.Runtime.Interface", srcLocFile = "src/Unison/Runtime/Interface.hs", srcLocStartLine = 118, srcLocStartCol = 18, srcLocEndLine = 118, srcLocEndCol = 60})] Lit + AnnotatedText (fromList [Segment {segment = "Unknown term reference: #4522d", annotation = Nothing}]) but as of this PR, it's okay. + diff --git a/unison-src/transcripts/fix2970.output.md b/unison-src/transcripts/fix2970.output.md index 52d017e842..2d4915f4a2 100644 --- a/unison-src/transcripts/fix2970.output.md +++ b/unison-src/transcripts/fix2970.output.md @@ -1,4 +1,4 @@ -Also fixes #1519 (it's the same issue). +Also fixes \#1519 (it's the same issue). ```ucm scratch/main> builtins.merge @@ -6,7 +6,7 @@ scratch/main> builtins.merge Done. ``` -```unison +``` unison foo.+.doc : Nat foo.+.doc = 10 ``` diff --git a/unison-src/transcripts/fix3037.output.md b/unison-src/transcripts/fix3037.output.md index 1ffd18c3bc..be813afc7b 100644 --- a/unison-src/transcripts/fix3037.output.md +++ b/unison-src/transcripts/fix3037.output.md @@ -2,7 +2,7 @@ Tests for an unsound case of ability checking that was erroneously being accepted before. In certain cases, abilities were able to be added to rows in invariant positions. -```unison +``` unison structural type Runner g = Runner (forall a. '{g} a -> {} a) pureRunner : Runner {} @@ -35,7 +35,7 @@ runner = pureRunner ``` Application version: -```unison +``` unison structural type A g = A (forall a. '{g} a ->{} a) anA : A {} diff --git a/unison-src/transcripts/fix3171.output.md b/unison-src/transcripts/fix3171.output.md index 6a6ba04962..0fdaf8377a 100644 --- a/unison-src/transcripts/fix3171.output.md +++ b/unison-src/transcripts/fix3171.output.md @@ -1,7 +1,7 @@ Tests an case where decompiling could cause function arguments to occur in the opposite order for partially applied functions. -```unison +``` unison f : Nat -> Nat -> Nat -> () -> Nat f x y z _ = x + y * z diff --git a/unison-src/transcripts/fix3196.output.md b/unison-src/transcripts/fix3196.output.md index 3a5e2944d1..95f0764c02 100644 --- a/unison-src/transcripts/fix3196.output.md +++ b/unison-src/transcripts/fix3196.output.md @@ -1,11 +1,10 @@ - Tests ability checking in scenarios where one side is concrete and the other is a variable. This was supposed to be covered, but the method wasn't actually symmetric, so doing `equate l r` might work, but not `equate r l`. Below were cases that caused the failing order. -```unison +``` unison structural type W es = W unique ability Zoot where diff --git a/unison-src/transcripts/fix3215.output.md b/unison-src/transcripts/fix3215.output.md index aaa3e8f4c3..492d69016d 100644 --- a/unison-src/transcripts/fix3215.output.md +++ b/unison-src/transcripts/fix3215.output.md @@ -3,7 +3,7 @@ inferred type. This was due to the pre-pass that figures out which abilities are being matched on. It was just concatenating the ability for each pattern into a list, and not checking whether there were duplicates. -```unison +``` unison structural ability T where nat : Nat int : Int diff --git a/unison-src/transcripts/fix3244.output.md b/unison-src/transcripts/fix3244.output.md index 94231d1745..5eca2f4f7a 100644 --- a/unison-src/transcripts/fix3244.output.md +++ b/unison-src/transcripts/fix3244.output.md @@ -2,7 +2,7 @@ This tests an previously erroneous case in the pattern compiler. It was assuming that the variables bound in a guard matched the variables bound in the rest of the branch exactly, but apparently this needn't be the case. -```unison +``` unison foo t = (x, _) = t f w = w + x diff --git a/unison-src/transcripts/fix3265.output.md b/unison-src/transcripts/fix3265.output.md index 93e8db747f..2db3893b80 100644 --- a/unison-src/transcripts/fix3265.output.md +++ b/unison-src/transcripts/fix3265.output.md @@ -1,12 +1,13 @@ Tests cases that produced bad decompilation output previously. There are three cases that need to be 'fixed up.' - 1. lambda expressions with free variables need to be beta reduced - 2. let defined functions need to have arguments removed and - occurrences rewritten. - 3. let-rec defined functions need to have arguments removed, but - it is a more complicated process. -```unison +1. lambda expressions with free variables need to be beta reduced +2. let defined functions need to have arguments removed and + occurrences rewritten. +3. let-rec defined functions need to have arguments removed, but + it is a more complicated process. + +``` unison > Any (w x -> let f0 y = match y with 0 -> x @@ -56,7 +57,7 @@ always occur with `x` as the first argument, but if we aren't careful, we might do that, because we find the first occurrence of `f`, and discard its arguments, where `f` also occurs. -```unison +``` unison > Any (x -> let f x y = match y with 0 -> 0 diff --git a/unison-src/transcripts/fix3634.output.md b/unison-src/transcripts/fix3634.output.md index 8648dd1cf3..e06cd8fbc4 100644 --- a/unison-src/transcripts/fix3634.output.md +++ b/unison-src/transcripts/fix3634.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural type M a = N | J a d = {{ diff --git a/unison-src/transcripts/fix3678.output.md b/unison-src/transcripts/fix3678.output.md index f99633e649..3b2754bdd0 100644 --- a/unison-src/transcripts/fix3678.output.md +++ b/unison-src/transcripts/fix3678.output.md @@ -1,7 +1,6 @@ - Array comparison was indexing out of bounds. -```unison +``` unison arr = Scope.run do ma = Scope.arrayOf "asdf" 0 freeze! ma diff --git a/unison-src/transcripts/fix3752.output.md b/unison-src/transcripts/fix3752.output.md index fd477070ba..fb52acd219 100644 --- a/unison-src/transcripts/fix3752.output.md +++ b/unison-src/transcripts/fix3752.output.md @@ -1,7 +1,7 @@ These were failing to type check before, because id was not generalized. -```unison +``` unison foo = do id x = _ = 1 diff --git a/unison-src/transcripts/fix3759.output.md b/unison-src/transcripts/fix3759.output.md index d4f1d9b2a1..4f0db3fe59 100644 --- a/unison-src/transcripts/fix3759.output.md +++ b/unison-src/transcripts/fix3759.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison unique type codebase.Foo = Foo Woot.state : Nat @@ -9,7 +8,7 @@ Woot.frobnicate : Nat Woot.frobnicate = 43 ``` -```unison +``` unison unique type Oog.Foo = Foo Text unique ability Blah where diff --git a/unison-src/transcripts/fix3773.output.md b/unison-src/transcripts/fix3773.output.md index 09027c3a11..e7f355fd0b 100644 --- a/unison-src/transcripts/fix3773.output.md +++ b/unison-src/transcripts/fix3773.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison foo = _ = 1 _ = 22 diff --git a/unison-src/transcripts/fix4172.output.md b/unison-src/transcripts/fix4172.output.md index da56c39408..436f797154 100644 --- a/unison-src/transcripts/fix4172.output.md +++ b/unison-src/transcripts/fix4172.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison debug a = match Debug.toText a with None -> "" Some (Left a) -> a @@ -56,7 +55,7 @@ scratch/main> test Tip: Use view 1 to view the source of a test. ``` -```unison +``` unison bool = false ``` diff --git a/unison-src/transcripts/fix4280.output.md b/unison-src/transcripts/fix4280.output.md index 8b918418f8..4c7fbb2de2 100644 --- a/unison-src/transcripts/fix4280.output.md +++ b/unison-src/transcripts/fix4280.output.md @@ -1,4 +1,4 @@ -```unison +``` unison foo.bar._baz = 5 bonk : Nat diff --git a/unison-src/transcripts/fix4397.output.md b/unison-src/transcripts/fix4397.output.md index e80ab21d49..2cb173290f 100644 --- a/unison-src/transcripts/fix4397.output.md +++ b/unison-src/transcripts/fix4397.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural type Foo f = Foo (f ()) unique type Baz = Baz (Foo Bar) diff --git a/unison-src/transcripts/fix4415.output.md b/unison-src/transcripts/fix4415.output.md index b6d881fa2a..90d57f289e 100644 --- a/unison-src/transcripts/fix4415.output.md +++ b/unison-src/transcripts/fix4415.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison unique type Foo = Foo unique type sub.Foo = ``` diff --git a/unison-src/transcripts/fix4424.output.md b/unison-src/transcripts/fix4424.output.md index dbf505cedb..1eb07ab2d6 100644 --- a/unison-src/transcripts/fix4424.output.md +++ b/unison-src/transcripts/fix4424.output.md @@ -1,6 +1,6 @@ Some basics: -```unison +``` unison unique type Cat.Dog = Mouse Nat unique type Rat.Dog = Bird @@ -20,7 +20,7 @@ scratch/main> add ``` Now I want to add a constructor. -```unison +``` unison unique type Rat.Dog = Bird | Mouse ``` diff --git a/unison-src/transcripts/fix4482.output.md b/unison-src/transcripts/fix4482.output.md index d61ddd6657..26a73068d7 100644 --- a/unison-src/transcripts/fix4482.output.md +++ b/unison-src/transcripts/fix4482.output.md @@ -1,4 +1,4 @@ -```unison +``` unison lib.foo0.lib.bonk1.bar = 203 lib.foo0.baz = 1 lib.foo1.zonk = 204 @@ -53,7 +53,7 @@ myproj/main> upgrade foo0 foo1 to delete the temporary branch and switch back to main. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u mybar : Nat mybar = use Nat + diff --git a/unison-src/transcripts/fix4498.output.md b/unison-src/transcripts/fix4498.output.md index fb5bbd771b..149d3406ff 100644 --- a/unison-src/transcripts/fix4498.output.md +++ b/unison-src/transcripts/fix4498.output.md @@ -1,4 +1,4 @@ -```unison +``` unison lib.dep0.bonk.foo = 5 lib.dep0.zonk.foo = "hi" lib.dep0.lib.dep1.foo = 6 diff --git a/unison-src/transcripts/fix4515.output.md b/unison-src/transcripts/fix4515.output.md index e2f03e9d5a..925195662a 100644 --- a/unison-src/transcripts/fix4515.output.md +++ b/unison-src/transcripts/fix4515.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Foo1 unique type Bar = X Foo unique type Baz = X Foo @@ -35,7 +35,7 @@ myproject/main> add useBar : Bar -> Nat ``` -```unison +``` unison unique type Foo = Foo1 | Foo2 ``` diff --git a/unison-src/transcripts/fix4528.output.md b/unison-src/transcripts/fix4528.output.md index 4715b6f47f..8b2d96fc3f 100644 --- a/unison-src/transcripts/fix4528.output.md +++ b/unison-src/transcripts/fix4528.output.md @@ -1,4 +1,4 @@ -```unison +``` unison structural type Foo = MkFoo Nat main : () -> Foo diff --git a/unison-src/transcripts/fix4556.output.md b/unison-src/transcripts/fix4556.output.md index 2b4add6caa..f36c030d2a 100644 --- a/unison-src/transcripts/fix4556.output.md +++ b/unison-src/transcripts/fix4556.output.md @@ -1,4 +1,4 @@ -```unison +``` unison thing = 3 foo.hello = 5 + thing bar.hello = 5 + thing @@ -32,7 +32,7 @@ scratch/main> add thing : Nat ``` -```unison +``` unison thing = 2 ``` diff --git a/unison-src/transcripts/fix4592.output.md b/unison-src/transcripts/fix4592.output.md index d1711bb55b..1644f6c33c 100644 --- a/unison-src/transcripts/fix4592.output.md +++ b/unison-src/transcripts/fix4592.output.md @@ -1,4 +1,4 @@ -```unison +``` unison doc = {{ {{ bug "bug" 52 }} }} ``` diff --git a/unison-src/transcripts/fix4618.output.md b/unison-src/transcripts/fix4618.output.md index 0b6a3921d8..144c13a8d3 100644 --- a/unison-src/transcripts/fix4618.output.md +++ b/unison-src/transcripts/fix4618.output.md @@ -1,4 +1,4 @@ -```unison +``` unison foo = 5 unique type Bugs.Zonk = Bugs ``` @@ -26,7 +26,7 @@ scratch/main> add foo : Nat ``` -```unison +``` unison foo = 4 unique type Bugs = ``` diff --git a/unison-src/transcripts/fix4722.output.md b/unison-src/transcripts/fix4722.output.md index 85611e9d91..91b071e5fe 100644 --- a/unison-src/transcripts/fix4722.output.md +++ b/unison-src/transcripts/fix4722.output.md @@ -1,14 +1,13 @@ - Tests an improvement to type checking related to abilities. -`foo` below typechecks fine as long as all the branches are _checked_ +`foo` below typechecks fine as long as all the branches are *checked* against their expected type. However, it's annoying to have to annotate them. The old code was checking a match by just synthesizing and subtyping, but we can instead check a match by pushing the expected type into each case, allowing top-level annotations to act like annotations on each case. -```unison +``` unison ability X a where yield : {X a} () ability Y where y : () diff --git a/unison-src/transcripts/fix4780.output.md b/unison-src/transcripts/fix4780.output.md index 9338c39660..392060c340 100644 --- a/unison-src/transcripts/fix4780.output.md +++ b/unison-src/transcripts/fix4780.output.md @@ -1,7 +1,7 @@ Just a simple test case to see whether partially applied builtins decompile properly. -```unison +``` unison > (+) 2 ``` diff --git a/unison-src/transcripts/fix4898.output.md b/unison-src/transcripts/fix4898.output.md index c348778f25..62c4d63772 100644 --- a/unison-src/transcripts/fix4898.output.md +++ b/unison-src/transcripts/fix4898.output.md @@ -4,7 +4,7 @@ scratch/main> builtins.merge Done. ``` -```unison +``` unison double : Int -> Int double x = x + x diff --git a/unison-src/transcripts/fix5055.output.md b/unison-src/transcripts/fix5055.output.md index a9fe9ee5d0..475edc5bdc 100644 --- a/unison-src/transcripts/fix5055.output.md +++ b/unison-src/transcripts/fix5055.output.md @@ -4,7 +4,7 @@ test-5055/main> builtins.merge Done. ``` -```unison +``` unison foo.add x y = x Int.+ y foo.subtract x y = x Int.- y diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md index c9d0b7c0ce..67468e1b85 100644 --- a/unison-src/transcripts/fix5080.output.md +++ b/unison-src/transcripts/fix5080.output.md @@ -1,4 +1,4 @@ -```unison +``` unison test> fix5080.tests.success = [Ok "success"] test> fix5080.tests.failure = [Fail "fail"] ``` diff --git a/unison-src/transcripts/fix614.output.md b/unison-src/transcripts/fix614.output.md index b679698eb6..770489a098 100644 --- a/unison-src/transcripts/fix614.output.md +++ b/unison-src/transcripts/fix614.output.md @@ -2,7 +2,7 @@ This transcript demonstrates that Unison forces actions in blocks to have a retu This works, as expected: -```unison +``` unison structural ability Stream a where emit : a -> () ex1 = do @@ -27,7 +27,7 @@ ex1 = do ``` This does not typecheck, we've accidentally underapplied `Stream.emit`: -```unison +``` unison ex2 = do Stream.emit 42 @@ -49,7 +49,7 @@ ex2 = do ``` We can explicitly ignore an unused result like so: -```unison +``` unison ex3 = do _ = Stream.emit () @@ -70,7 +70,7 @@ ex3 = do ``` Using a helper function like `void` also works fine: -```unison +``` unison void x = () ex4 = @@ -94,7 +94,7 @@ ex4 = ``` One more example: -```unison +``` unison ex4 = [1,2,3] -- no good () diff --git a/unison-src/transcripts/fix689.output.md b/unison-src/transcripts/fix689.output.md index 9bb9dcc064..06689cf642 100644 --- a/unison-src/transcripts/fix689.output.md +++ b/unison-src/transcripts/fix689.output.md @@ -1,6 +1,6 @@ Tests the fix for https://github.com/unisonweb/unison/issues/689 -```unison +``` unison structural ability SystemTime where systemTime : ##Nat diff --git a/unison-src/transcripts/fix693.output.md b/unison-src/transcripts/fix693.output.md index a5d0377374..753e434f21 100644 --- a/unison-src/transcripts/fix693.output.md +++ b/unison-src/transcripts/fix693.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison structural ability X t where x : t -> a -> a @@ -35,7 +34,7 @@ skolem variable `a` such that `c : a` and the continuation has type `a ->{X} b`. Thus, `handle c with h : Optional a`, which is not the correct result type. -```unison +``` unison h0 : Request {X t} b -> Optional b h0 req = match req with { X.x _ c -> _ } -> handle c with h0 @@ -63,7 +62,7 @@ h0 req = match req with ``` This code should not check because `t` does not match `b`. -```unison +``` unison h1 : Request {X t} b -> Optional b h1 req = match req with { X.x t _ -> _ } -> handle t with h1 @@ -92,7 +91,7 @@ h1 req = match req with This code should not check for reasons similar to the first example, but with the continuation rather than a parameter. -```unison +``` unison h2 : Request {Abort} r -> r h2 req = match req with { Abort.abort -> k } -> handle k 5 with h2 @@ -114,7 +113,7 @@ h2 req = match req with ``` This should work fine. -```unison +``` unison h3 : Request {X b, Abort} b -> Optional b h3 = cases { r } -> Some r diff --git a/unison-src/transcripts/fix845.output.md b/unison-src/transcripts/fix845.output.md index fbdc9fc732..6b910d67eb 100644 --- a/unison-src/transcripts/fix845.output.md +++ b/unison-src/transcripts/fix845.output.md @@ -1,7 +1,6 @@ - Add `List.zonk` to the codebase: -```unison +``` unison List.zonk : [a] -> [a] List.zonk xs = xs @@ -25,7 +24,7 @@ Text.zonk txt = txt ++ "!! " ``` Now, typecheck a file with a reference to `Blah.zonk` (which doesn't exist in the codebase). This should fail: -```unison +``` unison -- should not typecheck as there's no `Blah.zonk` in the codebase > Blah.zonk [1,2,3] ``` @@ -52,7 +51,7 @@ Now, typecheck a file with a reference to `Blah.zonk` (which doesn't exist in th ``` Here's another example, just checking that TDNR works for definitions in the same file: -```unison +``` unison foo.bar.baz = 42 qux.baz = "hello" @@ -86,7 +85,7 @@ ex = baz ++ ", world!" ``` Here's another example, checking that TDNR works when multiple codebase definitions have matching names: -```unison +``` unison ex = zonk "hi" > ex @@ -114,7 +113,7 @@ ex = zonk "hi" ``` Last example, showing that TDNR works when there are multiple matching names in both the file and the codebase: -```unison +``` unison woot.zonk = "woot" woot2.zonk = 9384 diff --git a/unison-src/transcripts/fix849.output.md b/unison-src/transcripts/fix849.output.md index 33720e550e..f1775f6306 100644 --- a/unison-src/transcripts/fix849.output.md +++ b/unison-src/transcripts/fix849.output.md @@ -1,7 +1,6 @@ - See [this ticket](https://github.com/unisonweb/unison/issues/849). -```unison +``` unison x = 42 > x diff --git a/unison-src/transcripts/fix942.output.md b/unison-src/transcripts/fix942.output.md index 68ec09bba8..13d68377a7 100644 --- a/unison-src/transcripts/fix942.output.md +++ b/unison-src/transcripts/fix942.output.md @@ -1,6 +1,6 @@ First we add some code: -```unison +``` unison x = 0 y = x + 1 z = y + 2 @@ -33,7 +33,7 @@ scratch/main> add ``` Now we edit `x` to be `7`, which should make `z` equal `10`: -```unison +``` unison x = 7 ``` @@ -79,9 +79,9 @@ scratch/main> view x y z y + 2 ``` -Uh oh! `z` is still referencing the old version. Just to confirm: +Uh oh\! `z` is still referencing the old version. Just to confirm: -```unison +``` unison test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] ``` diff --git a/unison-src/transcripts/fix987.output.md b/unison-src/transcripts/fix987.output.md index 50d747862f..e816b3808e 100644 --- a/unison-src/transcripts/fix987.output.md +++ b/unison-src/transcripts/fix987.output.md @@ -1,7 +1,6 @@ - First we'll add a definition: -```unison +``` unison structural ability DeathStar where attack : Text -> () @@ -38,7 +37,7 @@ scratch/main> add ``` Now we'll try to add a different definition that runs the actions in a different order. This should work fine: -```unison +``` unison spaceAttack2 x = z = attack "neptune" y = attack "saturn" @@ -67,3 +66,4 @@ scratch/main> add ``` Previously, this would fail because the hashing algorithm was being given one big let rec block whose binding order was normalized. + diff --git a/unison-src/transcripts/formatter.output.md b/unison-src/transcripts/formatter.output.md index ce931ed31d..1b16b7def5 100644 --- a/unison-src/transcripts/formatter.output.md +++ b/unison-src/transcripts/formatter.output.md @@ -1,4 +1,4 @@ -```unison +``` unison {{ # Doc This is a *doc*! @@ -87,7 +87,7 @@ with a strike-through block~ scratch/main> debug.format ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u x.doc = {{ # Doc This is a **doc**! @@ -167,7 +167,7 @@ multilineBold = Formatter should leave things alone if the file doesn't typecheck. -```unison +``` unison brokenDoc = {{ hello }} + 1 ``` diff --git a/unison-src/transcripts/fuzzy-options.output.md b/unison-src/transcripts/fuzzy-options.output.md index 290d07aab1..f07d399060 100644 --- a/unison-src/transcripts/fuzzy-options.output.md +++ b/unison-src/transcripts/fuzzy-options.output.md @@ -2,7 +2,6 @@ If an argument is required but doesn't have a fuzzy resolver, the command should just print the help. - ```ucm -- The second argument of move.term is a 'new-name' and doesn't have a fuzzy resolver scratch/main> move.term @@ -21,7 +20,7 @@ scratch/empty> view Sorry, I was expecting an argument for the definition to view, and I couldn't find any to suggest to you. 😅 ``` -```unison +``` unison optionOne = 1 nested.optionTwo = 2 diff --git a/unison-src/transcripts/generic-parse-errors.output.md b/unison-src/transcripts/generic-parse-errors.output.md index 7800cbab47..b0f6d6a5ba 100644 --- a/unison-src/transcripts/generic-parse-errors.output.md +++ b/unison-src/transcripts/generic-parse-errors.output.md @@ -1,6 +1,6 @@ Just a bunch of random parse errors to test the error formatting. -```unison +``` unison x = foo.123 ``` @@ -22,7 +22,7 @@ x = * identifier (ex: abba1, snake_case, .foo.bar#xyz, .foo.++#xyz, or 🌻) ``` -```unison +``` unison namespace.blah = 1 ``` @@ -38,7 +38,7 @@ namespace.blah = 1 or wrapping it in backticks (like `namespace` ). ``` -```unison +``` unison x = 1 ] ``` @@ -52,7 +52,7 @@ x = 1 ] ``` -```unison +``` unison x = a.#abc ``` @@ -68,7 +68,7 @@ x = a.#abc I was surprised to find a '.' here. ``` -```unison +``` unison x = "hi ``` @@ -78,7 +78,8 @@ x = "hi I got confused here: - 2 | + 1 | x = "hi + I was surprised to find an end of input here. I was expecting one of these instead: @@ -88,7 +89,7 @@ x = "hi * literal character ``` -```unison +``` unison y : a ``` @@ -98,7 +99,8 @@ y : a I got confused here: - 2 | + 1 | y : a + I was surprised to find an end of section here. I was expecting one of these instead: diff --git a/unison-src/transcripts/hello.output.md b/unison-src/transcripts/hello.output.md index e6d03ea95e..3c5d9bc8c2 100644 --- a/unison-src/transcripts/hello.output.md +++ b/unison-src/transcripts/hello.output.md @@ -1,29 +1,25 @@ - -# Hello! +# Hello\! This markdown file is also a Unison transcript file. Transcript files are an easy way to create self-documenting Unison programs, libraries, and tutorials. The format is just a regular markdown file with some fenced code blocks that are typechecked and elaborated by `ucm`. For example, you can call this transcript via: -``` -$ ucm transcript hello.md - -``` + $ ucm transcript hello.md This runs it on a freshly generated empty codebase. Alternately `ucm transcript.fork --codebase /path/to/code hello.md` runs the transcript on a freshly generated copy of the provided codebase. Do `ucm help` to learn more about usage. Fenced code blocks of type `unison` and `ucm` are treated specially: -* `ucm` blocks are executed, and the output is interleaved into the output markdown file after each command, replacing the original `ucm` block. -* `unison` blocks are typechecked, and a `ucm` block with the output of typechecking and execution of the file is inserted immediately afterwards. + - `ucm` blocks are executed, and the output is interleaved into the output markdown file after each command, replacing the original `ucm` block. + - `unison` blocks are typechecked, and a `ucm` block with the output of typechecking and execution of the file is inserted immediately afterwards. Take a look at [the elaborated output](hello.output.md) to see what this file looks like after passing through the transcript runner. -## Let's try it out!! +## Let's try it out\!\! In the `unison` fenced block, you can give an (optional) file name (defaults to `scratch.u`), like so: -```unison +``` unison --- title: myfile.u --- @@ -31,7 +27,6 @@ x = 42 ``` - ```ucm Loading changes detected in myfile.u. @@ -66,7 +61,7 @@ If `view` returned no results, the transcript would fail at this point. You may not always want to view the output of typechecking and evaluation every time, in which case, you can add `:hide` to the block. For instance: -```unison +``` unison y = 99 ``` @@ -76,9 +71,9 @@ Doing `unison:hide:all` hides the block altogether, both input and output - this ## Expecting failures -Sometimes, you have a block which you are _expecting_ to fail, perhaps because you're illustrating how something would be a type error. Adding `:error` to the block will check for this. For instance, this program has a type error: +Sometimes, you have a block which you are *expecting* to fail, perhaps because you're illustrating how something would be a type error. Adding `:error` to the block will check for this. For instance, this program has a type error: -```unison +``` unison hmm : .builtin.Nat hmm = "Not, in fact, a number" ``` diff --git a/unison-src/transcripts/help.output.md b/unison-src/transcripts/help.output.md index 27a6d74897..54662d0c95 100644 --- a/unison-src/transcripts/help.output.md +++ b/unison-src/transcripts/help.output.md @@ -966,3 +966,4 @@ scratch/main> help-topic testcache ``` We should add a command to show help for hidden commands also. + diff --git a/unison-src/transcripts/higher-rank.output.md b/unison-src/transcripts/higher-rank.output.md index 2054583f63..f4c2dbf502 100644 --- a/unison-src/transcripts/higher-rank.output.md +++ b/unison-src/transcripts/higher-rank.output.md @@ -1,9 +1,8 @@ - This transcript does some testing of higher-rank types. Regression tests related to higher-rank types can be added here. In this example, a higher-rank function is defined, `f`. No annotation is needed at the call-site of `f`, because the lambda is being checked against the polymorphic type `forall a . a -> a`, rather than inferred: -```unison +``` unison f : (forall a . a -> a) -> (Nat, Text) f id = (id 1, id "hi") @@ -32,7 +31,7 @@ f id = (id 1, id "hi") ``` Another example, involving abilities. Here the ability-polymorphic function is instantiated with two different ability lists, `{}` and `{IO}`: -```unison +``` unison f : (forall a g . '{g} a -> '{g} a) -> () -> () f id _ = _ = (id ('1 : '{} Nat), id ('("hi") : '{IO} Text)) @@ -54,7 +53,7 @@ f id _ = ``` Here's an example, showing that polymorphic functions can be fields of a constructor, and the functions remain polymorphic even when the field is bound to a name during pattern matching: -```unison +``` unison unique type Functor f = Functor (forall a b . (a -> b) -> f a -> f b) Functor.map : Functor f -> (forall a b . (a -> b) -> f a -> f b) @@ -85,7 +84,7 @@ Functor.blah = cases Functor f -> ``` This example is similar, but involves abilities: -```unison +``` unison unique ability Remote t where doRemoteStuff : t () unique type Loc = Loc (forall t a . '{Remote t} a ->{Remote t} t a) @@ -134,7 +133,7 @@ Loc.transform2 nt = cases Loc f -> ``` ## Types with polymorphic fields -```unison +``` unison structural type HigherRanked = HigherRanked (forall a. a -> a) ``` diff --git a/unison-src/transcripts/input-parse-errors.output.md b/unison-src/transcripts/input-parse-errors.output.md index ee1af109d8..2e00b284c4 100644 --- a/unison-src/transcripts/input-parse-errors.output.md +++ b/unison-src/transcripts/input-parse-errors.output.md @@ -1,10 +1,11 @@ # demonstrating our new input parsing errors -```unison +``` unison x = 55 ``` `handleNameArg` parse error in `add` + ```ucm scratch/main> add . @@ -42,8 +43,8 @@ scratch/main> add 2 ``` todo: -```haskell +``` haskell SA.Name name -> pure name SA.NameWithBranchPrefix (Left _) name -> pure name SA.NameWithBranchPrefix (Right prefix) name -> pure $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name @@ -56,7 +57,6 @@ todo: SA.SearchResult mpath result -> maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result otherNumArg -> Left . I.Formatted $ wrongStructuredArgument "a name" otherNumArg - ``` aliasMany: skipped -- similar to `add` @@ -75,18 +75,17 @@ You can run `help update` for more information on using ``` aliasTerm -```scratch -/main> alias.term ##Nat.+ Nat.+ -``` + scratch/main> alias.term ##Nat.+ Nat.+ aliasTermForce, aliasType, - todo: -```alias -Many, + +``` + +aliasMany, api, authLogin, back, @@ -202,6 +201,5 @@ upgradeCommitInputPattern, view, viewGlobal, viewReflog - ``` diff --git a/unison-src/transcripts/io-test-command.output.md b/unison-src/transcripts/io-test-command.output.md index ec848f23dc..65abcdab64 100644 --- a/unison-src/transcripts/io-test-command.output.md +++ b/unison-src/transcripts/io-test-command.output.md @@ -1,6 +1,6 @@ The `io.test` command should run all of the tests within the current namespace, excluding libs. -```unison +``` unison -- We manually specify types so we don't need to pull in base to run IO and such ioAndExceptionTest : '{IO, Exception} [Result] ioAndExceptionTest = do @@ -15,7 +15,7 @@ lib.ioAndExceptionTestInLib = do [Ok "Success"] ``` -Run a IO tests one by one +Run a IO tests one by one ```ucm scratch/main> io.test ioAndExceptionTest diff --git a/unison-src/transcripts/io.output.md b/unison-src/transcripts/io.output.md index cbc177145d..2cdaeea0ef 100644 --- a/unison-src/transcripts/io.output.md +++ b/unison-src/transcripts/io.output.md @@ -14,12 +14,12 @@ create a scratch directory which will automatically get cleaned up. ### Creating/Deleting/Renaming Directories Tests: createDirectory, - isDirectory, - fileExists, - renameDirectory, - deleteDirectory +isDirectory, +fileExists, +renameDirectory, +deleteDirectory -```unison +``` unison testCreateRename : '{io2.IO} [Result] testCreateRename _ = test = 'let @@ -85,10 +85,10 @@ scratch/main> io.test testCreateRename ### Opening / Closing files Tests: openFile - closeFile - isFileOpen +closeFile +isFileOpen -```unison +``` unison testOpenClose : '{io2.IO} [Result] testOpenClose _ = test = 'let @@ -166,11 +166,11 @@ scratch/main> io.test testOpenClose ### Reading files with getSomeBytes Tests: getSomeBytes - putBytes - isFileOpen - seekHandle +putBytes +isFileOpen +seekHandle -```unison +``` unison testGetSomeBytes : '{io2.IO} [Result] testGetSomeBytes _ = test = 'let @@ -258,15 +258,15 @@ scratch/main> io.test testGetSomeBytes ### Seeking in open files Tests: openFile - putBytes - closeFile - isSeekable - isFileEOF - seekHandle - getBytes - getLine - -```unison +putBytes +closeFile +isSeekable +isFileEOF +seekHandle +getBytes +getLine + +``` unison testSeek : '{io2.IO} [Result] testSeek _ = test = 'let @@ -374,7 +374,8 @@ scratch/main> io.test testAppend ``` ### SystemTime -```unison + +``` unison testSystemTime : '{io2.IO} [Result] testSystemTime _ = test = 'let @@ -417,7 +418,7 @@ scratch/main> io.test testSystemTime ``` ### Get temp directory -```unison +``` unison testGetTempDirectory : '{io2.IO} [Result] testGetTempDirectory _ = test = 'let @@ -448,7 +449,7 @@ scratch/main> io.test testGetTempDirectory ``` ### Get current directory -```unison +``` unison testGetCurrentDirectory : '{io2.IO} [Result] testGetCurrentDirectory _ = test = 'let @@ -479,7 +480,7 @@ scratch/main> io.test testGetCurrentDirectory ``` ### Get directory contents -```unison +``` unison testDirContents : '{io2.IO} [Result] testDirContents _ = test = 'let @@ -512,7 +513,7 @@ scratch/main> io.test testDirContents ``` ### Read environment variables -```unison +``` unison testGetEnv : '{io2.IO} [Result] testGetEnv _ = test = 'let @@ -548,7 +549,7 @@ scratch/main> io.test testGetEnv `runMeWithNoArgs`, `runMeWithOneArg`, and `runMeWithTwoArgs` raise exceptions unless they called with the right number of arguments. -```unison +``` unison testGetArgs.fail : Text -> Failure testGetArgs.fail descr = Failure (typeLink IOFailure) descr !Any @@ -578,6 +579,7 @@ testGetArgs.runMeWithTwoArgs = 'let ``` Test that they can be run with the right number of args. + ```ucm scratch/main> add @@ -658,7 +660,7 @@ scratch/main> run runMeWithTwoArgs ``` ### Get the time zone -```unison +``` unison testTimeZone = do (offset, summer, name) = Clock.internals.systemTimeZone +0 _ = (offset : Int, summer : Nat, name : Text) @@ -679,7 +681,7 @@ scratch/main> run testTimeZone ``` ### Get some random bytes -```unison +``` unison testRandom : '{io2.IO} [Result] testRandom = do test = do diff --git a/unison-src/transcripts/keyword-identifiers.output.md b/unison-src/transcripts/keyword-identifiers.output.md index 03ed3e919e..27a31d6f35 100644 --- a/unison-src/transcripts/keyword-identifiers.output.md +++ b/unison-src/transcripts/keyword-identifiers.output.md @@ -4,34 +4,34 @@ In particular, following a keyword with a `wordyIdChar` should be a valid identi Related issues: -- https://github.com/unisonweb/unison/issues/2091 -- https://github.com/unisonweb/unison/issues/2727 + - https://github.com/unisonweb/unison/issues/2091 + - https://github.com/unisonweb/unison/issues/2727 ## Keyword list Checks the following keywords: -- `type` -- `ability` -- `structural` -- `unique` -- `if` -- `then` -- `else` -- `forall` -- `handle` -- `with` -- `where` -- `use` -- `true` -- `false` -- `alias` -- `typeLink` -- `termLink` -- `let` -- `namespace` -- `match` -- `cases` + - `type` + - `ability` + - `structural` + - `unique` + - `if` + - `then` + - `else` + - `forall` + - `handle` + - `with` + - `where` + - `use` + - `true` + - `false` + - `alias` + - `typeLink` + - `termLink` + - `let` + - `namespace` + - `match` + - `cases` Note that although `∀` is a keyword, it cannot actually appear at the start of identifier. @@ -40,7 +40,7 @@ identifier. `type`: -```unison +``` unison typeFoo = 99 type1 = "I am a variable" type_ = 292 @@ -52,7 +52,7 @@ structural type type! type_ = type' type_ | type'' `ability`: -```unison +``` unison abilityFoo = 99 ability1 = "I am a variable" ability_ = 292 @@ -63,7 +63,7 @@ structural type ability! ability_ = ability' ability_ | ability'' `structural` -```unison +``` unison structuralFoo = 99 structural1 = "I am a variable" structural_ = 292 @@ -74,7 +74,7 @@ structural type structural! structural_ = structural' structural_ | structural'' `unique` -```unison +``` unison uniqueFoo = 99 unique1 = "I am a variable" unique_ = 292 @@ -85,7 +85,7 @@ structural type unique! unique_ = unique' unique_ | unique'' `if` -```unison +``` unison ifFoo = 99 if1 = "I am a variable" if_ = 292 @@ -96,7 +96,7 @@ structural type if! if_ = if' if_ | if'' `then` -```unison +``` unison thenFoo = 99 then1 = "I am a variable" then_ = 292 @@ -107,7 +107,7 @@ structural type then! then_ = then' then_ | then'' `else` -```unison +``` unison elseFoo = 99 else1 = "I am a variable" else_ = 292 @@ -118,7 +118,7 @@ structural type else! else_ = else' else_ | else'' `forall` -```unison +``` unison forallFoo = 99 forall1 = "I am a variable" forall_ = 292 @@ -129,7 +129,7 @@ structural type forall! forall_ = forall' forall_ | forall'' `handle` -```unison +``` unison handleFoo = 99 handle1 = "I am a variable" handle_ = 292 @@ -140,7 +140,7 @@ structural type handle! handle_ = handle' handle_ | handle'' `with` -```unison +``` unison withFoo = 99 with1 = "I am a variable" with_ = 292 @@ -151,7 +151,7 @@ structural type with! with_ = with' with_ | with'' `where` -```unison +``` unison whereFoo = 99 where1 = "I am a variable" where_ = 292 @@ -162,7 +162,7 @@ structural type where! where_ = where' where_ | where'' `use` -```unison +``` unison useFoo = 99 use1 = "I am a variable" use_ = 292 @@ -173,7 +173,7 @@ structural type use! use_ = use' use_ | use'' `true` -```unison +``` unison trueFoo = 99 true1 = "I am a variable" true_ = 292 @@ -184,7 +184,7 @@ structural type true! true_ = true' true_ | true'' `false` -```unison +``` unison falseFoo = 99 false1 = "I am a variable" false_ = 292 @@ -195,7 +195,7 @@ structural type false! false_ = false' false_ | false'' `alias` -```unison +``` unison aliasFoo = 99 alias1 = "I am a variable" alias_ = 292 @@ -206,7 +206,7 @@ structural type alias! alias_ = alias' alias_ | alias'' `typeLink` -```unison +``` unison typeLinkFoo = 99 typeLink1 = "I am a variable" typeLink_ = 292 @@ -217,7 +217,7 @@ structural type typeLink! typeLink_ = typeLink' typeLink_ | typeLink'' `termLink` -```unison +``` unison termLinkFoo = 99 termLink1 = "I am a variable" termLink_ = 292 @@ -228,7 +228,7 @@ structural type termLink! termLink_ = termLink' termLink_ | termLink'' `let` -```unison +``` unison letFoo = 99 let1 = "I am a variable" let_ = 292 @@ -239,7 +239,7 @@ structural type let! let_ = let' let_ | let'' `namespace` -```unison +``` unison namespaceFoo = 99 namespace1 = "I am a variable" namespace_ = 292 @@ -250,7 +250,7 @@ structural type namespace! namespace_ = namespace' namespace_ | namespace'' `match` -```unison +``` unison matchFoo = 99 match1 = "I am a variable" match_ = 292 @@ -261,7 +261,7 @@ structural type match! match_ = match' match_ | match'' `cases` -```unison +``` unison casesFoo = 99 cases1 = "I am a variable" cases_ = 292 diff --git a/unison-src/transcripts/kind-inference.output.md b/unison-src/transcripts/kind-inference.output.md index 73fb41d2d1..46a335a20a 100644 --- a/unison-src/transcripts/kind-inference.output.md +++ b/unison-src/transcripts/kind-inference.output.md @@ -1,8 +1,8 @@ - ## A type param cannot have conflicting kind constraints within a single decl conflicting constraints on the kind of `a` in a product -```unison + +``` unison unique type T a = T a (a Nat) ``` @@ -17,7 +17,8 @@ unique type T a = T a (a Nat) ``` conflicting constraints on the kind of `a` in a sum -```unison + +``` unison unique type T a = Star a | StarStar (a Nat) @@ -37,7 +38,8 @@ unique type T a Successfully infer `a` in `Ping a` to be of kind `* -> *` by inspecting its component-mate `Pong`. -```unison + +``` unison unique type Ping a = Ping Pong unique type Pong = Pong (Ping Optional) ``` @@ -58,7 +60,8 @@ unique type Pong = Pong (Ping Optional) ``` Catch the conflict on the kind of `a` in `Ping a`. `Ping` restricts `a` to `*`, whereas `Pong` restricts `a` to `* -> *`. -```unison + +``` unison unique type Ping a = Ping a Pong unique type Pong = Pong (Ping Optional) ``` @@ -75,7 +78,8 @@ unique type Pong = Pong (Ping Optional) ``` Successful example between mutually recursive type and ability -```unison + +``` unison unique type Ping a = Ping (a Nat -> {Pong Nat} ()) unique ability Pong a where pong : Ping Optional -> () @@ -96,7 +100,8 @@ unique ability Pong a where ``` Catch conflict between mutually recursive type and ability -```unison + +``` unison unique type Ping a = Ping (a -> {Pong Nat} ()) unique ability Pong a where pong : Ping Optional -> () @@ -114,7 +119,8 @@ unique ability Pong a where ``` Consistent instantiation of `T`'s `a` parameter in `S` -```unison + +``` unison unique type T a = T a unique type S = S (T Nat) @@ -137,7 +143,8 @@ unique type S = S (T Nat) Delay kind defaulting until all components are processed. Here `S` constrains the kind of `T`'s `a` parameter, although `S` is not in the same component as `T`. -```unison + +``` unison unique type T a = T unique type S = S (T Optional) @@ -158,7 +165,8 @@ unique type S = S (T Optional) ``` Catch invalid instantiation of `T`'s `a` parameter in `S` -```unison + +``` unison unique type T a = T a unique type S = S (T Optional) @@ -178,7 +186,8 @@ unique type S = S (T Optional) ## Checking annotations Catch kind error in type annotation -```unison + +``` unison test : Nat Nat test = 0 ``` @@ -195,7 +204,8 @@ test = 0 ``` Catch kind error in annotation example 2 -```unison + +``` unison test : Optional -> () test _ = () ``` @@ -212,7 +222,8 @@ test _ = () ``` Catch kind error in annotation example 3 -```unison + +``` unison unique type T a = T (a Nat) test : T Nat -> () @@ -231,7 +242,8 @@ test _ = () ``` Catch kind error in scoped type variable annotation -```unison + +``` unison unique type StarStar a = StarStar (a Nat) unique type Star a = Star a @@ -256,7 +268,8 @@ test _ = ## Effect/type mismatch Effects appearing where types are expected -```unison + +``` unison unique ability Foo where foo : () @@ -276,7 +289,8 @@ test _ = () ``` Types appearing where effects are expected -```unison + +``` unison test : {Nat} () test _ = () ``` @@ -295,7 +309,7 @@ test _ = () ``` ## Cyclic kinds -```unison +``` unison unique type T a = T (a a) ``` @@ -311,7 +325,7 @@ unique type T a = T (a a) is the kind of a. ``` -```unison +``` unison unique type T a b = T (a b) (b a) ``` @@ -327,7 +341,7 @@ unique type T a b = T (a b) (b a) k = (k -> Type) -> Type where k is the kind of b. ``` -```unison +``` unison unique type Ping a = Ping (a Pong) unique type Pong a = Pong (a Ping) ``` diff --git a/unison-src/transcripts/lambdacase.output.md b/unison-src/transcripts/lambdacase.output.md index 2e55001a98..86fd5b234d 100644 --- a/unison-src/transcripts/lambdacase.output.md +++ b/unison-src/transcripts/lambdacase.output.md @@ -2,7 +2,7 @@ This function takes a single argument and immediately pattern matches on it. As we'll see below, it can be written using `cases` syntax: -```unison +``` unison isEmpty x = match x with [] -> true _ -> false @@ -23,7 +23,7 @@ isEmpty x = match x with ``` Here's the same function written using `cases` syntax: -```unison +``` unison isEmpty2 = cases [] -> true _ -> false @@ -60,7 +60,7 @@ it shows the definition using `cases` syntax opportunistically, even though the Functions that take multiple arguments and immediately match on a tuple of arguments can also be rewritten to use `cases`. Here's a version using regular `match` syntax on a tuple: -```unison +``` unison merge : [a] -> [a] -> [a] merge xs ys = match (xs, ys) with ([], ys) -> ys @@ -80,7 +80,7 @@ scratch/main> add ``` And here's a version using `cases`. The patterns are separated by commas: -```unison +``` unison merge2 : [a] -> [a] -> [a] merge2 = cases [], ys -> ys @@ -122,7 +122,7 @@ it again shows the definition using the multi-argument `cases` syntax opportunis Here's another example: -```unison +``` unison structural type B = T | F blah : B -> B -> Text @@ -171,7 +171,7 @@ blorf = cases ``` ## Patterns with multiple guards -```unison +``` unison merge3 : [a] -> [a] -> [a] merge3 = cases [], ys -> ys @@ -213,7 +213,7 @@ scratch/main> view merge3 ``` This is the same definition written with multiple patterns and not using the `cases` syntax; notice it is considered an alias of `merge3` above. -```unison +``` unison merge4 : [a] -> [a] -> [a] merge4 a b = match (a,b) with [], ys -> ys diff --git a/unison-src/transcripts/lsp-fold-ranges.output.md b/unison-src/transcripts/lsp-fold-ranges.output.md index 2b76b3ff43..f2af4461bc 100644 --- a/unison-src/transcripts/lsp-fold-ranges.output.md +++ b/unison-src/transcripts/lsp-fold-ranges.output.md @@ -1,4 +1,4 @@ -```unison +``` unison {{ Type doc }} structural type Optional a = None diff --git a/unison-src/transcripts/lsp-name-completion.output.md b/unison-src/transcripts/lsp-name-completion.output.md index 622d415f4f..0b57f6a985 100644 --- a/unison-src/transcripts/lsp-name-completion.output.md +++ b/unison-src/transcripts/lsp-name-completion.output.md @@ -1,4 +1,4 @@ -```unison +``` unison foldMap = "top-level" nested.deeply.foldMap = "nested" lib.base.foldMap = "lib" @@ -29,6 +29,7 @@ scratch/main> debug.lsp-name-completion foldMap ``` Should still find the term which has a matching hash to a better name if the better name doesn't match. + ```ucm scratch/main> debug.lsp-name-completion transitive_same_hash.foldMap diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index a8a97adb6b..d67d0355b9 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -30,18 +30,21 @@ contains both additions. ## Basic merge: two unconflicted adds Alice's adds: -```unison + +``` unison foo : Text foo = "alices foo" ``` Bob's adds: -```unison + +``` unison bar : Text bar = "bobs bar" ``` Merge result: + ```ucm project/alice> merge /bob @@ -61,13 +64,15 @@ project/alice> view foo bar If Alice and Bob also happen to add the same definition, that's not a conflict. Alice's adds: -```unison + +``` unison foo : Text foo = "alice and bobs foo" ``` Bob's adds: -```unison + +``` unison foo : Text foo = "alice and bobs foo" @@ -76,6 +81,7 @@ bar = "bobs bar" ``` Merge result: + ```ucm project/alice> merge /bob @@ -95,19 +101,22 @@ project/alice> view foo bar Updates that occur in one branch are propagated to the other. In this example, Alice updates `foo`, while Bob adds a new dependent `bar` of the original `foo`. When Bob's branch is merged into Alice's, her update to `foo` is propagated to his `bar`. Original branch: -```unison + +``` unison foo : Text foo = "old foo" ``` Alice's updates: -```unison + +``` unison foo : Text foo = "new foo" ``` Bob's adds: -```unison + +``` unison bar : Text bar = foo ++ " - " ++ foo ``` @@ -119,6 +128,7 @@ project/bob> display bar ``` Merge result: + ```ucm project/alice> merge /bob @@ -146,7 +156,8 @@ We classify something as an update if its "syntactic hash"—not its normal Unis Let's see an example. We have `foo`, which depends on `bar` and `baz`. Alice updates `bar` (propagating to `foo`), and Bob updates `baz` (propagating to `foo`). When we merge their updates, both updates will be reflected in the final `foo`. Original branch: -```unison + +``` unison foo : Text foo = "foo" ++ " - " ++ bar ++ " - " ++ baz @@ -158,7 +169,8 @@ baz = "old baz" ``` Alice's updates: -```unison + +``` unison bar : Text bar = "alices bar" ``` @@ -170,7 +182,8 @@ project/alice> display foo ``` Bob's updates: -```unison + +``` unison baz : Text baz = "bobs baz" ``` @@ -182,6 +195,7 @@ project/bob> display foo ``` Merge result: + ```ucm project/alice> merge /bob @@ -210,7 +224,8 @@ project/alice> display foo Of course, it's also possible for Alice's update to propagate to one of Bob's updates. In this example, `foo` depends on `bar` which depends on `baz`. Alice updates `baz`, propagating to `bar` and `foo`, while Bob updates `bar` (to something that still depends on `foo`), propagating to `baz`. The merged result will have Alice's update to `foo` incorporated into Bob's updated `bar`, and both updates will propagate to `baz`. Original branch: -```unison + +``` unison foo : Text foo = "old foo" ++ " - " ++ bar @@ -228,7 +243,8 @@ project/main> display foo ``` Alice's updates: -```unison + +``` unison baz : Text baz = "alices baz" ``` @@ -240,7 +256,8 @@ project/alice> display foo ``` Bob's updates: -```unison + +``` unison bar : Text bar = "bobs bar" ++ " - " ++ baz ``` @@ -252,6 +269,7 @@ project/bob> display foo ``` Merge result: + ```ucm project/alice> merge /bob @@ -282,18 +300,21 @@ project/alice> display foo We don't currently consider "update + delete" a conflict like Git does. In this situation, the delete is just ignored, allowing the update to proceed. Original branch: -```unison + +``` unison foo : Text foo = "old foo" ``` Alice's updates: -```unison + +``` unison foo : Text foo = "alices foo" ``` Bob's changes: + ```ucm project/bob> delete.term foo @@ -301,6 +322,7 @@ project/bob> delete.term foo ``` Merge result: + ```ucm project/alice> merge /bob @@ -319,7 +341,8 @@ In a future version, we'd like to give the user a warning at least. Library dependencies don't cause merge conflicts, the library dependencies are just unioned together. If two library dependencies have the same name but different namespace hashes, then the merge algorithm makes up two fresh names. Alice's adds: -```unison + +``` unison lib.alice.foo : Nat lib.alice.foo = 17 @@ -331,7 +354,8 @@ lib.bothDifferent.baz = 19 ``` Bob's adds: -```unison + +``` unison lib.bob.foo : Nat lib.bob.foo = 20 @@ -343,6 +367,7 @@ lib.bothDifferent.baz = 21 ``` Merge result: + ```ucm project/alice> merge bob @@ -392,7 +417,7 @@ project/alice> merge /bob project/alice was already up-to-date with project/bob. ``` -## No-op merge (Bob < Alice) +## No-op merge (Bob \< Alice) If Bob is behind Alice, then merging Bob into Alice looks like this. @@ -413,7 +438,8 @@ project/main> branch bob ``` Alice's addition: -```unison + +``` unison foo : Text foo = "foo" ``` @@ -432,7 +458,7 @@ project/alice> merge /bob project/alice was already up-to-date with project/bob. ``` -## Fast-forward merge (Bob > Alice) +## Fast-forward merge (Bob \> Alice) If Bob is ahead of Alice, then merging Bob into Alice looks like this. @@ -453,7 +479,8 @@ project/main> branch bob ``` Bob's addition: -```unison + +``` unison foo : Text foo = "foo" ``` @@ -496,12 +523,14 @@ This can cause merge failures due to out-of-scope identifiers, and the user may In this example, Alice deletes `foo`, while Bob adds a new dependent of `foo`. Original branch: -```unison + +``` unison foo : Text foo = "foo" ``` Alice's delete: + ```ucm project/alice> delete.term foo @@ -509,7 +538,8 @@ project/alice> delete.term foo ``` Bob's new code that depends on `foo`: -```unison + +``` unison bar : Text bar = foo ++ " - " ++ foo ``` @@ -540,13 +570,12 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u bar : Text bar = use Text ++ foo ++ " - " ++ foo - ``` ## Merge failure: type error @@ -556,19 +585,22 @@ It may be Alice's and Bob's changes merge together cleanly in the sense that the In this example, Alice updates a `Text` to a `Nat`, while Bob adds a new dependent of the `Text`. Upon merging, propagating Alice's update to Bob's dependent causes a typechecking failure. Original branch: -```unison + +``` unison foo : Text foo = "foo" ``` Alice's update: -```unison + +``` unison foo : Nat foo = 100 ``` Bob's new definition: -```unison + +``` unison bar : Text bar = foo ++ " - " ++ foo ``` @@ -593,13 +625,12 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u bar : Text bar = use Text ++ foo ++ " - " ++ foo - ``` ## Merge failure: simple term conflict @@ -608,7 +639,8 @@ Alice and Bob may disagree about the definition of a term. In this case, the con are presented to the user to resolve. Original branch: -```unison + +``` unison foo : Text foo = "old foo" @@ -617,7 +649,8 @@ bar = "old bar" ``` Alice's changes: -```unison + +``` unison foo : Text foo = "alices foo" @@ -630,7 +663,7 @@ qux = "alices qux depends on alices foo" ++ foo Bob's changes: -```unison +``` unison foo : Text foo = "bobs foo" @@ -658,7 +691,7 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice foo : Text foo = "alices foo" @@ -675,7 +708,6 @@ qux = use Text ++ "alices qux depends on alices foo" ++ foo - ``` ```ucm @@ -693,17 +725,20 @@ project/merge-bob-into-alice> view bar baz Ditto for types; if the hashes don't match, it's a conflict. In this example, Alice and Bob do different things to the same constructor. However, any explicit changes to the same type will result in a conflict, including changes that could concievably be merged (e.g. Alice and Bob both add a new constructor, or edit different constructors). Original branch: -```unison + +``` unison unique type Foo = MkFoo Nat ``` Alice's changes: -```unison + +``` unison unique type Foo = MkFoo Nat Nat ``` Bob's changes: -```unison + +``` unison unique type Foo = MkFoo Nat Text ``` @@ -727,14 +762,13 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice type Foo = MkFoo Nat Nat -- project/bob type Foo = MkFoo Nat Text - ``` ## Merge failure: type-update + constructor-rename conflict @@ -742,17 +776,20 @@ type Foo = MkFoo Nat Text We model the renaming of a type's constructor as an update, so if Alice updates a type and Bob renames one of its constructors (even without changing its structure), we consider it a conflict. Original branch: -```unison + +``` unison unique type Foo = Baz Nat | Qux Text ``` Alice's changes `Baz Nat` to `Baz Nat Nat` -```unison + +``` unison unique type Foo = Baz Nat Nat | Qux Text ``` Bob's renames `Qux` to `BobQux`: -```unison + +``` unison unique type Foo = Baz Nat | BobQux Text ``` @@ -776,14 +813,13 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice type Foo = Baz Nat Nat | Qux Text -- project/bob type Foo = Baz Nat | BobQux Text - ``` ## Merge failure: constructor-rename conflict @@ -791,11 +827,13 @@ type Foo = Baz Nat | BobQux Text Here is another example demonstrating that constructor renames are modeled as updates. Original branch: -```unison + +``` unison unique type Foo = Baz Nat | Qux Text ``` Alice's rename: + ```ucm project/alice> move.term Foo.Baz Foo.Alice @@ -803,6 +841,7 @@ project/alice> move.term Foo.Baz Foo.Alice ``` Bob's rename: + ```ucm project/bob> move.term Foo.Qux Foo.Bob @@ -829,14 +868,13 @@ project/alice> merge bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice type Foo = Qux Text | Alice Nat -- project/bob type Foo = Bob Text | Baz Nat - ``` ## Merge failure: non-constructor/constructor conflict @@ -844,13 +882,15 @@ type Foo = Bob Text | Baz Nat A constructor on one side can conflict with a regular term definition on the other. Alice's additions: -```unison + +``` unison my.cool.thing : Nat my.cool.thing = 17 ``` Bob's additions: -```unison + +``` unison unique ability my.cool where thing : Nat -> Nat ``` @@ -875,7 +915,7 @@ project/alice> merge bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice my.cool.thing : Nat my.cool.thing = 17 @@ -883,7 +923,6 @@ my.cool.thing = 17 -- project/bob ability my.cool where thing : Nat ->{cool} Nat - ``` ## Merge failure: type/type conflict with term/constructor conflict @@ -891,28 +930,32 @@ ability my.cool where thing : Nat ->{cool} Nat Here's a subtle situation where a new type is added on each side of the merge, and an existing term is replaced with a constructor of one of the types. Original branch: -```unison + +``` unison Foo.Bar : Nat Foo.Bar = 17 ``` Alice adds this type `Foo` with constructor `Foo.Alice`: -```unison + +``` unison unique type Foo = Alice Nat ``` Bob adds the type `Foo` with constructor `Foo.Bar`, replacing the original `Foo.Bar` term: + ```ucm project/bob> delete.term Foo.Bar Done. ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` These won't cleanly merge. + ```ucm project/alice> merge bob @@ -933,7 +976,7 @@ project/alice> merge bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice Foo.Bar : Nat Foo.Bar = 17 @@ -944,14 +987,13 @@ type Foo = Alice Nat -- project/bob type Foo = Bar Nat Nat - ``` Here's a more involved example that demonstrates the same idea. In the LCA, we have a type with two constructors, and some term. -```unison +``` unison unique type Foo = Bar.Baz Nat | Bar.Qux Nat Nat @@ -1007,7 +1049,7 @@ project/alice> merge bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice Foo.Bar.Baz : Nat Foo.Bar.Baz = 100 @@ -1019,7 +1061,6 @@ Foo.Bar.Hello = 18 -- project/bob type Foo.Bar = Baz Nat | Hello Nat Nat - ``` ## Merge algorithm quirk: add/add unique types @@ -1031,7 +1072,8 @@ which is a parse error. We will resolve this situation automatically in a future version. Alice's additions: -```unison + +``` unison unique type Foo = Bar alice : Foo -> Nat @@ -1039,7 +1081,8 @@ alice _ = 18 ``` Bob's additions: -```unison + +``` unison unique type Foo = Bar bob : Foo -> Nat @@ -1066,7 +1109,7 @@ project/alice> merge bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice type Foo = Bar @@ -1084,7 +1127,6 @@ alice _ = 18 bob : Foo -> Nat bob _ = 19 - ``` ## `merge.commit` example (success) @@ -1093,20 +1135,22 @@ After merge conflicts are resolved, you can use `merge.commit` rather than `swit "commit" your changes. Original branch: -```unison + +``` unison foo : Text foo = "old foo" ``` Alice's changes: -```unison + +``` unison foo : Text foo = "alices foo" ``` Bob's changes: -```unison +``` unison foo : Text foo = "bobs foo" ``` @@ -1133,7 +1177,7 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice foo : Text foo = "alices foo" @@ -1142,12 +1186,11 @@ foo = "alices foo" foo : Text foo = "bobs foo" - ``` Resolve conflicts and commit: -```unison +``` unison foo : Text foo = "alice and bobs foo" ``` @@ -1219,7 +1262,8 @@ There are a number of conditions under which we can't perform a merge, and the u If `foo` and `bar` are aliases in the nearest common ancestor, but not in Alice's branch, then we don't know whether to update Bob's dependents to Alice's `foo` or Alice's `bar` (and vice-versa). Original branch: -```unison + +``` unison foo : Nat foo = 100 @@ -1228,7 +1272,8 @@ bar = 100 ``` Alice's updates: -```unison + +``` unison foo : Nat foo = 200 @@ -1237,7 +1282,8 @@ bar = 300 ``` Bob's addition: -```unison + +``` unison baz : Text baz = "baz" ``` @@ -1271,6 +1317,7 @@ conflict involving a builtin, we can't perform a merge. One way to fix this in the future would be to introduce a syntax for defining aliases in the scratch file. Alice's branch: + ```ucm project/alice> alias.type lib.builtins.Nat MyNat @@ -1278,7 +1325,8 @@ project/alice> alias.type lib.builtins.Nat MyNat ``` Bob's branch: -```unison + +``` unison unique type MyNat = MyNat Nat ``` @@ -1301,7 +1349,8 @@ project/alice> merge /bob Each naming of a decl may not have more than one name for each constructor, within the decl's namespace. Alice's branch: -```unison + +``` unison unique type Foo = Bar ``` @@ -1312,7 +1361,8 @@ project/alice> alias.term Foo.Bar Foo.some.other.Alias ``` Bob's branch: -```unison + +``` unison bob : Nat bob = 100 ``` @@ -1337,7 +1387,8 @@ project/alice> merge /bob Each naming of a decl must have a name for each constructor, within the decl's namespace. Alice's branch: -```unison + +``` unison unique type Foo = Bar ``` @@ -1348,7 +1399,8 @@ project/alice> delete.term Foo.Bar ``` Bob's branch: -```unison + +``` unison bob : Nat bob = 100 ``` @@ -1371,7 +1423,8 @@ project/alice> merge /bob A decl cannot be aliased within the namespace of another of its aliased. Alice's branch: -```unison + +``` unison structural type A = B Nat | C Nat Nat structural type A.inner.X = Y Nat | Z Nat Nat ``` @@ -1387,7 +1440,8 @@ project/alice> names A ``` Bob's branch: -```unison + +``` unison bob : Nat bob = 100 ``` @@ -1406,6 +1460,7 @@ project/alice> merge /bob Constructors may only exist within the corresponding decl's namespace. Alice's branch: + ```ucm project/alice> add @@ -1419,6 +1474,7 @@ project/alice> alias.term Foo.Bar AliasOutsideFooNamespace ``` Bob's branch: + ```ucm project/bob> add @@ -1445,13 +1501,15 @@ project/alice> merge bob By convention, `lib` can only namespaces; each of these represents a library dependencies. Individual terms and types are not allowed at the top level of `lib`. Alice's branch: -```unison + +``` unison lib.foo : Nat lib.foo = 1 ``` Bob's branch: -```unison + +``` unison bob : Nat bob = 100 ``` @@ -1470,14 +1528,14 @@ project/alice> merge /bob ``` ## LCA precondition violations -The LCA is not subject to most precondition violations, which is good, because the user can't easily manipulate it! +The LCA is not subject to most precondition violations, which is good, because the user can't easily manipulate it\! Here's an example. We'll delete a constructor name from the LCA and still be able to merge Alice and Bob's stuff together. LCA: -```unison +``` unison structural type Foo = Bar Nat | Baz Nat Nat ``` @@ -1525,7 +1583,7 @@ project/alice> delete.term Foo.Bar Done. ``` -```unison +``` unison alice : Nat alice = 100 ``` @@ -1570,7 +1628,7 @@ project/bob> delete.term Foo.Bar Done. ``` -```unison +``` unison bob : Nat bob = 101 ``` @@ -1608,8 +1666,7 @@ project/alice> merge /bob ### Delete one alias and update the other - -```unison +``` unison foo = 17 bar = 17 ``` @@ -1648,7 +1705,7 @@ project/alice> delete.term bar Done. ``` -```unison +``` unison foo = 18 ``` @@ -1682,7 +1739,7 @@ project/main> branch bob `switch /main` then `merge /bob`. ``` -```unison +``` unison bob = 101 ``` @@ -1715,8 +1772,7 @@ project/alice> merge /bob ``` ### Delete a constructor - -```unison +``` unison type Foo = Bar | Baz ``` @@ -1748,7 +1804,7 @@ project/main> branch topic `switch /main` then `merge /topic`. ``` -```unison +``` unison boop = "boop" ``` @@ -1773,7 +1829,7 @@ project/topic> add boop : Text ``` -```unison +``` unison type Foo = Bar ``` @@ -1814,10 +1870,9 @@ project/main> view Foo This test demonstrates a bug. - In the LCA, we have `foo` with dependent `bar`, and `baz`. -```unison +``` unison foo : Nat foo = 17 @@ -1862,7 +1917,7 @@ project/alice> branch bob ``` On Bob, we update `baz` to "bob". -```unison +``` unison baz : Text baz = "bob" ``` @@ -1892,7 +1947,7 @@ project/bob> update ``` On Alice, we update `baz` to "alice" (conflict), but also update `foo` (unconflicted), which propagates to `bar`. -```unison +``` unison foo : Nat foo = 18 @@ -1951,7 +2006,7 @@ project/alice> merge /bob to delete the temporary branch and switch back to alice. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u -- project/alice baz : Text baz = "alice" @@ -1968,7 +2023,6 @@ bar = use Nat + foo + foo - ``` But `bar` was put into the scratch file instead. @@ -1980,7 +2034,7 @@ history. Let's make three identical namespaces with different histories: -```unison +``` unison a = 1 ``` @@ -2005,7 +2059,7 @@ project/alice> add a : ##Nat ``` -```unison +``` unison b = 2 ``` @@ -2030,7 +2084,7 @@ project/alice> add b : ##Nat ``` -```unison +``` unison b = 2 ``` @@ -2050,7 +2104,7 @@ project/bob> add b : ##Nat ``` -```unison +``` unison a = 1 ``` @@ -2075,7 +2129,7 @@ project/bob> add a : ##Nat ``` -```unison +``` unison a = 1 b = 2 ``` @@ -2126,7 +2180,7 @@ project/carol> history This test demonstrates a change in syntactic hashing that fixed a bug due to auto-generated variable names for ignored results. -```unison +``` unison ignore : a -> () ignore _ = () @@ -2171,7 +2225,7 @@ scratch/alice> branch bob `switch /alice` then `merge /bob`. ``` -```unison +``` unison bar : Nat bar = ignore "hi" @@ -2204,7 +2258,7 @@ scratch/bob> update Previously, this update to `foo` would also cause a "real update" on `bar`, its dependent. Now it doesn't, so the merge will succeed. -```unison +``` unison foo : Nat foo = 19 ``` diff --git a/unison-src/transcripts/move-all.output.md b/unison-src/transcripts/move-all.output.md index d7a7bec859..cd68b319c3 100644 --- a/unison-src/transcripts/move-all.output.md +++ b/unison-src/transcripts/move-all.output.md @@ -4,7 +4,7 @@ Create a term, type, and namespace with history -```unison +``` unison Foo = 2 unique type Foo = Foo Foo.termInA = 1 @@ -38,7 +38,7 @@ scratch/main> add Foo.termInA : Nat ``` -```unison +``` unison Foo.termInA = 2 unique type Foo.T = T1 | T2 ``` @@ -109,7 +109,7 @@ scratch/main> history Bar ``` ## Happy Path - Just term -```unison +``` unison bonk = 5 ``` @@ -149,7 +149,7 @@ z/main> ls ``` ## Happy Path - Just namespace -```unison +``` unison bonk.zonk = 5 ``` diff --git a/unison-src/transcripts/move-namespace.output.md b/unison-src/transcripts/move-namespace.output.md index 257365dbdc..57b010c0d7 100644 --- a/unison-src/transcripts/move-namespace.output.md +++ b/unison-src/transcripts/move-namespace.output.md @@ -1,11 +1,10 @@ # Tests for `move.namespace` - ## Moving the Root I should be able to move the root into a sub-namespace -```unison +``` unison foo = 1 ``` @@ -57,7 +56,7 @@ foo = 1 □ 1. #08a6hgi6s4 (start of history) ``` -I should be able to move a sub namespace _over_ the root. +I should be able to move a sub namespace *over* the root. ```ucm -- Should request confirmation @@ -101,7 +100,7 @@ I should be able to move a sub namespace _over_ the root. Create a namespace and add some history to it -```unison +``` unison a.termInA = 1 unique type a.T = T ``` @@ -129,7 +128,7 @@ scratch/happy> add a.termInA : Nat ``` -```unison +``` unison a.termInA = 2 unique type a.T = T1 | T2 ``` @@ -193,7 +192,7 @@ scratch/happy> history b Create some namespaces and add some history to them -```unison +``` unison a.termInA = 1 b.termInB = 10 ``` @@ -221,7 +220,7 @@ scratch/history> add b.termInB : Nat ``` -```unison +``` unison a.termInA = 2 b.termInB = 11 ``` @@ -287,7 +286,7 @@ scratch/history> history a Create some namespace and add some history to them -```unison +``` unison a.termInA = 1 b.termInB = 10 ``` @@ -315,7 +314,7 @@ scratch/existing> add b.termInB : Nat ``` -```unison +``` unison a.termInA = 2 b.termInB = 11 ``` diff --git a/unison-src/transcripts/name-selection.output.md b/unison-src/transcripts/name-selection.output.md index a9b3d9679f..0df0ba3a0a 100644 --- a/unison-src/transcripts/name-selection.output.md +++ b/unison-src/transcripts/name-selection.output.md @@ -1,10 +1,10 @@ This transcript shows how the pretty-printer picks names for a hash when multiple are available. The algorithm is: -1. Names that are "name-only" come before names that are hash qualified. So `List.map` comes before `List.map#2384a` and also `aaaa#xyz`. -2. Shorter names (in terms of segment count) come before longer ones, for instance `base.List.map` comes before `somelibrary.external.base.List.map`. -3. Otherwise if there are multiple names with a minimal number of segments, compare the names alphabetically. +1. Names that are "name-only" come before names that are hash qualified. So `List.map` comes before `List.map#2384a` and also `aaaa#xyz`. +2. Shorter names (in terms of segment count) come before longer ones, for instance `base.List.map` comes before `somelibrary.external.base.List.map`. +3. Otherwise if there are multiple names with a minimal number of segments, compare the names alphabetically. -```unison +``` unison a.a = a.b + 1 a.b = 0 + 1 a.aaa.but.more.segments = 0 + 1 @@ -31,7 +31,7 @@ Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment ``` Next let's introduce a conflicting symbol and show that its hash qualified name isn't used when it has an unconflicted name: -```unison +``` unison a2.a = a2.b + 1 a2.b = 0 + 1 a2.aaa.but.more.segments = 0 + 1 @@ -116,7 +116,7 @@ The original `a2` namespace has an unconflicted definition for `c` and `d`, but ``` ## Name biasing -```unison +``` unison deeply.nested.term = a + 1 @@ -162,7 +162,7 @@ a = 10 ``` Add another term with `num` suffix to force longer suffixification of `deeply.nested.num` -```unison +``` unison other.num = 20 ``` diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index 8138b5434d..13d62fd7bf 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -2,7 +2,7 @@ Example uses of the `names` command and output -```unison +``` unison -- Some names with the same value some.place.x = 1 some.otherplace.y = 1 @@ -78,7 +78,6 @@ somewhere.y = 2 ``` `names.global` searches from the root, and absolutely qualifies results - ```ucm -- We can search by suffix and find all definitions in the codebase named 'x', and each of their aliases respectively. .some> names.global x diff --git a/unison-src/transcripts/namespace-dependencies.output.md b/unison-src/transcripts/namespace-dependencies.output.md index 0e7d298262..ae41b95183 100644 --- a/unison-src/transcripts/namespace-dependencies.output.md +++ b/unison-src/transcripts/namespace-dependencies.output.md @@ -1,6 +1,6 @@ # namespace.dependencies command -```unison +``` unison const a b = a external.mynat = 1 mynamespace.dependsOnText = const external.mynat 10 diff --git a/unison-src/transcripts/numbered-args.output.md b/unison-src/transcripts/numbered-args.output.md index 883a319de6..ba6016b962 100644 --- a/unison-src/transcripts/numbered-args.output.md +++ b/unison-src/transcripts/numbered-args.output.md @@ -2,7 +2,7 @@ First lets add some contents to our codebase. -```unison +``` unison foo = "foo" bar = "bar" baz = "baz" diff --git a/unison-src/transcripts/old-fold-right.output.md b/unison-src/transcripts/old-fold-right.output.md index 4f210513b9..f054ba9596 100644 --- a/unison-src/transcripts/old-fold-right.output.md +++ b/unison-src/transcripts/old-fold-right.output.md @@ -1,4 +1,4 @@ -```unison +``` unison oldRight: (b ->{e} a ->{e} b) -> [a] ->{e} [b] oldRight f la = bug "out" diff --git a/unison-src/transcripts/pattern-match-coverage.output.md b/unison-src/transcripts/pattern-match-coverage.output.md index b8d30cb252..ea249e9f72 100644 --- a/unison-src/transcripts/pattern-match-coverage.output.md +++ b/unison-src/transcripts/pattern-match-coverage.output.md @@ -1,6 +1,8 @@ # Basics + ## non-exhaustive patterns -```unison + +``` unison unique type T = A | B | C test : T -> () @@ -23,7 +25,7 @@ test = cases * C ``` -```unison +``` unison unique type T = A | B test : (T, Optional T) -> () @@ -51,7 +53,8 @@ test = cases ``` ## redundant patterns -```unison + +``` unison unique type T = A | B | C test : T -> () @@ -71,7 +74,7 @@ test = cases ``` -```unison +``` unison unique type T = A | B test : (T, Optional T) -> () @@ -95,7 +98,8 @@ test = cases # Uninhabited patterns match is complete without covering uninhabited patterns -```unison + +``` unison unique type V = test : Optional (Optional V) -> () @@ -119,7 +123,8 @@ test = cases ``` uninhabited patterns are reported as redundant -```unison + +``` unison unique type V = test0 : V -> () @@ -136,7 +141,7 @@ test0 = cases ``` -```unison +``` unison unique type V = test : Optional (Optional V) -> () @@ -158,7 +163,8 @@ test = cases # Guards ## Incomplete patterns due to guards should be reported -```unison + +``` unison test : () -> () test = cases () | false -> () @@ -177,7 +183,7 @@ test = cases * () ``` -```unison +``` unison test : Optional Nat -> Nat test = cases None -> 0 @@ -201,7 +207,8 @@ test = cases ``` ## Complete patterns with guards should be accepted -```unison + +``` unison test : Optional Nat -> Nat test = cases None -> 0 @@ -227,7 +234,8 @@ test = cases Uncovered patterns are only instantiated as deeply as necessary to distinguish them from existing patterns. -```unison + +``` unison unique type T = A | B | C test : Optional (Optional T) -> () @@ -250,7 +258,7 @@ test = cases * Some (Some _) ``` -```unison +``` unison unique type T = A | B | C test : Optional (Optional T) -> () @@ -282,7 +290,8 @@ test = cases ## Non-exhaustive Nat -```unison + +``` unison test : Nat -> () test = cases 0 -> () @@ -302,7 +311,8 @@ test = cases ``` Boolean -```unison + +``` unison test : Boolean -> () test = cases true -> () @@ -324,7 +334,8 @@ test = cases ## Exhaustive Nat -```unison + +``` unison test : Nat -> () test = cases 0 -> () @@ -345,7 +356,8 @@ test = cases ``` Boolean -```unison + +``` unison test : Boolean -> () test = cases true -> () @@ -368,7 +380,8 @@ test = cases # Redundant Nat -```unison + +``` unison test : Nat -> () test = cases 0 -> () @@ -386,7 +399,8 @@ test = cases ``` Boolean -```unison + +``` unison test : Boolean -> () test = cases true -> () @@ -406,7 +420,8 @@ test = cases # Sequences ## Exhaustive -```unison + +``` unison test : [()] -> () test = cases [] -> () @@ -427,7 +442,8 @@ test = cases ``` ## Non-exhaustive -```unison + +``` unison test : [()] -> () test = cases [] -> () @@ -446,7 +462,7 @@ test = cases * (() +: _) ``` -```unison +``` unison test : [()] -> () test = cases x +: xs -> () @@ -465,7 +481,7 @@ test = cases * [] ``` -```unison +``` unison test : [()] -> () test = cases xs :+ x -> () @@ -484,7 +500,7 @@ test = cases * [] ``` -```unison +``` unison test : [()] -> () test = cases x0 +: (x1 +: xs) -> () @@ -505,7 +521,7 @@ test = cases * (() +: []) ``` -```unison +``` unison test : [()] -> () test = cases [] -> () @@ -529,7 +545,8 @@ test = cases ## Uninhabited `Cons` is not expected since `V` is uninhabited -```unison + +``` unison unique type V = test : [V] -> () @@ -559,7 +576,8 @@ final element is `false`, while the fourth pattern matches when the first element is `true`. However, the only possible list length at the third or fourth clause is 1, so the first and final element must be equal. Thus, the pattern match is exhaustive. -```unison + +``` unison test : [Boolean] -> () test = cases [a, b] ++ xs -> () @@ -582,7 +600,8 @@ test = cases ``` This is the same idea as above but shows that fourth match is redundant. -```unison + +``` unison test : [Boolean] -> () test = cases [a, b] ++ xs -> () @@ -607,7 +626,8 @@ first and third element are true. The third matches lists of length 4 or greater where the final 4 elements are `true, false, true, false`. The list must be exactly of length 4 to arrive at the second or third clause, so the third pattern is redundant. -```unison + +``` unison test : [Boolean] -> () test = cases [a, b, c, d, f] ++ xs -> () @@ -627,7 +647,7 @@ test = cases ``` # bugfix: Sufficient data decl map -```unison +``` unison unique type T = A unit2t : Unit -> T @@ -665,7 +685,8 @@ transitive type dependencies of references that appear in the expression. This test ensures that we have fetched the `T` type although there is no data decl reference to `T` in `witht`. -```unison + +``` unison witht : Unit witht = match unit2t () with x -> () @@ -684,7 +705,7 @@ witht = match unit2t () with witht : () ``` -```unison +``` unison unique type V = evil : Unit -> V @@ -714,7 +735,7 @@ scratch/main> add evil : 'V ``` -```unison +``` unison withV : Unit withV = match evil () with x -> () @@ -729,7 +750,7 @@ withV = match evil () with ``` -```unison +``` unison unique type SomeType = A ``` @@ -754,7 +775,7 @@ scratch/main> add type SomeType ``` -```unison +``` unison unique type R = R SomeType get x = match x with @@ -775,7 +796,7 @@ get x = match x with get : R -> SomeType ``` -```unison +``` unison unique type R = { someType : SomeType } ``` @@ -799,7 +820,7 @@ unique type R = { someType : SomeType } ## Exhaustive ability handlers are accepted -```unison +``` unison structural ability Abort where abort : {Abort} a @@ -824,7 +845,7 @@ result f = handle !f with cases result : '{e, Abort} a ->{e} a ``` -```unison +``` unison structural ability Abort where abort : {Abort} a @@ -856,7 +877,7 @@ result f = handle !f with cases type T ``` -```unison +``` unison structural ability Abort where abort : {Abort} a @@ -882,7 +903,7 @@ result f = result : '{e, Abort} V ->{e} V ``` -```unison +``` unison structural ability Abort where abort : {Abort} a @@ -915,7 +936,7 @@ handleMulti c = ``` ## Non-exhaustive ability handlers are rejected -```unison +``` unison structural ability Abort where abort : {Abort} a abortWithMessage : Text -> {Abort} a @@ -941,7 +962,7 @@ result f = handle !f with cases * { abortWithMessage _ -> _ } ``` -```unison +``` unison structural ability Abort where abort : {Abort} a @@ -967,7 +988,7 @@ result f = handle !f with cases * { B } ``` -```unison +``` unison unique ability Give a where give : a -> {Give a} Unit @@ -993,7 +1014,7 @@ result f = handle !f with cases * { give B -> _ } ``` -```unison +``` unison structural ability Abort where abort : {Abort} a @@ -1025,7 +1046,7 @@ handleMulti c = ``` ## Redundant handler cases are rejected -```unison +``` unison unique ability Give a where give : a -> {Give a} Unit @@ -1049,7 +1070,7 @@ result f = handle !f with cases ``` ## Exhaustive ability reinterpretations are accepted -```unison +``` unison structural ability Abort where abort : {Abort} a abortWithMessage : Text -> {Abort} a @@ -1076,7 +1097,7 @@ result f = handle !f with cases result : '{e, Abort} a ->{e, Abort} a ``` -```unison +``` unison structural ability Abort a where abort : {Abort a} r abortWithMessage : a -> {Abort a} r @@ -1106,7 +1127,7 @@ result f = ``` ## Non-exhaustive ability reinterpretations are rejected -```unison +``` unison structural ability Abort where abort : {Abort} a abortWithMessage : Text -> {Abort} a @@ -1145,7 +1166,7 @@ they are all uninhabited. The messages here aren't the best, but I don't think uninhabited abilities will come up and get handlers written for them often. -```unison +``` unison unique ability Give a where give : a -> {Give a} Unit give2 : a -> {Give a} Unit @@ -1173,7 +1194,7 @@ result f = * { give2 _ -> _ } ``` -```unison +``` unison unique ability Give a where give : a -> {Give a} Unit give2 : a -> {Give a} Unit @@ -1201,7 +1222,7 @@ result f = result : '{e, Give V} r ->{e} r ``` -```unison +``` unison unique ability Give a where give : a -> {Give a} Unit give2 : a -> {Give a} Unit @@ -1229,7 +1250,7 @@ result f = result : '{e, Give V} r ->{e} r ``` -```unison +``` unison unique ability Give a where give : a -> {Give a} Unit give2 : a -> {Give a} Unit @@ -1253,7 +1274,7 @@ result f = ``` -```unison +``` unison unique ability GiveA a where giveA : a -> {GiveA a} Unit giveA2 : a -> {GiveA a} Unit @@ -1283,7 +1304,7 @@ result f = ``` -```unison +``` unison unique ability GiveA a where giveA : a -> {GiveA a} Unit giveA2 : a -> {GiveA a} Unit diff --git a/unison-src/transcripts/pattern-pretty-print-2345.output.md b/unison-src/transcripts/pattern-pretty-print-2345.output.md index 6157aa8e7f..15ebf87401 100644 --- a/unison-src/transcripts/pattern-pretty-print-2345.output.md +++ b/unison-src/transcripts/pattern-pretty-print-2345.output.md @@ -1,7 +1,6 @@ Regression test for https://github.com/unisonweb/unison/pull/2377 - -```unison +``` unison structural ability Ab where a: Nat -> () diff --git a/unison-src/transcripts/patternMatchTls.output.md b/unison-src/transcripts/patternMatchTls.output.md index 65aa5153d6..7d207ef375 100644 --- a/unison-src/transcripts/patternMatchTls.output.md +++ b/unison-src/transcripts/patternMatchTls.output.md @@ -1,9 +1,7 @@ We had bugs in the calling conventions for both send and terminate which would cause pattern matching on the resulting (Right ()) would cause a runtime error. - - -```unison +``` unison use builtin.io2.Tls newClient send handshake terminate frank: '{IO} () diff --git a/unison-src/transcripts/patterns.output.md b/unison-src/transcripts/patterns.output.md index 7db153f99b..054c9224ea 100644 --- a/unison-src/transcripts/patterns.output.md +++ b/unison-src/transcripts/patterns.output.md @@ -1,6 +1,6 @@ Some tests of pattern behavior. -```unison +``` unison p1 = join [literal "blue", literal "frog"] > Pattern.run (many p1) "bluefrogbluegoat" diff --git a/unison-src/transcripts/propagate.output.md b/unison-src/transcripts/propagate.output.md index 5e16983bc3..036681f1b6 100644 --- a/unison-src/transcripts/propagate.output.md +++ b/unison-src/transcripts/propagate.output.md @@ -2,7 +2,7 @@ We introduce a type `Foo` with a function dependent `fooToInt`. -```unison +``` unison unique type Foo = Foo fooToInt : Foo -> Int @@ -54,7 +54,7 @@ scratch/main> view fooToInt ``` Then if we change the type `Foo`... -```unison +``` unison unique type Foo = Foo | Bar ``` @@ -96,7 +96,7 @@ scratch/main> view fooToInt We make a term that has a dependency on another term and also a non-redundant user-provided type signature. -```unison +``` unison preserve.someTerm : Optional foo -> Optional foo preserve.someTerm x = x @@ -131,7 +131,7 @@ scratch/main> add ``` Let's now edit the dependency: -```unison +``` unison preserve.someTerm : Optional x -> Optional x preserve.someTerm _ = None ``` @@ -189,7 +189,7 @@ Cleaning up a bit... ``` Now, we make two terms, where one depends on the other. -```unison +``` unison one.someTerm : Optional foo -> Optional foo one.someTerm x = x @@ -228,7 +228,7 @@ We'll make two copies of this namespace. ``` Now let's edit one of the terms... -```unison +``` unison someTerm : Optional x -> Optional x someTerm _ = None ``` diff --git a/unison-src/transcripts/records.output.md b/unison-src/transcripts/records.output.md index 315bec4bb9..8d2be7417c 100644 --- a/unison-src/transcripts/records.output.md +++ b/unison-src/transcripts/records.output.md @@ -2,7 +2,7 @@ Ensure that Records keep their syntax after being added to the codebase ## Record with 1 field -```unison +``` unison unique type Record1 = { a : Text } ``` @@ -14,7 +14,7 @@ scratch/main> view Record1 ``` ## Record with 2 fields -```unison +``` unison unique type Record2 = { a : Text, b : Int } ``` @@ -26,7 +26,7 @@ scratch/main> view Record2 ``` ## Record with 3 fields -```unison +``` unison unique type Record3 = { a : Text, b : Int, c : Nat } ``` @@ -38,7 +38,7 @@ scratch/main> view Record3 ``` ## Record with many fields -```unison +``` unison unique type Record4 = { a : Text , b : Int @@ -65,7 +65,7 @@ scratch/main> view Record4 ``` ## Record with many many fields -```unison +``` unison unique type Record5 = { zero : Nat, one : [Nat], @@ -122,13 +122,13 @@ scratch/main> view Record5 This record type has two fields whose types are user-defined (`Record4` and `UserType`). -```unison +``` unison unique type UserType = UserType Nat unique type RecordWithUserType = { a : Text, b : Record4, c : UserType } ``` -If you `view` or `edit` it, it _should_ be treated as a record type, but it does not (which is a bug) +If you `view` or `edit` it, it *should* be treated as a record type, but it does not (which is a bug) ```ucm scratch/main> view RecordWithUserType @@ -141,7 +141,7 @@ scratch/main> view RecordWithUserType Trailing commas are allowed. -```unison +``` unison unique type Record5 = { a : Text, b : Int, diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index 96e68114ff..a608b04a9a 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -1,7 +1,7 @@ First we make two changes to the codebase, so that there's more than one line for the `reflog` command to display: -```unison +``` unison x = 1 ``` @@ -26,7 +26,7 @@ x = 1 x : Nat ``` -```unison +``` unison y = 2 ``` @@ -81,6 +81,7 @@ y = 2 ``` If we `reset-root` to its previous value, `y` disappears. + ```ucm .> reset-root 2 diff --git a/unison-src/transcripts/release-draft-command.output.md b/unison-src/transcripts/release-draft-command.output.md index 0eb667e870..58077a37e0 100644 --- a/unison-src/transcripts/release-draft-command.output.md +++ b/unison-src/transcripts/release-draft-command.output.md @@ -2,7 +2,7 @@ The `release.draft` command drafts a release from the current branch. Some setup: -```unison +``` unison someterm = 18 ``` diff --git a/unison-src/transcripts/reset.output.md b/unison-src/transcripts/reset.output.md index 9be437365f..1858250abc 100644 --- a/unison-src/transcripts/reset.output.md +++ b/unison-src/transcripts/reset.output.md @@ -1,5 +1,6 @@ # reset loose code -```unison + +``` unison a = 5 ``` @@ -50,7 +51,7 @@ scratch/main> history □ 1. #4bigcpnl7t (start of history) ``` -```unison +``` unison foo.a = 5 ``` @@ -108,7 +109,7 @@ foo/main> history ☝️ The namespace is empty. ``` -```unison +``` unison a = 5 ``` @@ -149,7 +150,7 @@ foo/main> history □ 1. #5l94rduvel (start of history) ``` -```unison +``` unison a = 3 ``` @@ -192,7 +193,8 @@ foo/main> history # ambiguous reset ## ambiguous target -```unison + +``` unison main.a = 3 ``` @@ -244,7 +246,7 @@ foo/main> reset 2 main ``` ## ambiguous hash -```unison +``` unison main.a = 3 ``` diff --git a/unison-src/transcripts/resolution-failures.output.md b/unison-src/transcripts/resolution-failures.output.md index bca703a4e5..262f6f744d 100644 --- a/unison-src/transcripts/resolution-failures.output.md +++ b/unison-src/transcripts/resolution-failures.output.md @@ -6,7 +6,7 @@ This transcript tests the errors printed to the user when a name cannot be resol First we define differing types with the same name in different namespaces: -```unison +``` unison unique type one.AmbiguousType = one.AmbiguousType unique type two.AmbiguousType = two.AmbiguousType @@ -48,10 +48,10 @@ It is ambiguous which type from which namespace we mean. We expect the output to: -1. Print all ambiguous usage sites separately -2. Print possible disambiguation suggestions for each unique ambiguity +1. Print all ambiguous usage sites separately +2. Print possible disambiguation suggestions for each unique ambiguity -```unison +``` unison -- We intentionally avoid using a constructor to ensure the constructor doesn't -- affect type resolution. useAmbiguousType : AmbiguousType -> () @@ -96,7 +96,7 @@ separateAmbiguousTypeUsage _ = () Currently, ambiguous terms are caught and handled by type directed name resolution, but expect it to eventually be handled by the above machinery. -```unison +``` unison useAmbiguousTerm = ambiguousTerm ``` diff --git a/unison-src/transcripts/rsa.output.md b/unison-src/transcripts/rsa.output.md index b81a16becc..a5994b24bd 100644 --- a/unison-src/transcripts/rsa.output.md +++ b/unison-src/transcripts/rsa.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison up = 0xs0123456789abcdef down = 0xsfedcba9876543210 diff --git a/unison-src/transcripts/scope-ref.output.md b/unison-src/transcripts/scope-ref.output.md index ea44a79469..1319186623 100644 --- a/unison-src/transcripts/scope-ref.output.md +++ b/unison-src/transcripts/scope-ref.output.md @@ -1,7 +1,6 @@ - A short script to test mutable references with local scope. -```unison +``` unison test = Scope.run 'let r = Scope.ref 0 Ref.write r 1 diff --git a/unison-src/transcripts/suffixes.output.md b/unison-src/transcripts/suffixes.output.md index 411fdebba3..5752f29187 100644 --- a/unison-src/transcripts/suffixes.output.md +++ b/unison-src/transcripts/suffixes.output.md @@ -2,7 +2,7 @@ Any unique name suffix can be used to refer to a definition. For instance: -```unison +``` unison -- No imports needed even though FQN is `builtin.{Int,Nat}` foo.bar.a : Int foo.bar.a = +99 @@ -61,7 +61,7 @@ scratch/main> find : Nat -> [a] -> [a] Suffix-based resolution prefers names that are not in an indirect dependency. -```unison +``` unison cool.abra.cadabra = "my project" lib.distributed.abra.cadabra = "direct dependency 1" lib.distributed.baz.qux = "direct dependency 2" @@ -95,7 +95,7 @@ scratch/main> add lib.distributed.lib.baz.qux : Text ``` -```unison +``` unison > abra.cadabra ``` @@ -117,7 +117,7 @@ scratch/main> add distributed.abra.cadabra : Text ``` -```unison +``` unison > baz.qux ``` @@ -173,7 +173,7 @@ scratch/main> names distributed.lib.baz.qux If a definition is given in a scratch file, its suffixes shadow existing definitions that exist in the codebase with the same suffixes. For example: -```unison +``` unison unique type A = Thing1 Nat | thing2 Nat foo.a = 23 @@ -190,7 +190,7 @@ scratch/main> add foo.a : Nat ``` -```unison +``` unison unique type B = Thing1 Text | thing2 Text | Thing3 Text zoink.a = "hi" diff --git a/unison-src/transcripts/sum-type-update-conflicts.output.md b/unison-src/transcripts/sum-type-update-conflicts.output.md index 493a4d9407..f28ec5dd41 100644 --- a/unison-src/transcripts/sum-type-update-conflicts.output.md +++ b/unison-src/transcripts/sum-type-update-conflicts.output.md @@ -4,7 +4,7 @@ https://github.com/unisonweb/unison/issues/2786 First we add a sum-type to the codebase. -```unison +``` unison structural type X = x ``` @@ -31,10 +31,10 @@ scratch/main> add (also named lib.builtins.Unit) ``` -Now we update the type, changing the name of the constructors, _but_, we simultaneously +Now we update the type, changing the name of the constructors, *but*, we simultaneously add a new top-level term with the same name as the old constructor. -```unison +``` unison structural type X = y | z X.x : Text diff --git a/unison-src/transcripts/switch-command.output.md b/unison-src/transcripts/switch-command.output.md index e84fefd0ab..f00a15723c 100644 --- a/unison-src/transcripts/switch-command.output.md +++ b/unison-src/transcripts/switch-command.output.md @@ -2,7 +2,7 @@ The `switch` command switches to an existing project or branch. Setup stuff. -```unison +``` unison someterm = 18 ``` diff --git a/unison-src/transcripts/tab-completion.output.md b/unison-src/transcripts/tab-completion.output.md index c7730c17d5..86a7b552e3 100644 --- a/unison-src/transcripts/tab-completion.output.md +++ b/unison-src/transcripts/tab-completion.output.md @@ -25,7 +25,7 @@ scratch/main> debug.tab-complete delete. ``` ## Tab complete terms & types -```unison +``` unison subnamespace.someName = 1 subnamespace.someOtherName = 2 subnamespace2.thing = 3 @@ -89,7 +89,7 @@ scratch/main> debug.tab-complete view subnamespace.someOther * subnamespace.someOtherName ``` -```unison +``` unison absolute.term = "absolute" ``` @@ -143,7 +143,7 @@ scratch/main> debug.tab-complete io.test subnamespace. ``` Tab Complete Delete Subcommands -```unison +``` unison unique type Foo = A | B add : a -> a add b = b @@ -202,7 +202,7 @@ myproject/main> debug.tab-complete project.rename my ``` Commands which complete namespaces OR branches should list both -```unison +``` unison mybranchsubnamespace.term = 1 ``` diff --git a/unison-src/transcripts/test-command.output.md b/unison-src/transcripts/test-command.output.md index 4e2d9bafe0..4182b223ce 100644 --- a/unison-src/transcripts/test-command.output.md +++ b/unison-src/transcripts/test-command.output.md @@ -2,7 +2,7 @@ Merge builtins so we get enough names for the testing stuff. The `test` command should run all of the tests in the current directory. -```unison +``` unison test1 : [Result] test1 = [Ok "test1"] @@ -64,7 +64,7 @@ scratch/main> test ``` `test` won't descend into the `lib` namespace, but `test.all` will. -```unison +``` unison lib.dep.testInLib : [Result] lib.dep.testInLib = [Ok "testInLib"] ``` diff --git a/unison-src/transcripts/text-literals.output.md b/unison-src/transcripts/text-literals.output.md index 1889ec8e78..f9d4311f25 100644 --- a/unison-src/transcripts/text-literals.output.md +++ b/unison-src/transcripts/text-literals.output.md @@ -1,7 +1,6 @@ - This transcript shows some syntax for raw text literals. -```unison +``` unison lit1 = """ This is a raw text literal. It can start with 3 or more ", diff --git a/unison-src/transcripts/todo-bug-builtins.output.md b/unison-src/transcripts/todo-bug-builtins.output.md index 0e3bb72ada..104d6bf86f 100644 --- a/unison-src/transcripts/todo-bug-builtins.output.md +++ b/unison-src/transcripts/todo-bug-builtins.output.md @@ -1,7 +1,8 @@ # The `todo` and `bug` builtin `todo` and `bug` have type `a -> b`. They take a message or a value of type `a` and crash during runtime displaying `a` in ucm. -```unison + +``` unison > todo "implement me later" ``` @@ -28,7 +29,7 @@ #qe5e1lcfn8 ``` -```unison +``` unison > bug "there's a bug in my code" ``` @@ -56,8 +57,10 @@ ``` ## Todo + `todo` is useful if you want to come back to a piece of code later but you want your project to compile. -```unison + +``` unison complicatedMathStuff x = todo "Come back and to something with x here" ``` @@ -75,8 +78,10 @@ complicatedMathStuff x = todo "Come back and to something with x here" ``` ## Bug + `bug` is used to indicate that a particular branch is not expected to execute. -```unison + +``` unison test = match true with true -> "Yay" false -> bug "Wow, that's unexpected" diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index cfad74ec15..434e7a43d4 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -16,7 +16,7 @@ The todo command shows conflicted names (not demonstrated here yet because it is The `todo` command shows local (outside `lib`) terms that directly call `todo`. -```unison +``` unison foo : Nat foo = todo "implement foo" @@ -58,7 +58,7 @@ project/main> todo The `todo` command shows hashes of direct dependencies of local (outside `lib`) definitions that don't have names in the current namespace. -```unison +``` unison foo.bar = 15 baz = foo.bar + foo.bar ``` diff --git a/unison-src/transcripts/top-level-exceptions.output.md b/unison-src/transcripts/top-level-exceptions.output.md index 6624fbd233..4a889dedcd 100644 --- a/unison-src/transcripts/top-level-exceptions.output.md +++ b/unison-src/transcripts/top-level-exceptions.output.md @@ -1,4 +1,3 @@ - A simple transcript to test the use of exceptions that bubble to the top level. FYI, here are the `Exception` and `Failure` types: @@ -15,7 +14,7 @@ scratch/main> view Exception Failure ``` Here's a sample program just to verify that the typechecker allows `run` to throw exceptions: -```unison +``` unison use builtin IO Exception Test.Result main : '{IO, Exception} () @@ -64,7 +63,7 @@ scratch/main> io.test mytest ``` Now a test to show the handling of uncaught exceptions: -```unison +``` unison main2 = '(error "oh noes!" ()) error : Text -> a ->{Exception} x diff --git a/unison-src/transcripts/transcript-parser-commands.output.md b/unison-src/transcripts/transcript-parser-commands.output.md index 15b72bc3b1..842ea130cc 100644 --- a/unison-src/transcripts/transcript-parser-commands.output.md +++ b/unison-src/transcripts/transcript-parser-commands.output.md @@ -2,7 +2,7 @@ The transcript parser is meant to parse `ucm` and `unison` blocks. -```unison +``` unison x = 1 ``` @@ -27,7 +27,7 @@ x = 1 x : Nat ``` -```unison +``` unison --- title: :scratch.u --- @@ -35,7 +35,6 @@ z ``` - ```ucm .> delete foo @@ -56,21 +55,15 @@ z ``` However handling of blocks of other languages should be supported. -```python - +``` python some python code - ``` -```c_cpp - +``` c_cpp some C++ code - ``` -```c9search - +``` c9search some cloud9 code - ``` diff --git a/unison-src/transcripts/type-deps.output.md b/unison-src/transcripts/type-deps.output.md index ad1205e1ef..24ab0e2885 100644 --- a/unison-src/transcripts/type-deps.output.md +++ b/unison-src/transcripts/type-deps.output.md @@ -4,13 +4,13 @@ https://github.com/unisonweb/unison/pull/2821 Define a type. -```unison +``` unison structural type Y = Y ``` Now, we update `Y`, and add a new type `Z` which depends on it. -```unison +``` unison structural type Z = Z Y structural type Y = Y Nat ``` @@ -35,6 +35,7 @@ structural type Y = Y Nat ``` Adding should fail for BOTH definitions, `Y` needs an update and `Z` is blocked by `Y`. + ```ucm scratch/main> add diff --git a/unison-src/transcripts/type-modifier-are-optional.output.md b/unison-src/transcripts/type-modifier-are-optional.output.md index 88b7844127..34c562d153 100644 --- a/unison-src/transcripts/type-modifier-are-optional.output.md +++ b/unison-src/transcripts/type-modifier-are-optional.output.md @@ -2,7 +2,7 @@ Types and abilities may be prefixed with either `unique` or `structural`. When left unspecified, `unique` is assumed. -```unison +``` unison type Abc = Abc unique type Def = Def structural type Ghi = Ghi diff --git a/unison-src/transcripts/unique-type-churn.output.md b/unison-src/transcripts/unique-type-churn.output.md index 74076d8c6d..f633292e86 100644 --- a/unison-src/transcripts/unique-type-churn.output.md +++ b/unison-src/transcripts/unique-type-churn.output.md @@ -1,7 +1,7 @@ This transcript demonstrates that unique types no longer always get a fresh GUID: they share GUIDs with already-saved unique types of the same name. -```unison +``` unison unique type A = A unique type B = B C @@ -33,7 +33,7 @@ scratch/main> add type C ``` -```unison +``` unison unique type A = A unique type B = B C @@ -64,7 +64,7 @@ scratch/main> names A Tip: Use `names.global` to see more results. ``` -```unison +``` unison unique type A = A () ``` @@ -103,7 +103,7 @@ scratch/main> names A Tip: Use `names.global` to see more results. ``` -```unison +``` unison unique type A = A ``` diff --git a/unison-src/transcripts/unitnamespace.output.md b/unison-src/transcripts/unitnamespace.output.md index a3d7b39568..9bc4274342 100644 --- a/unison-src/transcripts/unitnamespace.output.md +++ b/unison-src/transcripts/unitnamespace.output.md @@ -1,4 +1,4 @@ -```unison +``` unison `()`.foo = "bar" ``` diff --git a/unison-src/transcripts/universal-cmp.output.md b/unison-src/transcripts/universal-cmp.output.md index b1f07fddf2..af4bced3e2 100644 --- a/unison-src/transcripts/universal-cmp.output.md +++ b/unison-src/transcripts/universal-cmp.output.md @@ -1,8 +1,7 @@ - File for test cases making sure that universal equality/comparison cases exist for built-in types. Just making sure they don't crash. -```unison +``` unison unique type A = A threadEyeDeez _ = @@ -38,7 +37,7 @@ scratch/main> run threadEyeDeez (false, true) ``` -```unison +``` unison > typeLink A == typeLink A > typeLink Text == typeLink Text > typeLink Text == typeLink A diff --git a/unison-src/transcripts/unsafe-coerce.output.md b/unison-src/transcripts/unsafe-coerce.output.md index 62eb29845f..73ed1c6253 100644 --- a/unison-src/transcripts/unsafe-coerce.output.md +++ b/unison-src/transcripts/unsafe-coerce.output.md @@ -1,5 +1,4 @@ - -```unison +``` unison f : '{} Nat f _ = 5 diff --git a/unison-src/transcripts/update-ignores-lib-namespace.output.md b/unison-src/transcripts/update-ignores-lib-namespace.output.md index e7026d6f3b..ffc4147d0d 100644 --- a/unison-src/transcripts/update-ignores-lib-namespace.output.md +++ b/unison-src/transcripts/update-ignores-lib-namespace.output.md @@ -2,7 +2,7 @@ the project organization convention that dependencies are put in "lib"; it's much easier to apply a patch to all of one's own code if the "lib" namespace is simply ignored. -```unison +``` unison foo = 100 lib.foo = 100 ``` @@ -30,7 +30,7 @@ scratch/main> add lib.foo : Nat ``` -```unison +``` unison foo = 200 ``` diff --git a/unison-src/transcripts/update-on-conflict.output.md b/unison-src/transcripts/update-on-conflict.output.md index ce48e5f6c8..8d05b394f2 100644 --- a/unison-src/transcripts/update-on-conflict.output.md +++ b/unison-src/transcripts/update-on-conflict.output.md @@ -2,7 +2,7 @@ Updating conflicted definitions works fine. -```unison +``` unison x = 1 temp = 2 ``` @@ -38,7 +38,7 @@ scratch/main> delete.term temp Done. ``` -```unison +``` unison x = 3 ``` diff --git a/unison-src/transcripts/update-suffixifies-properly.output.md b/unison-src/transcripts/update-suffixifies-properly.output.md index 812eac20e2..a2a938fead 100644 --- a/unison-src/transcripts/update-suffixifies-properly.output.md +++ b/unison-src/transcripts/update-suffixifies-properly.output.md @@ -1,4 +1,4 @@ -```unison +``` unison a.x.x.x.x = 100 b.x.x.x.x = 100 foo = 25 @@ -38,7 +38,7 @@ myproject/main> add foo : Nat ``` -```unison +``` unison foo = +30 ``` @@ -69,7 +69,7 @@ myproject/main> update `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u bar : Nat bar = use Nat + diff --git a/unison-src/transcripts/update-term-aliases-in-different-ways.output.md b/unison-src/transcripts/update-term-aliases-in-different-ways.output.md index 10e8303cab..3d16a9254a 100644 --- a/unison-src/transcripts/update-term-aliases-in-different-ways.output.md +++ b/unison-src/transcripts/update-term-aliases-in-different-ways.output.md @@ -4,7 +4,7 @@ scratch/main> builtins.merge Done. ``` -```unison +``` unison foo : Nat foo = 5 @@ -35,7 +35,7 @@ scratch/main> add foo : Nat ``` -```unison +``` unison foo : Nat foo = 6 diff --git a/unison-src/transcripts/update-term-to-different-type.output.md b/unison-src/transcripts/update-term-to-different-type.output.md index b1cad29f4a..a525811da4 100644 --- a/unison-src/transcripts/update-term-to-different-type.output.md +++ b/unison-src/transcripts/update-term-to-different-type.output.md @@ -4,7 +4,7 @@ scratch/main> builtins.merge Done. ``` -```unison +``` unison foo : Nat foo = 5 ``` @@ -30,7 +30,7 @@ scratch/main> add foo : Nat ``` -```unison +``` unison foo : Int foo = +5 ``` diff --git a/unison-src/transcripts/update-term-with-alias.output.md b/unison-src/transcripts/update-term-with-alias.output.md index 785a5e0d6e..03124e7945 100644 --- a/unison-src/transcripts/update-term-with-alias.output.md +++ b/unison-src/transcripts/update-term-with-alias.output.md @@ -4,7 +4,7 @@ scratch/main> builtins.merge Done. ``` -```unison +``` unison foo : Nat foo = 5 @@ -35,7 +35,7 @@ scratch/main> add foo : Nat ``` -```unison +``` unison foo : Nat foo = 6 ``` diff --git a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md index c2357e31e7..aef8fcb1e9 100644 --- a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md +++ b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md @@ -4,7 +4,7 @@ scratch/main> builtins.merge Done. ``` -```unison +``` unison foo : Nat foo = 5 @@ -35,7 +35,7 @@ scratch/main> add foo : Nat ``` -```unison +``` unison foo : Int foo = +5 ``` @@ -67,7 +67,7 @@ scratch/main> update `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u bar : Nat bar = use Nat + diff --git a/unison-src/transcripts/update-term-with-dependent.output.md b/unison-src/transcripts/update-term-with-dependent.output.md index 9acbb2b7b7..79aee87f34 100644 --- a/unison-src/transcripts/update-term-with-dependent.output.md +++ b/unison-src/transcripts/update-term-with-dependent.output.md @@ -4,7 +4,7 @@ scratch/main> builtins.merge Done. ``` -```unison +``` unison foo : Nat foo = 5 @@ -35,7 +35,7 @@ scratch/main> add foo : Nat ``` -```unison +``` unison foo : Nat foo = 6 ``` diff --git a/unison-src/transcripts/update-term.output.md b/unison-src/transcripts/update-term.output.md index 26bb87579d..982c3b23ab 100644 --- a/unison-src/transcripts/update-term.output.md +++ b/unison-src/transcripts/update-term.output.md @@ -4,7 +4,7 @@ scratch/main> builtins.merge Done. ``` -```unison +``` unison foo : Nat foo = 5 ``` @@ -30,7 +30,7 @@ scratch/main> add foo : Nat ``` -```unison +``` unison foo : Nat foo = 6 ``` diff --git a/unison-src/transcripts/update-test-to-non-test.output.md b/unison-src/transcripts/update-test-to-non-test.output.md index f08dd4bb97..fc9363d5a6 100644 --- a/unison-src/transcripts/update-test-to-non-test.output.md +++ b/unison-src/transcripts/update-test-to-non-test.output.md @@ -4,7 +4,7 @@ scratch/main> builtins.merge Done. ``` -```unison +``` unison test> foo = [] ``` @@ -42,7 +42,7 @@ scratch/main> view foo foo = [] ``` -```unison +``` unison foo = 1 ``` diff --git a/unison-src/transcripts/update-test-watch-roundtrip.output.md b/unison-src/transcripts/update-test-watch-roundtrip.output.md index 2f1959eb58..5ba534cd3b 100644 --- a/unison-src/transcripts/update-test-watch-roundtrip.output.md +++ b/unison-src/transcripts/update-test-watch-roundtrip.output.md @@ -1,7 +1,6 @@ - Given a test that depends on another definition, -```unison +``` unison foo n = n + 1 test> mynamespace.foo.test = @@ -20,7 +19,7 @@ scratch/main> add ``` if we change the type of the dependency, the test should show in the scratch file as a test watch. -```unison +``` unison foo n = "hello, world!" ``` @@ -51,7 +50,7 @@ scratch/main> update `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u test> mynamespace.foo.test = n = 2 if foo n == 2 then [Ok "passed"] else [Fail "wat"] diff --git a/unison-src/transcripts/update-type-add-constructor.output.md b/unison-src/transcripts/update-type-add-constructor.output.md index 4064cbf3d3..5f58f745cc 100644 --- a/unison-src/transcripts/update-type-add-constructor.output.md +++ b/unison-src/transcripts/update-type-add-constructor.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat ``` @@ -24,7 +24,7 @@ scratch/main> add type Foo ``` -```unison +``` unison unique type Foo = Bar Nat | Baz Nat Nat diff --git a/unison-src/transcripts/update-type-add-field.output.md b/unison-src/transcripts/update-type-add-field.output.md index 6ba0471643..b96464e02f 100644 --- a/unison-src/transcripts/update-type-add-field.output.md +++ b/unison-src/transcripts/update-type-add-field.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat ``` @@ -23,7 +23,7 @@ scratch/main> add type Foo ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` diff --git a/unison-src/transcripts/update-type-add-new-record.output.md b/unison-src/transcripts/update-type-add-new-record.output.md index 321ac28ec7..4e10132bc4 100644 --- a/unison-src/transcripts/update-type-add-new-record.output.md +++ b/unison-src/transcripts/update-type-add-new-record.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = { bar : Nat } ``` diff --git a/unison-src/transcripts/update-type-add-record-field.output.md b/unison-src/transcripts/update-type-add-record-field.output.md index d0a7a700eb..1997eb2acd 100644 --- a/unison-src/transcripts/update-type-add-record-field.output.md +++ b/unison-src/transcripts/update-type-add-record-field.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = { bar : Nat } ``` @@ -29,7 +29,7 @@ scratch/main> add Foo.bar.set : Nat -> Foo -> Foo ``` -```unison +``` unison unique type Foo = { bar : Nat, baz : Int } ``` diff --git a/unison-src/transcripts/update-type-constructor-alias.output.md b/unison-src/transcripts/update-type-constructor-alias.output.md index 21cea73a91..76291ee05f 100644 --- a/unison-src/transcripts/update-type-constructor-alias.output.md +++ b/unison-src/transcripts/update-type-constructor-alias.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat ``` @@ -27,7 +27,7 @@ scratch/main> alias.term Foo.Bar Foo.BarAlias Done. ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` diff --git a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md index f443c34263..3eca077a5d 100644 --- a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md +++ b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat | Baz Nat Nat @@ -32,7 +32,7 @@ scratch/main> add foo : Foo -> Nat ``` -```unison +``` unison unique type Foo = Bar Nat ``` @@ -64,7 +64,7 @@ scratch/main> update `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u foo : Foo -> Nat foo = cases Bar n -> n diff --git a/unison-src/transcripts/update-type-delete-constructor.output.md b/unison-src/transcripts/update-type-delete-constructor.output.md index 1aa01c8a57..05d18c2598 100644 --- a/unison-src/transcripts/update-type-delete-constructor.output.md +++ b/unison-src/transcripts/update-type-delete-constructor.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat | Baz Nat Nat @@ -25,7 +25,7 @@ scratch/main> add type Foo ``` -```unison +``` unison unique type Foo = Bar Nat ``` diff --git a/unison-src/transcripts/update-type-delete-record-field.output.md b/unison-src/transcripts/update-type-delete-record-field.output.md index e2691b8145..dcdfa6d51d 100644 --- a/unison-src/transcripts/update-type-delete-record-field.output.md +++ b/unison-src/transcripts/update-type-delete-record-field.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = { bar : Nat, baz : Int } ``` @@ -35,7 +35,7 @@ scratch/main> add Foo.baz.set : Int -> Foo -> Foo ``` -```unison +``` unison unique type Foo = { bar : Nat } ``` @@ -103,7 +103,7 @@ scratch/main> find.verbose ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u Foo.baz : Foo -> Int Foo.baz = cases Foo _ baz -> baz diff --git a/unison-src/transcripts/update-type-missing-constructor.output.md b/unison-src/transcripts/update-type-missing-constructor.output.md index 59df270a54..2344e4319a 100644 --- a/unison-src/transcripts/update-type-missing-constructor.output.md +++ b/unison-src/transcripts/update-type-missing-constructor.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat ``` @@ -29,7 +29,7 @@ scratch/main> delete.term Foo.Bar ``` Now we've set up a situation where the original constructor missing. -```unison +``` unison unique type Foo = Bar Nat Nat ``` diff --git a/unison-src/transcripts/update-type-nested-decl-aliases.output.md b/unison-src/transcripts/update-type-nested-decl-aliases.output.md index afddbf3de6..e67a1c4b14 100644 --- a/unison-src/transcripts/update-type-nested-decl-aliases.output.md +++ b/unison-src/transcripts/update-type-nested-decl-aliases.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat structural type A.B = OneAlias Foo @@ -30,7 +30,7 @@ scratch/main> add type Foo ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` @@ -65,7 +65,7 @@ scratch/main> update `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u structural type A = B.OneAlias Foo structural type A.B = OneAlias Foo diff --git a/unison-src/transcripts/update-type-no-op-record.output.md b/unison-src/transcripts/update-type-no-op-record.output.md index 8d46e420ce..159f9aa865 100644 --- a/unison-src/transcripts/update-type-no-op-record.output.md +++ b/unison-src/transcripts/update-type-no-op-record.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = { bar : Nat } ``` diff --git a/unison-src/transcripts/update-type-stray-constructor-alias.output.md b/unison-src/transcripts/update-type-stray-constructor-alias.output.md index 0e906b70dd..54a1e59653 100644 --- a/unison-src/transcripts/update-type-stray-constructor-alias.output.md +++ b/unison-src/transcripts/update-type-stray-constructor-alias.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat ``` @@ -27,7 +27,7 @@ scratch/main> alias.term Foo.Bar Stray.BarAlias Done. ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` diff --git a/unison-src/transcripts/update-type-stray-constructor.output.md b/unison-src/transcripts/update-type-stray-constructor.output.md index a76b034b41..999c57ae43 100644 --- a/unison-src/transcripts/update-type-stray-constructor.output.md +++ b/unison-src/transcripts/update-type-stray-constructor.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat ``` @@ -29,7 +29,7 @@ scratch/main> move.term Foo.Bar Stray.Bar ``` Now we've set up a situation where the constructor is not where it's supposed to be; it's somewhere else. -```unison +``` unison unique type Foo = Bar Nat Nat ``` diff --git a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md index a00b5dde63..cff0653a02 100644 --- a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md +++ b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat makeFoo : Nat -> Foo @@ -28,7 +28,7 @@ scratch/main> add makeFoo : Nat -> Foo ``` -```unison +``` unison unique type Foo = internal.Bar Nat Foo.Bar : Nat -> Foo diff --git a/unison-src/transcripts/update-type-turn-non-record-into-record.output.md b/unison-src/transcripts/update-type-turn-non-record-into-record.output.md index fb1f2dd2ce..a9a3bf4674 100644 --- a/unison-src/transcripts/update-type-turn-non-record-into-record.output.md +++ b/unison-src/transcripts/update-type-turn-non-record-into-record.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Nat ``` @@ -23,7 +23,7 @@ scratch/main> add type Foo ``` -```unison +``` unison unique type Foo = { bar : Nat } ``` diff --git a/unison-src/transcripts/update-type-with-dependent-term.output.md b/unison-src/transcripts/update-type-with-dependent-term.output.md index 1ab2b586bc..09d0a63f5d 100644 --- a/unison-src/transcripts/update-type-with-dependent-term.output.md +++ b/unison-src/transcripts/update-type-with-dependent-term.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat incrFoo : Foo -> Foo @@ -28,7 +28,7 @@ scratch/main> add incrFoo : Foo -> Foo ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` @@ -59,7 +59,7 @@ scratch/main> update `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u incrFoo : Foo -> Foo incrFoo = cases Bar n -> Bar (n Nat.+ 1) diff --git a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md index edc63c214d..ea8d652422 100644 --- a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md +++ b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat unique type Baz = Qux Foo ``` @@ -26,7 +26,7 @@ scratch/main> add type Foo ``` -```unison +``` unison unique type Foo a = Bar Nat a ``` @@ -57,7 +57,7 @@ scratch/main> update `update` again. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u type Baz = Qux Foo type Foo a = Bar Nat a diff --git a/unison-src/transcripts/update-type-with-dependent-type.output.md b/unison-src/transcripts/update-type-with-dependent-type.output.md index 2523eed7df..474a8ceef8 100644 --- a/unison-src/transcripts/update-type-with-dependent-type.output.md +++ b/unison-src/transcripts/update-type-with-dependent-type.output.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type Foo = Bar Nat unique type Baz = Qux Foo ``` @@ -26,7 +26,7 @@ scratch/main> add type Foo ``` -```unison +``` unison unique type Foo = Bar Nat Nat ``` diff --git a/unison-src/transcripts/update-watch.output.md b/unison-src/transcripts/update-watch.output.md index c9c9510457..36bc89ae21 100644 --- a/unison-src/transcripts/update-watch.output.md +++ b/unison-src/transcripts/update-watch.output.md @@ -1,4 +1,4 @@ -```unison +``` unison > 1 ``` diff --git a/unison-src/transcripts/upgrade-happy-path.output.md b/unison-src/transcripts/upgrade-happy-path.output.md index b2d8bb80a6..33c8b6c8d2 100644 --- a/unison-src/transcripts/upgrade-happy-path.output.md +++ b/unison-src/transcripts/upgrade-happy-path.output.md @@ -1,4 +1,4 @@ -```unison +``` unison lib.old.foo = 17 lib.new.foo = 18 thingy = lib.old.foo + 10 diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md index f0811cd8ee..d25d2f8c4e 100644 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ b/unison-src/transcripts/upgrade-sad-path.output.md @@ -1,4 +1,4 @@ -```unison +``` unison lib.old.foo = 17 lib.new.foo = +18 thingy = lib.old.foo + 10 @@ -49,7 +49,7 @@ proj/main> upgrade old new to delete the temporary branch and switch back to main. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u thingy : Nat thingy = use Nat + @@ -58,7 +58,7 @@ thingy = Resolve the error and commit the upgrade. -```unison +``` unison thingy = foo + +10 ``` diff --git a/unison-src/transcripts/upgrade-suffixifies-properly.output.md b/unison-src/transcripts/upgrade-suffixifies-properly.output.md index 4b7b313199..cacefecf8a 100644 --- a/unison-src/transcripts/upgrade-suffixifies-properly.output.md +++ b/unison-src/transcripts/upgrade-suffixifies-properly.output.md @@ -1,4 +1,4 @@ -```unison +``` unison lib.old.foo = 25 lib.new.foo = +30 a.x.x.x.x = 100 @@ -61,7 +61,7 @@ myproject/main> upgrade old new to delete the temporary branch and switch back to main. ``` -```unison:added-by-ucm scratch.u +``` unison:added-by-ucm scratch.u bar : Nat bar = use Nat + diff --git a/unison-src/transcripts/upgrade-with-old-alias.output.md b/unison-src/transcripts/upgrade-with-old-alias.output.md index 9fdea6d7bd..46b0736166 100644 --- a/unison-src/transcripts/upgrade-with-old-alias.output.md +++ b/unison-src/transcripts/upgrade-with-old-alias.output.md @@ -1,4 +1,4 @@ -```unison +``` unison lib.old.foo = 141 lib.new.foo = 142 bar = 141 diff --git a/unison-src/transcripts/view.output.md b/unison-src/transcripts/view.output.md index 71ebf98da7..c300d96d3b 100644 --- a/unison-src/transcripts/view.output.md +++ b/unison-src/transcripts/view.output.md @@ -1,6 +1,6 @@ # View commands -```unison +``` unison a.thing = "a" b.thing = "b" ``` diff --git a/unison-src/transcripts/watch-expressions.output.md b/unison-src/transcripts/watch-expressions.output.md index 589b70833e..0641ab1a6a 100644 --- a/unison-src/transcripts/watch-expressions.output.md +++ b/unison-src/transcripts/watch-expressions.output.md @@ -4,7 +4,7 @@ scratch/main> builtins.mergeio Done. ``` -```unison +``` unison test> pass = [Ok "Passed"] ``` @@ -36,7 +36,7 @@ scratch/main> add pass : [Result] ``` -```unison +``` unison test> pass = [Ok "Passed"] ``` @@ -71,7 +71,7 @@ scratch/main> test Tip: Use view 1 to view the source of a test. ``` -```unison +``` unison > ImmutableArray.fromList [?a, ?b, ?c] > ImmutableByteArray.fromBytes 0xs123456 ``` From 0031542fafa33d05d55e6a66cb3337d931cfdb43 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 10 Jul 2024 10:17:15 -0600 Subject: [PATCH 434/631] Add a space before code block info strings This is for consistency with the `cmark` style. Now the blocks we still pretty-print ourselves will match the bulk of them that `cmark` produces. --- .../IntegrationTests/transcript.output.md | 4 +- .../src/Unison/Codebase/TranscriptParser.hs | 6 +- .../transcripts-manual/docs.to-html.output.md | 6 +- .../transcripts-manual/rewrites.output.md | 20 +- .../transcripts-round-trip/main.output.md | 10 +- .../transcripts-using-base/_base.output.md | 4 +- .../all-base-hashes.output.md | 2 +- .../binary-encoding-nats.output.md | 4 +- .../transcripts-using-base/codeops.output.md | 16 +- .../transcripts-using-base/doc.output.md | 10 +- .../failure-tests.output.md | 8 +- .../fix2158-1.output.md | 2 +- .../transcripts-using-base/fix2297.output.md | 2 +- .../transcripts-using-base/fix2358.output.md | 4 +- .../transcripts-using-base/fix3166.output.md | 6 +- .../transcripts-using-base/fix3542.output.md | 2 +- .../transcripts-using-base/fix3939.output.md | 4 +- .../transcripts-using-base/fix4746.output.md | 2 +- .../transcripts-using-base/fix5129.output.md | 4 +- .../transcripts-using-base/hashing.output.md | 16 +- .../transcripts-using-base/mvar.output.md | 4 +- .../nat-coersion.output.md | 4 +- .../transcripts-using-base/net.output.md | 8 +- .../random-deserial.output.md | 4 +- .../ref-promise.output.md | 20 +- .../serial-test-00.output.md | 4 +- .../serial-test-01.output.md | 4 +- .../serial-test-02.output.md | 4 +- .../serial-test-03.output.md | 4 +- .../serial-test-04.output.md | 4 +- .../transcripts-using-base/stm.output.md | 8 +- .../test-watch-dependencies.output.md | 8 +- .../transcripts-using-base/thread.output.md | 10 +- .../transcripts-using-base/tls.output.md | 8 +- .../transcripts-using-base/utf8.output.md | 10 +- unison-src/transcripts/abilities.output.md | 4 +- ...ability-order-doesnt-affect-hash.output.md | 4 +- ...ability-term-conflicts-on-update.output.md | 22 +- unison-src/transcripts/add-run.output.md | 40 ++-- .../add-test-watch-roundtrip.output.md | 2 +- .../transcripts/addupdatemessages.output.md | 16 +- unison-src/transcripts/alias-many.output.md | 2 +- unison-src/transcripts/alias-term.output.md | 8 +- unison-src/transcripts/alias-type.output.md | 8 +- unison-src/transcripts/anf-tests.output.md | 4 +- unison-src/transcripts/any-extract.output.md | 4 +- .../transcripts/api-doc-rendering.output.md | 4 +- unison-src/transcripts/api-find.output.md | 6 +- .../transcripts/api-getDefinition.output.md | 6 +- .../api-list-projects-branches.output.md | 2 +- .../api-namespace-details.output.md | 6 +- .../transcripts/api-namespace-list.output.md | 6 +- .../transcripts/api-summaries.output.md | 4 +- .../block-on-required-update.output.md | 8 +- unison-src/transcripts/blocks.output.md | 26 +-- .../boolean-op-pretty-print-2819.output.md | 4 +- .../transcripts/branch-command.output.md | 8 +- .../branch-relative-path.output.md | 8 +- unison-src/transcripts/bug-fix-4354.output.md | 2 +- .../transcripts/bug-strange-closure.output.md | 8 +- .../transcripts/builtins-merge.output.md | 2 +- unison-src/transcripts/builtins.output.md | 12 +- .../transcripts/bytesFromList.output.md | 2 +- unison-src/transcripts/check763.output.md | 4 +- unison-src/transcripts/check873.output.md | 6 +- .../constructor-applied-to-unit.output.md | 2 +- .../transcripts/contrabilities.output.md | 2 +- .../transcripts/create-author.output.md | 2 +- .../transcripts/cycle-update-1.output.md | 8 +- .../transcripts/cycle-update-2.output.md | 8 +- .../transcripts/cycle-update-3.output.md | 8 +- .../transcripts/cycle-update-4.output.md | 8 +- .../transcripts/cycle-update-5.output.md | 8 +- .../transcripts/debug-definitions.output.md | 2 +- .../transcripts/debug-name-diffs.output.md | 4 +- unison-src/transcripts/deep-names.output.md | 8 +- .../transcripts/definition-diff-api.output.md | 14 +- ...elete-namespace-dependents-check.output.md | 4 +- .../transcripts/delete-namespace.output.md | 12 +- .../delete-project-branch.output.md | 8 +- .../transcripts/delete-project.output.md | 2 +- .../transcripts/delete-silent.output.md | 4 +- unison-src/transcripts/delete.output.md | 28 +-- ...ependents-dependencies-debugfile.output.md | 4 +- .../transcripts/destructuring-binds.output.md | 14 +- .../transcripts/diff-namespace.output.md | 32 +-- .../transcripts/doc-formatting.output.md | 54 ++--- .../doc-type-link-keywords.output.md | 2 +- unison-src/transcripts/doc1.output.md | 16 +- unison-src/transcripts/doc2.output.md | 2 +- unison-src/transcripts/doc2markdown.output.md | 4 +- ...t-upgrade-refs-that-exist-in-old.output.md | 4 +- .../transcripts/duplicate-names.output.md | 12 +- .../duplicate-term-detection.output.md | 8 +- unison-src/transcripts/ed25519.output.md | 2 +- unison-src/transcripts/edit-command.output.md | 8 +- .../transcripts/edit-namespace.output.md | 8 +- .../transcripts/empty-namespaces.output.md | 14 +- .../transcripts/emptyCodebase.output.md | 6 +- .../transcripts/error-messages.output.md | 40 ++-- .../transcripts/escape-sequences.output.md | 2 +- unison-src/transcripts/find-by-type.output.md | 4 +- unison-src/transcripts/find-command.output.md | 10 +- .../fix-1381-excess-propagate.output.md | 8 +- .../transcripts/fix-big-list-crash.output.md | 2 +- unison-src/transcripts/fix-ls.output.md | 6 +- unison-src/transcripts/fix1063.output.md | 4 +- unison-src/transcripts/fix1334.output.md | 2 +- unison-src/transcripts/fix1390.output.md | 8 +- unison-src/transcripts/fix1532.output.md | 14 +- unison-src/transcripts/fix1696.output.md | 2 +- unison-src/transcripts/fix1709.output.md | 6 +- unison-src/transcripts/fix1731.output.md | 2 +- unison-src/transcripts/fix1800.output.md | 8 +- unison-src/transcripts/fix1844.output.md | 2 +- unison-src/transcripts/fix1926.output.md | 6 +- unison-src/transcripts/fix2026.output.md | 4 +- unison-src/transcripts/fix2027.output.md | 4 +- unison-src/transcripts/fix2049.output.md | 6 +- unison-src/transcripts/fix2053.output.md | 2 +- unison-src/transcripts/fix2156.output.md | 2 +- unison-src/transcripts/fix2167.output.md | 2 +- unison-src/transcripts/fix2187.output.md | 2 +- unison-src/transcripts/fix2231.output.md | 4 +- unison-src/transcripts/fix2238.output.md | 4 +- unison-src/transcripts/fix2244.output.md | 2 +- unison-src/transcripts/fix2254.output.md | 12 +- unison-src/transcripts/fix2268.output.md | 2 +- unison-src/transcripts/fix2334.output.md | 2 +- unison-src/transcripts/fix2344.output.md | 2 +- unison-src/transcripts/fix2350.output.md | 2 +- unison-src/transcripts/fix2353.output.md | 2 +- unison-src/transcripts/fix2354.output.md | 2 +- unison-src/transcripts/fix2355.output.md | 2 +- unison-src/transcripts/fix2378.output.md | 2 +- unison-src/transcripts/fix2423.output.md | 2 +- unison-src/transcripts/fix2474.output.md | 4 +- unison-src/transcripts/fix2628.output.md | 2 +- unison-src/transcripts/fix2663.output.md | 2 +- unison-src/transcripts/fix2693.output.md | 8 +- unison-src/transcripts/fix2712.output.md | 6 +- unison-src/transcripts/fix2795.output.md | 2 +- unison-src/transcripts/fix2840.output.md | 4 +- unison-src/transcripts/fix2970.output.md | 4 +- unison-src/transcripts/fix3037.output.md | 4 +- unison-src/transcripts/fix3171.output.md | 2 +- unison-src/transcripts/fix3196.output.md | 2 +- unison-src/transcripts/fix3215.output.md | 2 +- unison-src/transcripts/fix3244.output.md | 2 +- unison-src/transcripts/fix3265.output.md | 4 +- unison-src/transcripts/fix3634.output.md | 4 +- unison-src/transcripts/fix3678.output.md | 2 +- unison-src/transcripts/fix3752.output.md | 2 +- unison-src/transcripts/fix3759.output.md | 2 +- unison-src/transcripts/fix3773.output.md | 2 +- unison-src/transcripts/fix4172.output.md | 8 +- unison-src/transcripts/fix4280.output.md | 2 +- unison-src/transcripts/fix4397.output.md | 2 +- unison-src/transcripts/fix4415.output.md | 2 +- unison-src/transcripts/fix4424.output.md | 4 +- unison-src/transcripts/fix4482.output.md | 4 +- unison-src/transcripts/fix4498.output.md | 4 +- unison-src/transcripts/fix4515.output.md | 8 +- unison-src/transcripts/fix4528.output.md | 4 +- unison-src/transcripts/fix4556.output.md | 8 +- unison-src/transcripts/fix4592.output.md | 2 +- unison-src/transcripts/fix4618.output.md | 8 +- unison-src/transcripts/fix4722.output.md | 2 +- unison-src/transcripts/fix4780.output.md | 2 +- unison-src/transcripts/fix4898.output.md | 6 +- unison-src/transcripts/fix5055.output.md | 6 +- unison-src/transcripts/fix5080.output.md | 6 +- unison-src/transcripts/fix614.output.md | 10 +- unison-src/transcripts/fix689.output.md | 2 +- unison-src/transcripts/fix693.output.md | 12 +- unison-src/transcripts/fix845.output.md | 10 +- unison-src/transcripts/fix849.output.md | 2 +- unison-src/transcripts/fix942.output.md | 12 +- unison-src/transcripts/fix987.output.md | 8 +- unison-src/transcripts/formatter.output.md | 6 +- .../transcripts/fuzzy-options.output.md | 10 +- .../generic-parse-errors.output.md | 12 +- unison-src/transcripts/hello.output.md | 6 +- unison-src/transcripts/help.output.md | 2 +- unison-src/transcripts/higher-rank.output.md | 10 +- .../transcripts/input-parse-errors.output.md | 4 +- .../transcripts/io-test-command.output.md | 6 +- unison-src/transcripts/io.output.md | 42 ++-- .../transcripts/kind-inference.output.md | 36 +-- unison-src/transcripts/lambdacase.output.md | 20 +- .../transcripts/lsp-fold-ranges.output.md | 2 +- .../transcripts/lsp-name-completion.output.md | 4 +- unison-src/transcripts/merge.output.md | 206 +++++++++--------- unison-src/transcripts/move-all.output.md | 20 +- .../transcripts/move-namespace.output.md | 36 +-- .../transcripts/name-segment-escape.output.md | 4 +- .../transcripts/name-selection.output.md | 14 +- unison-src/transcripts/names.output.md | 8 +- .../namespace-deletion-regression.output.md | 2 +- .../namespace-dependencies.output.md | 2 +- .../transcripts/numbered-args.output.md | 14 +- .../transcripts/old-fold-right.output.md | 2 +- .../pattern-match-coverage.output.md | 112 +++++----- .../pattern-pretty-print-2345.output.md | 4 +- .../transcripts/patternMatchTls.output.md | 4 +- unison-src/transcripts/patterns.output.md | 2 +- unison-src/transcripts/propagate.output.md | 32 +-- unison-src/transcripts/pull-errors.output.md | 2 +- unison-src/transcripts/records.output.md | 14 +- unison-src/transcripts/reflog.output.md | 14 +- .../release-draft-command.output.md | 8 +- unison-src/transcripts/reset.output.md | 26 +-- .../transcripts/resolution-failures.output.md | 8 +- unison-src/transcripts/rsa.output.md | 2 +- unison-src/transcripts/scope-ref.output.md | 2 +- unison-src/transcripts/suffixes.output.md | 22 +- .../sum-type-update-conflicts.output.md | 8 +- .../transcripts/switch-command.output.md | 14 +- .../transcripts/tab-completion.output.md | 20 +- unison-src/transcripts/test-command.output.md | 14 +- .../transcripts/text-literals.output.md | 4 +- .../transcripts/todo-bug-builtins.output.md | 8 +- unison-src/transcripts/todo.output.md | 10 +- .../top-level-exceptions.output.md | 10 +- .../transcript-parser-commands.output.md | 8 +- unison-src/transcripts/type-deps.output.md | 4 +- .../type-modifier-are-optional.output.md | 2 +- .../transcripts/unique-type-churn.output.md | 16 +- .../transcripts/unitnamespace.output.md | 4 +- .../transcripts/universal-cmp.output.md | 6 +- .../transcripts/unsafe-coerce.output.md | 4 +- .../update-ignores-lib-namespace.output.md | 8 +- .../transcripts/update-on-conflict.output.md | 8 +- .../update-suffixifies-properly.output.md | 8 +- ...e-term-aliases-in-different-ways.output.md | 10 +- .../update-term-to-different-type.output.md | 10 +- .../update-term-with-alias.output.md | 10 +- ...with-dependent-to-different-type.output.md | 10 +- .../update-term-with-dependent.output.md | 10 +- unison-src/transcripts/update-term.output.md | 10 +- .../update-test-to-non-test.output.md | 10 +- .../update-test-watch-roundtrip.output.md | 6 +- .../update-type-add-constructor.output.md | 8 +- .../update-type-add-field.output.md | 8 +- .../update-type-add-new-record.output.md | 4 +- .../update-type-add-record-field.output.md | 8 +- .../update-type-constructor-alias.output.md | 8 +- ...elete-constructor-with-dependent.output.md | 8 +- .../update-type-delete-constructor.output.md | 8 +- .../update-type-delete-record-field.output.md | 8 +- .../update-type-missing-constructor.output.md | 8 +- .../update-type-nested-decl-aliases.output.md | 8 +- .../update-type-no-op-record.output.md | 6 +- ...ate-type-stray-constructor-alias.output.md | 8 +- .../update-type-stray-constructor.output.md | 8 +- ...nstructor-into-smart-constructor.output.md | 8 +- ...type-turn-non-record-into-record.output.md | 8 +- .../update-type-with-dependent-term.output.md | 8 +- ...dependent-type-to-different-kind.output.md | 8 +- .../update-type-with-dependent-type.output.md | 8 +- unison-src/transcripts/update-watch.output.md | 4 +- .../transcripts/upgrade-happy-path.output.md | 8 +- .../transcripts/upgrade-sad-path.output.md | 10 +- .../upgrade-suffixifies-properly.output.md | 6 +- .../upgrade-with-old-alias.output.md | 4 +- unison-src/transcripts/view.output.md | 2 +- .../transcripts/watch-expressions.output.md | 12 +- 267 files changed, 1157 insertions(+), 1157 deletions(-) diff --git a/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md index 09def16163..2cf4f325cc 100644 --- a/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md +++ b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md @@ -27,7 +27,7 @@ main = do _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -43,7 +43,7 @@ main = do resume : Request {g, Break} x -> x ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/TranscriptParser.hs index ebabe7b4d7..bf71f18a87 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/unison-cli/src/Unison/Codebase/TranscriptParser.hs @@ -423,14 +423,14 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion liftIO (writeIORef allowErrors errOk) -- Open a ucm block which will contain the output from UCM -- after processing the UnisonFileChanged event. - liftIO (output "```ucm\n") + liftIO (output "``` ucm\n") -- Close the ucm block after processing the UnisonFileChanged event. atomically . Q.enqueue cmdQueue $ Nothing let sourceName = fromMaybe "scratch.u" filename liftIO $ updateVirtualFile sourceName txt pure $ Left (UnisonFileChanged sourceName txt) API apiRequests -> do - liftIO (output "```api\n") + liftIO (output "``` api\n") liftIO (for_ apiRequests apiRequest) liftIO (output "```") awaitInput @@ -438,7 +438,7 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion liftIO (writeIORef hidden hide) liftIO (writeIORef allowErrors errOk) liftIO (writeIORef hasErrors False) - liftIO (output "```ucm") + liftIO (output "``` ucm") traverse_ (atomically . Q.enqueue cmdQueue . Just) cmds atomically . Q.enqueue cmdQueue $ Nothing awaitInput diff --git a/unison-src/transcripts-manual/docs.to-html.output.md b/unison-src/transcripts-manual/docs.to-html.output.md index e59537da20..5c938806be 100644 --- a/unison-src/transcripts-manual/docs.to-html.output.md +++ b/unison-src/transcripts-manual/docs.to-html.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm test-html-docs/main> builtins.mergeio lib.builtins Done. @@ -15,7 +15,7 @@ some.ns.pretty.deeply.nested = 2 some.outside = 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -33,7 +33,7 @@ some.outside = 3 some.outside.doc : Doc2 ``` -```ucm +``` ucm test-html-docs/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-manual/rewrites.output.md b/unison-src/transcripts-manual/rewrites.output.md index 91d1272ec3..26cd59b494 100644 --- a/unison-src/transcripts-manual/rewrites.output.md +++ b/unison-src/transcripts-manual/rewrites.output.md @@ -29,7 +29,7 @@ rule2 x = @rewrite signature Optional ==> Optional2 Let's rewrite these: -```ucm +``` ucm scratch/main> rewrite rule1 ☝️ @@ -110,7 +110,7 @@ rule2 x = @rewrite signature Optional ==> Optional2 After adding to the codebase, here's the rewritten source: -```ucm +``` ucm scratch/main> view ex1 Either.mapRight rule1 Either.mapRight : (a ->{g} b) -> Optional a ->{g} Optional b @@ -156,7 +156,7 @@ blah2 = 456 Let's apply the rewrite `woot1to2`: -```ucm +``` ucm scratch/main> rewrite woot1to2 ☝️ @@ -192,7 +192,7 @@ blah2 = 456 After adding the rewritten form to the codebase, here's the rewritten `Woot1` to `Woot2`: -```ucm +``` ucm scratch/main> view wootEx wootEx : Nat ->{Woot2} Nat @@ -224,7 +224,7 @@ sameFileEx = After adding the rewritten form to the codebase, here's the rewritten definitions: -```ucm +``` ucm scratch/main> view foo1 foo2 sameFileEx foo1 : Nat @@ -265,7 +265,7 @@ sameFileEx = In the above example, `bar2` is locally bound by the rule, so when applied, it should not refer to the `bar2` top level binding. -```ucm +``` ucm scratch/main> rewrite rule ☝️ @@ -299,7 +299,7 @@ sameFileEx = Instead, it should be an unbound free variable, which doesn't typecheck: -```ucm +``` ucm scratch/main> load Loading changes detected in scratch.u. @@ -330,7 +330,7 @@ rule a = @rewrite term 233 ==> a ``` -```ucm +``` ucm scratch/main> rewrite rule ☝️ @@ -356,7 +356,7 @@ rule a = The `a` introduced will be freshened to not capture the `a` in scope, so it remains as an unbound variable and is a type error: -```ucm +``` ucm scratch/main> load Loading changes detected in scratch.u. @@ -386,7 +386,7 @@ findEitherEx x = @rewrite term Left ("hello", x) ==> Left ("hello" Text.++ x) findEitherFailure = @rewrite signature a . Either Failure a ==> () ``` -```ucm +``` ucm scratch/main> sfind findEitherEx 🔎 diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index 05d85375e6..5230f3495f 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -4,7 +4,7 @@ This transcript verifies that the pretty-printer produces code that can be succe x = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ x = () ``` So we can see the pretty-printed output: -```ucm +``` ucm .a1> edit 1-1000 ☝️ @@ -770,7 +770,7 @@ a |> f = f a This diff should be empty if the two namespaces are equivalent. If it's nonempty, the diff will show us the hashes that differ. -```ucm +``` ucm .> diff.namespace a1 a2 The namespaces are identical. @@ -784,7 +784,7 @@ This just makes 'roundtrip.u' the latest scratch file. x = () ``` -```ucm +``` ucm .a3> edit 1-5000 ☝️ @@ -819,7 +819,7 @@ sloppyDocEval = These are currently all expected to have different hashes on round trip. -```ucm +``` ucm .> diff.namespace a3 a3_old Updates: diff --git a/unison-src/transcripts-using-base/_base.output.md b/unison-src/transcripts-using-base/_base.output.md index ef2da4b888..eaad4fb38e 100644 --- a/unison-src/transcripts-using-base/_base.output.md +++ b/unison-src/transcripts-using-base/_base.output.md @@ -39,7 +39,7 @@ testAutoClean _ = Left (Failure _ t _) -> results :+ (Fail t) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -52,7 +52,7 @@ testAutoClean _ = testAutoClean : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/all-base-hashes.output.md b/unison-src/transcripts-using-base/all-base-hashes.output.md index 99d4128d07..0b656ef0c3 100644 --- a/unison-src/transcripts-using-base/all-base-hashes.output.md +++ b/unison-src/transcripts-using-base/all-base-hashes.output.md @@ -1,6 +1,6 @@ This transcript is intended to make visible accidental changes to the hashing algorithm. -```ucm +``` ucm scratch/main> find.verbose 1. -- #sgesq8035ut22q779pl1g4gqsg8c81894jjonmrq1bjltphkath225up841hk8dku59tnnc4laj9nggbofamgei4klof0ldc20uj2oo diff --git a/unison-src/transcripts-using-base/binary-encoding-nats.output.md b/unison-src/transcripts-using-base/binary-encoding-nats.output.md index 5f4b4c889b..da9bc7a95a 100644 --- a/unison-src/transcripts-using-base/binary-encoding-nats.output.md +++ b/unison-src/transcripts-using-base/binary-encoding-nats.output.md @@ -53,7 +53,7 @@ testABunchOfNats _ = (runTest (testNat 0)) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -75,7 +75,7 @@ testABunchOfNats _ = testRoundTrip : Nat -> EncDec ->{IO, Stream Result} () ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/codeops.output.md b/unison-src/transcripts-using-base/codeops.output.md index 4a4671c537..6e51f371d1 100644 --- a/unison-src/transcripts-using-base/codeops.output.md +++ b/unison-src/transcripts-using-base/codeops.output.md @@ -151,7 +151,7 @@ swapped name link = rejected ("swapped " ++ name) rco ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -198,7 +198,7 @@ swapped name link = ->{Throw Text} () ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -315,7 +315,7 @@ badLoad _ = Left _ -> [Fail "Exception"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -342,7 +342,7 @@ This simply runs some functions to make sure there isn't a crash. Once we gain the ability to capture output in a transcript, it can be modified to actual show that the serialization works. -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -428,7 +428,7 @@ codeTests = ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -441,7 +441,7 @@ codeTests = codeTests : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -514,7 +514,7 @@ vtests _ = ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -528,7 +528,7 @@ vtests _ = vtests : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/doc.output.md b/unison-src/transcripts-using-base/doc.output.md index 12a284c079..850929abab 100644 --- a/unison-src/transcripts-using-base/doc.output.md +++ b/unison-src/transcripts-using-base/doc.output.md @@ -28,7 +28,7 @@ The 7 days of the week, defined as: unique type time.DayOfWeek = Sun | Mon | Tue | Wed | Thu | Fri | Sat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,7 +50,7 @@ Notice that an anonymous documentation block `{{ ... }}` before a definition `Im You can preview what docs will look like when rendered to the console using the `display` or `docs` commands: -```ucm +``` ucm scratch/main> display d1 Hello there Alice! @@ -72,7 +72,7 @@ The `docs ImportantConstant` command will look for `ImportantConstant.doc` in th First, we'll load the `syntax.u` file which has examples of all the syntax: -```ucm +``` ucm scratch/main> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u Loading changes detected in @@ -99,7 +99,7 @@ Now we can review different portions of the guide. we'll show both the pretty-printed source using `view` and the rendered output using `display`: -```ucm +``` ucm scratch/main> view basicFormatting basicFormatting : Doc2 @@ -548,7 +548,7 @@ scratch/main> display otherElements ``` Lastly, it's common to build longer documents including subdocuments via `{{ subdoc }}`. We can stitch together the full syntax guide in this way: -```ucm +``` ucm scratch/main> view doc.guide doc.guide : Doc2 diff --git a/unison-src/transcripts-using-base/failure-tests.output.md b/unison-src/transcripts-using-base/failure-tests.output.md index adbf9bc53a..3a661894dd 100644 --- a/unison-src/transcripts-using-base/failure-tests.output.md +++ b/unison-src/transcripts-using-base/failure-tests.output.md @@ -18,7 +18,7 @@ test2 = do [Ok "test2"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -32,7 +32,7 @@ test2 = do test2 : '{IO, Exception} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -41,7 +41,7 @@ scratch/main> add test2 : '{IO, Exception} [Result] ``` -```ucm +``` ucm scratch/main> io.test test1 💔💥 @@ -57,7 +57,7 @@ scratch/main> io.test test1 ##raise ``` -```ucm +``` ucm scratch/main> io.test test2 💔💥 diff --git a/unison-src/transcripts-using-base/fix2158-1.output.md b/unison-src/transcripts-using-base/fix2158-1.output.md index 2099749bc9..9a692bb3de 100644 --- a/unison-src/transcripts-using-base/fix2158-1.output.md +++ b/unison-src/transcripts-using-base/fix2158-1.output.md @@ -11,7 +11,7 @@ Async.parMap f as = List.map await tasks ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts-using-base/fix2297.output.md b/unison-src/transcripts-using-base/fix2297.output.md index 3d8ca7d623..949cdd89e9 100644 --- a/unison-src/transcripts-using-base/fix2297.output.md +++ b/unison-src/transcripts-using-base/fix2297.output.md @@ -24,7 +24,7 @@ wat = handleTrivial testAction -- Somehow this completely forgets about Excepti > handleTrivial testAction ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts-using-base/fix2358.output.md b/unison-src/transcripts-using-base/fix2358.output.md index 8c8582c273..7e71541b74 100644 --- a/unison-src/transcripts-using-base/fix2358.output.md +++ b/unison-src/transcripts-using-base/fix2358.output.md @@ -8,7 +8,7 @@ timingApp2 _ = printLine "World" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,7 +21,7 @@ timingApp2 _ = timingApp2 : '{IO, Exception} () ``` -```ucm +``` ucm scratch/main> run timingApp2 () diff --git a/unison-src/transcripts-using-base/fix3166.output.md b/unison-src/transcripts-using-base/fix3166.output.md index 35e5815f93..9e33e14563 100644 --- a/unison-src/transcripts-using-base/fix3166.output.md +++ b/unison-src/transcripts-using-base/fix3166.output.md @@ -31,7 +31,7 @@ increment n = 1 + n Stream.toList s2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -82,7 +82,7 @@ foo _ = > h foo 337 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -126,7 +126,7 @@ hmm = > hmm ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts-using-base/fix3542.output.md b/unison-src/transcripts-using-base/fix3542.output.md index 5d6fe4b533..976f1c0636 100644 --- a/unison-src/transcripts-using-base/fix3542.output.md +++ b/unison-src/transcripts-using-base/fix3542.output.md @@ -13,7 +13,7 @@ arrayList v n = do > Scope.run '(catch (arrayList 7 8)) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts-using-base/fix3939.output.md b/unison-src/transcripts-using-base/fix3939.output.md index 75c0dcbea2..9240c712f9 100644 --- a/unison-src/transcripts-using-base/fix3939.output.md +++ b/unison-src/transcripts-using-base/fix3939.output.md @@ -5,7 +5,7 @@ A simple doc. meh = 9 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ meh = 9 meh.doc : Doc2 ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/fix4746.output.md b/unison-src/transcripts-using-base/fix4746.output.md index 62f7632c0b..8887e34743 100644 --- a/unison-src/transcripts-using-base/fix4746.output.md +++ b/unison-src/transcripts-using-base/fix4746.output.md @@ -35,7 +35,7 @@ run s = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts-using-base/fix5129.output.md b/unison-src/transcripts-using-base/fix5129.output.md index 90f205bd4a..3d07942a78 100644 --- a/unison-src/transcripts-using-base/fix5129.output.md +++ b/unison-src/transcripts-using-base/fix5129.output.md @@ -22,7 +22,7 @@ go = do foreach forkIt [thunk] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -56,7 +56,7 @@ fancyTryEval : '{g, IO, Exception} a ->{g, IO, Exception} a fancyTryEval = reraise << catchAll.impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts-using-base/hashing.output.md b/unison-src/transcripts-using-base/hashing.output.md index 721c1ec3c7..3bede2577e 100644 --- a/unison-src/transcripts-using-base/hashing.output.md +++ b/unison-src/transcripts-using-base/hashing.output.md @@ -2,7 +2,7 @@ Unison has cryptographic builtins for hashing and computing [HMACs](https://en.wikipedia.org/wiki/HMAC) (hash-based message authentication codes). This transcript shows their usage and has some test cases. -```ucm +``` ucm scratch/main> ls builtin.Bytes 1. ++ (Bytes -> Bytes -> Bytes) @@ -74,7 +74,7 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex > ex5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -119,7 +119,7 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex ``` And here's the full API: -```ucm +``` ucm scratch/main> find-in builtin.crypto 1. type CryptoFailure @@ -159,7 +159,7 @@ Note that the universal versions of `hash` and `hmac` are currently unimplemente > hash Sha3_256 (fromHex "3849238492") ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -311,7 +311,7 @@ test> crypto.hash.numTests = checks (List.map t (range 0 20)) ``` -```ucm +``` ucm scratch/main> test Cached test results (`help testcache` to learn more) @@ -378,7 +378,7 @@ test> hmac_sha2_512.tests.ex2 = "164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -441,7 +441,7 @@ test> md5.tests.ex3 = "e4d909c290d0fb1ca068ffaddf22cbd0" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -473,7 +473,7 @@ test> md5.tests.ex3 = ✅ Passed Passed ``` -```ucm +``` ucm scratch/main> test Cached test results (`help testcache` to learn more) diff --git a/unison-src/transcripts-using-base/mvar.output.md b/unison-src/transcripts-using-base/mvar.output.md index 466291ead1..c0bfdac99c 100644 --- a/unison-src/transcripts-using-base/mvar.output.md +++ b/unison-src/transcripts-using-base/mvar.output.md @@ -50,7 +50,7 @@ testMvars _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -64,7 +64,7 @@ testMvars _ = testMvars : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/nat-coersion.output.md b/unison-src/transcripts-using-base/nat-coersion.output.md index dac858429e..14d5c66855 100644 --- a/unison-src/transcripts-using-base/nat-coersion.output.md +++ b/unison-src/transcripts-using-base/nat-coersion.output.md @@ -31,7 +31,7 @@ test = 'let runTest testABunchOfNats ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -48,7 +48,7 @@ test = 'let ->{Stream Result} () ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/net.output.md b/unison-src/transcripts-using-base/net.output.md index 702be91bbf..4d95488cbf 100644 --- a/unison-src/transcripts-using-base/net.output.md +++ b/unison-src/transcripts-using-base/net.output.md @@ -90,7 +90,7 @@ testDefaultPort _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -105,7 +105,7 @@ testDefaultPort _ = testExplicitHost : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -177,7 +177,7 @@ testTcpConnect = 'let ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -192,7 +192,7 @@ testTcpConnect = 'let testTcpConnect : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/random-deserial.output.md b/unison-src/transcripts-using-base/random-deserial.output.md index 66d6354d5b..6c68e978ec 100644 --- a/unison-src/transcripts-using-base/random-deserial.output.md +++ b/unison-src/transcripts-using-base/random-deserial.output.md @@ -55,7 +55,7 @@ serialTests = do List.map snd (bSort (List.map runTestCase cs)) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -73,7 +73,7 @@ serialTests = do shuffle : Nat -> [a] -> [a] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/ref-promise.output.md b/unison-src/transcripts-using-base/ref-promise.output.md index bcc4487c3f..b44e98bb9f 100644 --- a/unison-src/transcripts-using-base/ref-promise.output.md +++ b/unison-src/transcripts-using-base/ref-promise.output.md @@ -18,7 +18,7 @@ casTest = do runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -31,7 +31,7 @@ casTest = do casTest : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -80,7 +80,7 @@ promiseConcurrentTest = do runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -94,7 +94,7 @@ promiseConcurrentTest = do promiseSequentialTest : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -134,7 +134,7 @@ atomicUpdate ref f = if Ref.cas ref ticket value then () else atomicUpdate ref f ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -147,7 +147,7 @@ atomicUpdate ref f = atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -173,7 +173,7 @@ spawnN n fa = map Promise.read (go n []) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -186,7 +186,7 @@ spawnN n fa = spawnN : Nat -> '{IO} a ->{IO} [a] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -222,7 +222,7 @@ fullTest = do runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -235,7 +235,7 @@ fullTest = do fullTest : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/serial-test-00.output.md b/unison-src/transcripts-using-base/serial-test-00.output.md index 019289ccdb..ce996f93ba 100644 --- a/unison-src/transcripts-using-base/serial-test-00.output.md +++ b/unison-src/transcripts-using-base/serial-test-00.output.md @@ -67,7 +67,7 @@ mkTestCase = do saveTestCase "case-00" "v4" f tup ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -94,7 +94,7 @@ mkTestCase = do tree3 : Tree Text ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/serial-test-01.output.md b/unison-src/transcripts-using-base/serial-test-01.output.md index a1a9668c1a..a6654a2547 100644 --- a/unison-src/transcripts-using-base/serial-test-01.output.md +++ b/unison-src/transcripts-using-base/serial-test-01.output.md @@ -15,7 +15,7 @@ mkTestCase = do saveTestCase "case-01" "v4" combines (l1, l2, l3) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -32,7 +32,7 @@ mkTestCase = do mkTestCase : '{IO, Exception} () ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/serial-test-02.output.md b/unison-src/transcripts-using-base/serial-test-02.output.md index 3a352b88b5..102fea092b 100644 --- a/unison-src/transcripts-using-base/serial-test-02.output.md +++ b/unison-src/transcripts-using-base/serial-test-02.output.md @@ -29,7 +29,7 @@ mkTestCase = do ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -48,7 +48,7 @@ mkTestCase = do products : ([Nat], [Nat], [Nat]) -> Text ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/serial-test-03.output.md b/unison-src/transcripts-using-base/serial-test-03.output.md index a1ca50f908..a20eafe7f6 100644 --- a/unison-src/transcripts-using-base/serial-test-03.output.md +++ b/unison-src/transcripts-using-base/serial-test-03.output.md @@ -43,7 +43,7 @@ mkTestCase = do saveTestCase "case-03" "v4" finish trip ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -67,7 +67,7 @@ mkTestCase = do suspSum : [Nat] -> Delayed Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/serial-test-04.output.md b/unison-src/transcripts-using-base/serial-test-04.output.md index 0b0b6230e4..990ce14799 100644 --- a/unison-src/transcripts-using-base/serial-test-04.output.md +++ b/unison-src/transcripts-using-base/serial-test-04.output.md @@ -12,7 +12,7 @@ mkTestCase = do saveTestCase "case-04" "v4" mutual1 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,7 +27,7 @@ mkTestCase = do mutual1 : Nat -> Text ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/stm.output.md b/unison-src/transcripts-using-base/stm.output.md index fd8fb97280..2e7724f9e3 100644 --- a/unison-src/transcripts-using-base/stm.output.md +++ b/unison-src/transcripts-using-base/stm.output.md @@ -28,7 +28,7 @@ body k out v = atomically '(TVar.write out (Some n)) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,7 +44,7 @@ body k out v = loop : '{IO} Nat -> Nat -> Nat ->{IO} Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -90,7 +90,7 @@ tests : '{io2.IO} [Result] tests = '(map spawn nats) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -106,7 +106,7 @@ tests = '(map spawn nats) tests : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/test-watch-dependencies.output.md b/unison-src/transcripts-using-base/test-watch-dependencies.output.md index b38e4373ad..a321643568 100644 --- a/unison-src/transcripts-using-base/test-watch-dependencies.output.md +++ b/unison-src/transcripts-using-base/test-watch-dependencies.output.md @@ -15,7 +15,7 @@ x = 1000 test> mytest = checks [x + 1 == 1001] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -42,7 +42,7 @@ test> mytest = checks [x + 1 == 1001] ``` We expect this 'add' to fail because the test is blocked by the update to `x`. -```ucm +``` ucm scratch/main> add x These definitions failed: @@ -61,7 +61,7 @@ y = 42 test> useY = checks [y + 1 == 43] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -84,7 +84,7 @@ test> useY = checks [y + 1 == 43] ``` This should correctly identify `y` as a dependency and add that too. -```ucm +``` ucm scratch/main> add useY ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/thread.output.md b/unison-src/transcripts-using-base/thread.output.md index bab82e7eb1..863d749698 100644 --- a/unison-src/transcripts-using-base/thread.output.md +++ b/unison-src/transcripts-using-base/thread.output.md @@ -16,7 +16,7 @@ testBasicFork = 'let ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -56,7 +56,7 @@ testBasicMultiThreadMVar = 'let ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -70,7 +70,7 @@ testBasicMultiThreadMVar = 'let thread1 : Nat -> MVar Nat -> '{IO} () ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -127,7 +127,7 @@ testTwoThreads = 'let ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -143,7 +143,7 @@ testTwoThreads = 'let testTwoThreads : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/tls.output.md b/unison-src/transcripts-using-base/tls.output.md index fc0362d8c6..76b9be2782 100644 --- a/unison-src/transcripts-using-base/tls.output.md +++ b/unison-src/transcripts-using-base/tls.output.md @@ -27,7 +27,7 @@ this_should_not_work=match (decodeCert.impl (toUtf8 not_a_cert) with what_should_work _ = this_should_work ++ this_should_not_work ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -42,7 +42,7 @@ what_should_work _ = this_should_work ++ this_should_not_work what_should_work : ∀ _. _ -> [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -217,7 +217,7 @@ testCNReject _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -237,7 +237,7 @@ testCNReject _ = testConnectSelfSigned : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts-using-base/utf8.output.md b/unison-src/transcripts-using-base/utf8.output.md index 0cd3d4c0d5..15c15c027e 100644 --- a/unison-src/transcripts-using-base/utf8.output.md +++ b/unison-src/transcripts-using-base/utf8.output.md @@ -2,7 +2,7 @@ Test for new Text -\> Bytes conversions explicitly using UTF-8 as the encoding Unison has function for converting between `Text` and a UTF-8 `Bytes` encoding of the Text. -```ucm +``` ucm scratch/main> find Utf8 1. builtin.Text.toUtf8 : Text -> Bytes @@ -21,7 +21,7 @@ ascii = "ABCDE" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -51,7 +51,7 @@ greek = "ΑΒΓΔΕ" > toUtf8 greek ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -86,7 +86,7 @@ greek = "ΑΒΓΔΕ" test> greekTest = checkRoundTrip greek ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -121,7 +121,7 @@ greek_bytes = Bytes.fromList [206, 145, 206, 146, 206, 147, 206, 148, 206] ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/abilities.output.md b/unison-src/transcripts/abilities.output.md index 52428c98f8..aa162e135b 100644 --- a/unison-src/transcripts/abilities.output.md +++ b/unison-src/transcripts/abilities.output.md @@ -16,7 +16,7 @@ ha = cases { four i -> c } -> handle c (j k l -> i+j+k+l) with ha ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -30,7 +30,7 @@ ha = cases ha : Request {A} r -> r ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md index 7b98c2065e..a61dd00459 100644 --- a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md +++ b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md @@ -14,7 +14,7 @@ term2 : () ->{Bar, Foo} () term2 _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -30,7 +30,7 @@ term2 _ = () term2 : '{Bar, Foo} () ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/ability-term-conflicts-on-update.output.md b/unison-src/transcripts/ability-term-conflicts-on-update.output.md index a9bba9dbfe..f5580e7b80 100644 --- a/unison-src/transcripts/ability-term-conflicts-on-update.output.md +++ b/unison-src/transcripts/ability-term-conflicts-on-update.output.md @@ -10,7 +10,7 @@ unique ability Channels where send : a -> {Channels} () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,7 +23,7 @@ unique ability Channels where ability Channels ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -46,7 +46,7 @@ thing : '{Channels} () thing _ = send 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -67,7 +67,7 @@ thing _ = send 1 ``` These should fail with a term/ctor conflict since we exclude the ability from the update. -```ucm +``` ucm scratch/main> update.old patch Channels.send x These definitions failed: @@ -102,7 +102,7 @@ thing : '{Channels} () thing _ = send 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -121,7 +121,7 @@ thing _ = send 1 ``` These updates should succeed since `Channels` is a dependency. -```ucm +``` ucm scratch/main> update.old.preview patch Channels.send I found and typechecked these definitions in scratch.u. If you @@ -152,7 +152,7 @@ scratch/main> update.old.preview patch thing ``` We should also be able to successfully update the whole thing. -```ucm +``` ucm scratch/main> update.old ⊡ Ignored previously added definitions: Channels @@ -169,7 +169,7 @@ scratch/main> update.old X.x = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -182,7 +182,7 @@ X.x = 1 X.x : Nat ``` -```ucm +``` ucm scratch/main2> add ⍟ I've added these definitions: @@ -195,7 +195,7 @@ structural ability X where x : () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -214,7 +214,7 @@ structural ability X where ``` This should fail with a ctor/term conflict. -```ucm +``` ucm scratch/main2> add x These definitions failed: diff --git a/unison-src/transcripts/add-run.output.md b/unison-src/transcripts/add-run.output.md index c1802922f6..acf50c24d8 100644 --- a/unison-src/transcripts/add-run.output.md +++ b/unison-src/transcripts/add-run.output.md @@ -13,7 +13,7 @@ is2even : 'Boolean is2even = '(even 2) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -30,7 +30,7 @@ is2even = '(even 2) ``` it errors if there isn't a previous run -```ucm +``` ucm scratch/main> add.run foo ⚠️ @@ -39,7 +39,7 @@ scratch/main> add.run foo something before attempting to save it. ``` -```ucm +``` ucm scratch/main> run is2even true @@ -48,7 +48,7 @@ scratch/main> run is2even it errors if the desired result name conflicts with a name in the unison file -```ucm +``` ucm scratch/main> add.run is2even ⚠️ @@ -59,7 +59,7 @@ scratch/main> add.run is2even ``` otherwise, the result is successfully persisted -```ucm +``` ucm scratch/main> add.run foo.bar.baz ⍟ I've added these definitions: @@ -67,7 +67,7 @@ scratch/main> add.run foo.bar.baz foo.bar.baz : Boolean ``` -```ucm +``` ucm scratch/main> view foo.bar.baz foo.bar.baz : Boolean @@ -87,7 +87,7 @@ main : '{IO, Exception} (Nat -> Nat -> Nat) main _ = y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -102,7 +102,7 @@ main _ = y z : Nat -> Nat ``` -```ucm +``` ucm scratch/main> run main a b -> a Nat.+ b Nat.+ z 10 @@ -122,7 +122,7 @@ inc : Nat -> Nat inc x = x + 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -135,7 +135,7 @@ inc x = x + 1 inc : Nat -> Nat ``` -```ucm +``` ucm scratch/main> add inc ⍟ I've added these definitions: @@ -148,7 +148,7 @@ main : '(Nat -> Nat) main _ x = inc x ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -161,7 +161,7 @@ main _ x = inc x main : '(Nat -> Nat) ``` -```ucm +``` ucm scratch/main> run main inc @@ -186,7 +186,7 @@ y = x + x main = 'y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -201,7 +201,7 @@ main = 'y y : Nat ``` -```ucm +``` ucm scratch/main> run main 2 @@ -211,7 +211,7 @@ scratch/main> run main x = 50 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -226,7 +226,7 @@ x = 50 ``` this saves 2 to xres, rather than 100 -```ucm +``` ucm scratch/main> add.run xres ⍟ I've added these definitions: @@ -245,7 +245,7 @@ scratch/main> view xres main = '5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -258,7 +258,7 @@ main = '5 main : 'Nat ``` -```ucm +``` ucm scratch/main> run main 5 @@ -279,7 +279,7 @@ scratch/main> add.run xres main = '5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -292,7 +292,7 @@ main = '5 main : 'Nat ``` -```ucm +``` ucm .> run main 5 diff --git a/unison-src/transcripts/add-test-watch-roundtrip.output.md b/unison-src/transcripts/add-test-watch-roundtrip.output.md index e276eba244..5366a47342 100644 --- a/unison-src/transcripts/add-test-watch-roundtrip.output.md +++ b/unison-src/transcripts/add-test-watch-roundtrip.output.md @@ -5,7 +5,7 @@ foo = [] Apparently when we add a test watch, we add a type annotation to it, even if it already has one. We don't want this to happen though\! -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/addupdatemessages.output.md b/unison-src/transcripts/addupdatemessages.output.md index 813639f58d..cbf0552713 100644 --- a/unison-src/transcripts/addupdatemessages.output.md +++ b/unison-src/transcripts/addupdatemessages.output.md @@ -10,7 +10,7 @@ structural type X = One Nat structural type Y = Two Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -28,7 +28,7 @@ structural type Y = Two Nat Nat ``` Expected: `x` and `y`, `X`, and `Y` exist as above. UCM tells you this. -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -47,7 +47,7 @@ z = 1 structural type Z = One Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -66,7 +66,7 @@ structural type Z = One Nat Expected: `z` is now `1`. UCM tells you that this definition is also called `x`. Also, `Z` is an alias for `X`. -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -84,7 +84,7 @@ x = 3 structural type X = Three Nat Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -103,7 +103,7 @@ structural type X = Three Nat Nat Nat ``` Expected: `x` is now `3` and `X` has constructor `Three`. UCM tells you the old definitions were also called `z` and `Z` and these names have also been updated. -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be @@ -123,7 +123,7 @@ x = 2 structural type X = Two Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -142,7 +142,7 @@ structural type X = Two Nat Nat ``` Expected: `x` is now `2` and `X` is `Two`. UCM says the old definition was also named `z/Z`, and was also updated. And it says the new definition is also named `y/Y`. -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/alias-many.output.md b/unison-src/transcripts/alias-many.output.md index 942539b629..4a20a354c2 100644 --- a/unison-src/transcripts/alias-many.output.md +++ b/unison-src/transcripts/alias-many.output.md @@ -10,7 +10,7 @@ The names that will be used in the target namespace are the names you specify, r Let's try it\! -```ucm +``` ucm scratch/main> alias.many List.adjacentPairs List.all List.any List.chunk List.chunksOf List.dropWhile List.first List.init List.intersperse List.isEmpty List.last List.replicate List.splitAt List.tail List.takeWhile mylib Here's what changed in mylib : diff --git a/unison-src/transcripts/alias-term.output.md b/unison-src/transcripts/alias-term.output.md index d072506cb0..2c120239e2 100644 --- a/unison-src/transcripts/alias-term.output.md +++ b/unison-src/transcripts/alias-term.output.md @@ -1,6 +1,6 @@ `alias.term` makes a new name for a term. -```ucm +``` ucm project/main> alias.term lib.builtins.bug foo Done. @@ -13,7 +13,7 @@ project/main> ls ``` It won't create a conflicted name, though. -```ucm +``` ucm project/main> alias.term lib.builtins.todo foo ⚠️ @@ -21,7 +21,7 @@ project/main> alias.term lib.builtins.todo foo A term by that name already exists. ``` -```ucm +``` ucm project/main> ls 1. foo (a -> b) @@ -30,7 +30,7 @@ project/main> ls ``` You can use `debug.alias.term.force` for that. -```ucm +``` ucm project/main> debug.alias.term.force lib.builtins.todo foo Done. diff --git a/unison-src/transcripts/alias-type.output.md b/unison-src/transcripts/alias-type.output.md index 820c817614..79a2fbcd7a 100644 --- a/unison-src/transcripts/alias-type.output.md +++ b/unison-src/transcripts/alias-type.output.md @@ -1,6 +1,6 @@ `alias.type` makes a new name for a type. -```ucm +``` ucm project/main> alias.type lib.builtins.Nat Foo Done. @@ -13,7 +13,7 @@ project/main> ls ``` It won't create a conflicted name, though. -```ucm +``` ucm project/main> alias.type lib.builtins.Int Foo ⚠️ @@ -21,7 +21,7 @@ project/main> alias.type lib.builtins.Int Foo A type by that name already exists. ``` -```ucm +``` ucm project/main> ls 1. Foo (builtin type) @@ -30,7 +30,7 @@ project/main> ls ``` You can use `debug.alias.type.force` for that. -```ucm +``` ucm project/main> debug.alias.type.force lib.builtins.Int Foo Done. diff --git a/unison-src/transcripts/anf-tests.output.md b/unison-src/transcripts/anf-tests.output.md index b1dc2f599f..0a1242dda9 100644 --- a/unison-src/transcripts/anf-tests.output.md +++ b/unison-src/transcripts/anf-tests.output.md @@ -23,7 +23,7 @@ foo _ = > !foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -43,7 +43,7 @@ foo _ = 5 ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/any-extract.output.md b/unison-src/transcripts/any-extract.output.md index 8f3488cb49..342ef3fbbc 100644 --- a/unison-src/transcripts/any-extract.output.md +++ b/unison-src/transcripts/any-extract.output.md @@ -11,7 +11,7 @@ test> Any.unsafeExtract.works = ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -31,7 +31,7 @@ test> Any.unsafeExtract.works = ✅ Passed Passed ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/api-doc-rendering.output.md b/unison-src/transcripts/api-doc-rendering.output.md index 8afef59e8c..271fac7840 100644 --- a/unison-src/transcripts/api-doc-rendering.output.md +++ b/unison-src/transcripts/api-doc-rendering.output.md @@ -77,7 +77,7 @@ Transclusion/evaluation: term = 42 ``` -```ucm +``` ucm scratch/main> display term.doc # Heading @@ -146,7 +146,7 @@ scratch/main> display term.doc message ``` -```api +``` api GET /api/projects/scratch/branches/main/getDefinition?names=term { "missingDefinitions": [], diff --git a/unison-src/transcripts/api-find.output.md b/unison-src/transcripts/api-find.output.md index aecfe603a2..24c34c837e 100644 --- a/unison-src/transcripts/api-find.output.md +++ b/unison-src/transcripts/api-find.output.md @@ -7,7 +7,7 @@ joey.httpServer.z = 44 joey.yaml.zz = 45 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,7 +23,7 @@ joey.yaml.zz = 45 ross.httpClient.y : ##Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -34,7 +34,7 @@ scratch/main> add ross.httpClient.y : ##Nat ``` -```api +``` api -- Namespace segment prefix search GET /api/projects/scratch/branches/main/find?query=http [ diff --git a/unison-src/transcripts/api-getDefinition.output.md b/unison-src/transcripts/api-getDefinition.output.md index bf244e4a06..6daa80c011 100644 --- a/unison-src/transcripts/api-getDefinition.output.md +++ b/unison-src/transcripts/api-getDefinition.output.md @@ -5,7 +5,7 @@ nested.names.x.doc = {{ Documentation }} nested.names.x = 42 ``` -```api +``` api -- Should NOT find names by suffix GET /api/projects/scratch/branches/main/getDefinition?names=x { @@ -216,7 +216,7 @@ doctest.otherstuff.thing = "A different thing" Only docs for the term we request should be returned, even if there are other term docs with the same suffix. -```api +``` api GET /api/projects/scratch/branches/main/getDefinition?names=thing&relativeTo=doctest { "missingDefinitions": [], @@ -334,7 +334,7 @@ GET /api/projects/scratch/branches/main/getDefinition?names=thing&relativeTo=doc } ```If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. -```api +``` api GET /api/projects/scratch/branches/main/getDefinition?names=thing.doc&relativeTo=doctest { "missingDefinitions": [], diff --git a/unison-src/transcripts/api-list-projects-branches.output.md b/unison-src/transcripts/api-list-projects-branches.output.md index b3c09895da..5768b6454d 100644 --- a/unison-src/transcripts/api-list-projects-branches.output.md +++ b/unison-src/transcripts/api-list-projects-branches.output.md @@ -1,6 +1,6 @@ # List Projects And Branches Test -```api +``` api -- Should list all projects GET /api/projects [ diff --git a/unison-src/transcripts/api-namespace-details.output.md b/unison-src/transcripts/api-namespace-details.output.md index 593efac4fd..124c28e5d5 100644 --- a/unison-src/transcripts/api-namespace-details.output.md +++ b/unison-src/transcripts/api-namespace-details.output.md @@ -9,7 +9,7 @@ Here's a *README*! }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ Here's a *README*! nested.names.x.doc : Doc2 ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -34,7 +34,7 @@ scratch/main> add nested.names.x.doc : Doc2 ``` -```api +``` api -- Should find names by suffix GET /api/projects/scratch/branches/main/namespaces/nested.names { diff --git a/unison-src/transcripts/api-namespace-list.output.md b/unison-src/transcripts/api-namespace-list.output.md index 6116dad617..1378a7d36f 100644 --- a/unison-src/transcripts/api-namespace-list.output.md +++ b/unison-src/transcripts/api-namespace-list.output.md @@ -7,7 +7,7 @@ nested.names.x = 42 nested.names.readme = {{ I'm a readme! }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,7 +22,7 @@ nested.names.readme = {{ I'm a readme! }} nested.names.x.doc : Doc2 ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -32,7 +32,7 @@ scratch/main> add nested.names.x.doc : Doc2 ``` -```api +``` api GET /api/projects/scratch/branches/main/list?namespace=nested.names { "namespaceListingChildren": [ diff --git a/unison-src/transcripts/api-summaries.output.md b/unison-src/transcripts/api-summaries.output.md index de7e14c3aa..115dba15a8 100644 --- a/unison-src/transcripts/api-summaries.output.md +++ b/unison-src/transcripts/api-summaries.output.md @@ -21,7 +21,7 @@ structural ability Stream s where ## Term Summary APIs -```api +``` api -- term GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat { @@ -669,7 +669,7 @@ GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@@IO.putBytes. } ```## Type Summary APIs -```api +``` api -- data GET /api/projects/scratch/branches/main/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing { diff --git a/unison-src/transcripts/block-on-required-update.output.md b/unison-src/transcripts/block-on-required-update.output.md index 49e1332464..20560c94c4 100644 --- a/unison-src/transcripts/block-on-required-update.output.md +++ b/unison-src/transcripts/block-on-required-update.output.md @@ -6,7 +6,7 @@ Should block an `add` if it requires an update on an in-file dependency. x = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ x = 1 x : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -34,7 +34,7 @@ x = 10 y = x + 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -54,7 +54,7 @@ y = x + 1 ``` Try to add only the new `y`. This should fail because it requires an update to `x`, but we only ran an 'add'. -```ucm +``` ucm scratch/main> add y x These definitions failed: diff --git a/unison-src/transcripts/blocks.output.md b/unison-src/transcripts/blocks.output.md index b017e0cfc9..f52ca4f259 100644 --- a/unison-src/transcripts/blocks.output.md +++ b/unison-src/transcripts/blocks.output.md @@ -15,7 +15,7 @@ ex thing = > ex "hello" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -48,7 +48,7 @@ ex thing = > ex "hello" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -83,7 +83,7 @@ ex thing = > ex (x -> x * 100) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -115,7 +115,7 @@ ex thing = > ex (x -> x * 100) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -154,7 +154,7 @@ ex n = ping 42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -181,7 +181,7 @@ ex n = ping 0 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -205,7 +205,7 @@ ex n = pong ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -223,7 +223,7 @@ ex n = loop ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -240,7 +240,7 @@ ex n = !loop ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -269,7 +269,7 @@ ex n = zap1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -293,7 +293,7 @@ ex n = zap1 "pluto" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -322,7 +322,7 @@ ex n = ping 42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -349,7 +349,7 @@ ex n = ping 42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/boolean-op-pretty-print-2819.output.md b/unison-src/transcripts/boolean-op-pretty-print-2819.output.md index 7fe8f92cfe..b840f4bbc0 100644 --- a/unison-src/transcripts/boolean-op-pretty-print-2819.output.md +++ b/unison-src/transcripts/boolean-op-pretty-print-2819.output.md @@ -7,7 +7,7 @@ hangExample = && ("a long piece of text to hang the line" == "") ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -20,7 +20,7 @@ hangExample = hangExample : Boolean ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/branch-command.output.md b/unison-src/transcripts/branch-command.output.md index 569ab5d760..6a78b8e723 100644 --- a/unison-src/transcripts/branch-command.output.md +++ b/unison-src/transcripts/branch-command.output.md @@ -6,7 +6,7 @@ First, we'll create a term to include in the branches. someterm = 18 ``` -```ucm +``` ucm scratch/main> builtins.merge lib.builtins Done. @@ -23,7 +23,7 @@ Now, the `branch` demo: `branch` can create a branch from a different branch in the same project, from a different branch in a different project. It can also create an empty branch. -```ucm +``` ucm foo/main> branch topic1 Done. I've created the topic1 branch based off of main. @@ -151,7 +151,7 @@ scratch/main> branch.empty foo/empty4 ``` The `branch` command can create branches named `releases/drafts/*` (because why not). -```ucm +``` ucm foo/main> branch releases/drafts/1.2.3 Done. I've created the releases/drafts/1.2.3 branch based off @@ -165,7 +165,7 @@ foo/main> switch /releases/drafts/1.2.3 ``` The `branch` command can't create branches named `releases/*` nor `releases/drafts/*`. -```ucm +``` ucm foo/main> branch releases/1.2.3 Branch names like releases/1.2.3 are reserved for releases. diff --git a/unison-src/transcripts/branch-relative-path.output.md b/unison-src/transcripts/branch-relative-path.output.md index 591fa64f8e..e9e33b5ad9 100644 --- a/unison-src/transcripts/branch-relative-path.output.md +++ b/unison-src/transcripts/branch-relative-path.output.md @@ -3,7 +3,7 @@ foo = 5 foo.bar = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,7 +17,7 @@ foo.bar = 1 foo.bar : ##Nat ``` -```ucm +``` ucm p0/main> add ⍟ I've added these definitions: @@ -31,7 +31,7 @@ bonk = 5 donk.bonk = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -47,7 +47,7 @@ donk.bonk = 1 (also named foo.bar) ``` -```ucm +``` ucm p1/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/bug-fix-4354.output.md b/unison-src/transcripts/bug-fix-4354.output.md index 8ef9e7370f..110aca0022 100644 --- a/unison-src/transcripts/bug-fix-4354.output.md +++ b/unison-src/transcripts/bug-fix-4354.output.md @@ -8,7 +8,7 @@ bonk x = x ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md index 91f7ce9980..ebd96be4a5 100644 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ b/unison-src/transcripts/bug-strange-closure.output.md @@ -1,6 +1,6 @@ We can display the guide before and after adding it to the codebase: -```ucm +``` ucm .> display doc.guide # Unison computable documentation @@ -417,7 +417,7 @@ But we can't display this due to a decompilation problem. rendered = Pretty.get (docFormatConsole doc.guide) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -430,7 +430,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) rendered : Annotated () (Either SpecialForm ConsoleText) ``` -```ucm +``` ucm .> display rendered # Unison computable documentation @@ -850,7 +850,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) > rendered ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/builtins-merge.output.md b/unison-src/transcripts/builtins-merge.output.md index b79bdab58d..8147375776 100644 --- a/unison-src/transcripts/builtins-merge.output.md +++ b/unison-src/transcripts/builtins-merge.output.md @@ -1,6 +1,6 @@ The `builtins.merge` command adds the known builtins to the specified subnamespace within the current namespace. -```ucm +``` ucm scratch/main> builtins.merge builtins Done. diff --git a/unison-src/transcripts/builtins.output.md b/unison-src/transcripts/builtins.output.md index 5ddc4b7659..3a4538f30a 100644 --- a/unison-src/transcripts/builtins.output.md +++ b/unison-src/transcripts/builtins.output.md @@ -363,7 +363,7 @@ test> Any.test1 = checks [(Any "hi" == Any "hi")] test> Any.test2 = checks [(not (Any "hi" == Any 42))] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -415,7 +415,7 @@ test> Sandbox.test3 = checks [validateSandboxed [termLink openFile.impl] openFile] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -468,7 +468,7 @@ openFilesIO = do ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -481,7 +481,7 @@ openFilesIO = do openFilesIO : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -508,7 +508,7 @@ Just exercises the function test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Universal.murmurHash [1,2,3]] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -536,7 +536,7 @@ test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Unive Now that all the tests have been added to the codebase, let's view the test report. This will fail the transcript (with a nice message) if any of the tests are failing. -```ucm +``` ucm scratch/main> test Cached test results (`help testcache` to learn more) diff --git a/unison-src/transcripts/bytesFromList.output.md b/unison-src/transcripts/bytesFromList.output.md index 099a73cb59..b4a9782215 100644 --- a/unison-src/transcripts/bytesFromList.output.md +++ b/unison-src/transcripts/bytesFromList.output.md @@ -4,7 +4,7 @@ This should render as `Bytes.fromList [1,2,3,4]`, not `##Bytes.fromSequence [1,2 > Bytes.fromList [1,2,3,4] ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/check763.output.md b/unison-src/transcripts/check763.output.md index 0d5dcc0ba2..7975553f1d 100644 --- a/unison-src/transcripts/check763.output.md +++ b/unison-src/transcripts/check763.output.md @@ -5,7 +5,7 @@ Regression test for https://github.com/unisonweb/unison/issues/763 (+-+) x y = x * y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,7 +18,7 @@ Regression test for https://github.com/unisonweb/unison/issues/763 +-+ : Nat -> Nat -> Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/check873.output.md b/unison-src/transcripts/check873.output.md index cc952accaf..fa6f046e80 100644 --- a/unison-src/transcripts/check873.output.md +++ b/unison-src/transcripts/check873.output.md @@ -4,7 +4,7 @@ See [this ticket](https://github.com/unisonweb/unison/issues/873); the point bei (-) = builtin.Nat.sub ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,7 +17,7 @@ See [this ticket](https://github.com/unisonweb/unison/issues/873); the point bei - : Nat -> Nat -> Int ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -29,7 +29,7 @@ scratch/main> add baz x = x - 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/constructor-applied-to-unit.output.md b/unison-src/transcripts/constructor-applied-to-unit.output.md index 04cc3c417a..e12d3f1d43 100644 --- a/unison-src/transcripts/constructor-applied-to-unit.output.md +++ b/unison-src/transcripts/constructor-applied-to-unit.output.md @@ -5,7 +5,7 @@ structural type Zoink a b c = Zoink a b c > [ Zoink [0,1,2,3,4,5] [6,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,3] () ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/contrabilities.output.md b/unison-src/transcripts/contrabilities.output.md index f3b76a8c5e..ef0f98dffa 100644 --- a/unison-src/transcripts/contrabilities.output.md +++ b/unison-src/transcripts/contrabilities.output.md @@ -3,7 +3,7 @@ f : (() -> a) -> Nat f x = 42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/create-author.output.md b/unison-src/transcripts/create-author.output.md index a71fca7b13..caa4d2740d 100644 --- a/unison-src/transcripts/create-author.output.md +++ b/unison-src/transcripts/create-author.output.md @@ -1,6 +1,6 @@ Demonstrating `create.author`: -```ucm +``` ucm scratch/main> create.author alicecoder "Alice McGee" Added definitions: diff --git a/unison-src/transcripts/cycle-update-1.output.md b/unison-src/transcripts/cycle-update-1.output.md index 3cfeca6fc2..b5dd6e69aa 100644 --- a/unison-src/transcripts/cycle-update-1.output.md +++ b/unison-src/transcripts/cycle-update-1.output.md @@ -8,7 +8,7 @@ pong : 'Nat pong _ = !ping + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,7 +22,7 @@ pong _ = !ping + 2 pong : 'Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -36,7 +36,7 @@ ping : 'Nat ping _ = !pong + 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,7 +50,7 @@ ping _ = !pong + 3 ping : 'Nat ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/cycle-update-2.output.md b/unison-src/transcripts/cycle-update-2.output.md index 11b97f14d8..b9bdc363fd 100644 --- a/unison-src/transcripts/cycle-update-2.output.md +++ b/unison-src/transcripts/cycle-update-2.output.md @@ -8,7 +8,7 @@ pong : 'Nat pong _ = !ping + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,7 +22,7 @@ pong _ = !ping + 2 pong : 'Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -36,7 +36,7 @@ ping : 'Nat ping _ = 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,7 +50,7 @@ ping _ = 3 ping : 'Nat ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/cycle-update-3.output.md b/unison-src/transcripts/cycle-update-3.output.md index cf8c1c72ca..15b0e26624 100644 --- a/unison-src/transcripts/cycle-update-3.output.md +++ b/unison-src/transcripts/cycle-update-3.output.md @@ -8,7 +8,7 @@ pong : 'Nat pong _ = !ping + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,7 +22,7 @@ pong _ = !ping + 2 pong : 'Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -36,7 +36,7 @@ ping : Nat ping = 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,7 +50,7 @@ ping = 3 ping : Nat ``` -```ucm +``` ucm scratch/main> update.old ⍟ I've updated these names to your new definition: diff --git a/unison-src/transcripts/cycle-update-4.output.md b/unison-src/transcripts/cycle-update-4.output.md index c3bcccbd1c..2fec74ba80 100644 --- a/unison-src/transcripts/cycle-update-4.output.md +++ b/unison-src/transcripts/cycle-update-4.output.md @@ -8,7 +8,7 @@ pong : 'Nat pong _ = !ping + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,7 +22,7 @@ pong _ = !ping + 2 pong : 'Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -39,7 +39,7 @@ clang : 'Nat clang _ = !pong + 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -57,7 +57,7 @@ clang _ = !pong + 3 ping : 'Nat ``` -```ucm +``` ucm scratch/main> update.old ping ⍟ I've added these definitions: diff --git a/unison-src/transcripts/cycle-update-5.output.md b/unison-src/transcripts/cycle-update-5.output.md index a022fbed62..64f50af577 100644 --- a/unison-src/transcripts/cycle-update-5.output.md +++ b/unison-src/transcripts/cycle-update-5.output.md @@ -8,7 +8,7 @@ pong : 'Nat pong _ = !inner.ping + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,7 +22,7 @@ pong _ = !inner.ping + 2 pong : 'Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -39,7 +39,7 @@ inner.ping : 'Nat inner.ping _ = !pong + 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -53,7 +53,7 @@ inner.ping _ = !pong + 3 inner.ping : 'Nat ``` -```ucm +``` ucm ☝️ The namespace .inner is empty. .inner> update.old diff --git a/unison-src/transcripts/debug-definitions.output.md b/unison-src/transcripts/debug-definitions.output.md index 8689d2d780..9c4bb349c5 100644 --- a/unison-src/transcripts/debug-definitions.output.md +++ b/unison-src/transcripts/debug-definitions.output.md @@ -12,7 +12,7 @@ ability Ask a where ask : a ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/debug-name-diffs.output.md b/unison-src/transcripts/debug-name-diffs.output.md index 0333dee6b9..beed0b4cc7 100644 --- a/unison-src/transcripts/debug-name-diffs.output.md +++ b/unison-src/transcripts/debug-name-diffs.output.md @@ -9,7 +9,7 @@ structural type a.x.Foo = Foo | Bar structural type a.b.Baz = Boo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,7 +27,7 @@ structural type a.b.Baz = Boo a.x.three : ##Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/deep-names.output.md b/unison-src/transcripts/deep-names.output.md index dcaf16dbea..114133d786 100644 --- a/unison-src/transcripts/deep-names.output.md +++ b/unison-src/transcripts/deep-names.output.md @@ -14,7 +14,7 @@ http.z = 8 Our `app1` project includes the text library twice and the http library twice as direct dependencies. -```ucm +``` ucm scratch/app1> fork text lib.text_v1 Done. @@ -42,7 +42,7 @@ scratch/app1> delete.namespace http ``` As such, we see two copies of `a` and two copies of `x` via these direct dependencies. -```ucm +``` ucm scratch/app1> names a Term @@ -63,7 +63,7 @@ scratch/app1> names x Our `app2` project includes the `http` library twice as direct dependencies, and once as an indirect dependency via `webutil`. It also includes the `text` library twice as indirect dependencies via `webutil` -```ucm +``` ucm scratch/app2> fork http lib.http_v1 Done. @@ -96,7 +96,7 @@ scratch/app2> delete.namespace text Now we see two copies of `x` via direct dependencies on `http`, and one copy of `a` via indirect dependency on `text` via `webutil`. We see neither the second indirect copy of `a` nor the indirect copy of `x` via webutil because we already have names for them. -```ucm +``` ucm scratch/app2> names a Term diff --git a/unison-src/transcripts/definition-diff-api.output.md b/unison-src/transcripts/definition-diff-api.output.md index 460e84d807..8d55cc7850 100644 --- a/unison-src/transcripts/definition-diff-api.output.md +++ b/unison-src/transcripts/definition-diff-api.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm diffs/main> builtins.merge Done. @@ -12,7 +12,7 @@ term = type Type = Type Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ type Type = Type Nat term : Nat ``` -```ucm +``` ucm diffs/main> add ⍟ I've added these definitions: @@ -50,7 +50,7 @@ term = type Type a = Type a Text ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -65,7 +65,7 @@ type Type a = Type a Text term : Nat ``` -```ucm +``` ucm diffs/new> update Okay, I'm searching the branch for code that needs to be @@ -76,7 +76,7 @@ diffs/new> update ``` Diff terms -```api +``` api GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=term&newTerm=term { "diff": { @@ -560,7 +560,7 @@ GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=te } ```Diff types -```api +``` api GET /api/projects/diffs/diff/types?oldBranchRef=main&newBranchRef=new&oldType=Type&newType=Type { "diff": { diff --git a/unison-src/transcripts/delete-namespace-dependents-check.output.md b/unison-src/transcripts/delete-namespace-dependents-check.output.md index ce131fcb71..1343731033 100644 --- a/unison-src/transcripts/delete-namespace-dependents-check.output.md +++ b/unison-src/transcripts/delete-namespace-dependents-check.output.md @@ -10,7 +10,7 @@ sub.dependency = 123 dependent = dependency + 99 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ dependent = dependency + 99 sub.dependency : Nat ``` -```ucm +``` ucm myproject/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/delete-namespace.output.md b/unison-src/transcripts/delete-namespace.output.md index a57094d9eb..288160895c 100644 --- a/unison-src/transcripts/delete-namespace.output.md +++ b/unison-src/transcripts/delete-namespace.output.md @@ -12,7 +12,7 @@ dependents.usage2 = dependencies.term1 * dependencies.term2 Deleting a namespace with no external dependencies should succeed. -```ucm +``` ucm scratch/main> delete.namespace no_dependencies Done. @@ -20,7 +20,7 @@ scratch/main> delete.namespace no_dependencies ``` Deleting a namespace with external dependencies should fail and list all dependents. -```ucm +``` ucm scratch/main> delete.namespace dependencies ⚠️ @@ -41,7 +41,7 @@ scratch/main> delete.namespace dependencies ``` Deleting a namespace with external dependencies should succeed when using `delete.namespace.force` -```ucm +``` ucm scratch/main> delete.namespace.force dependencies Done. @@ -61,7 +61,7 @@ scratch/main> delete.namespace.force dependencies ``` I should be able to view an affected dependency by number -```ucm +``` ucm scratch/main> view 2 dependents.usage2 : Nat @@ -72,7 +72,7 @@ scratch/main> view 2 ``` Deleting the root namespace should require confirmation if not forced. -```ucm +``` ucm scratch/main> delete.namespace . ⚠️ @@ -94,7 +94,7 @@ scratch/main> history . ``` Deleting the root namespace shouldn't require confirmation if forced. -```ucm +``` ucm scratch/main> delete.namespace.force . Okay, I deleted everything except the history. Use `undo` to diff --git a/unison-src/transcripts/delete-project-branch.output.md b/unison-src/transcripts/delete-project-branch.output.md index 84568c97da..755d5f0c70 100644 --- a/unison-src/transcripts/delete-project-branch.output.md +++ b/unison-src/transcripts/delete-project-branch.output.md @@ -1,7 +1,7 @@ Deleting the branch you are on takes you to its parent (though this is impossible to see in a transcript, since we set your working directory with each command). -```ucm +``` ucm foo/main> branch topic Done. I've created the topic branch based off of main. @@ -14,7 +14,7 @@ foo/topic> delete.branch /topic ``` A branch need not be preceded by a forward slash. -```ucm +``` ucm foo/main> branch topic Done. I've created the topic branch based off of main. @@ -27,7 +27,7 @@ foo/topic> delete.branch topic ``` You can precede the branch name by a project name. -```ucm +``` ucm foo/main> branch topic Done. I've created the topic branch based off of main. @@ -40,7 +40,7 @@ scratch/main> delete.branch foo/topic ``` You can delete the only branch in a project. -```ucm +``` ucm foo/main> delete.branch /main ``` diff --git a/unison-src/transcripts/delete-project.output.md b/unison-src/transcripts/delete-project.output.md index e2b974a9ca..2ee362e503 100644 --- a/unison-src/transcripts/delete-project.output.md +++ b/unison-src/transcripts/delete-project.output.md @@ -1,6 +1,6 @@ # delete.project -```ucm +``` ucm scratch/main> project.create-empty foo 🎉 I've created the project foo. diff --git a/unison-src/transcripts/delete-silent.output.md b/unison-src/transcripts/delete-silent.output.md index 899a38b3be..49c5a0860d 100644 --- a/unison-src/transcripts/delete-silent.output.md +++ b/unison-src/transcripts/delete-silent.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> delete foo ⚠️ @@ -12,7 +12,7 @@ foo = 1 structural type Foo = Foo () ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/delete.output.md b/unison-src/transcripts/delete.output.md index 853f2ee386..178e92797d 100644 --- a/unison-src/transcripts/delete.output.md +++ b/unison-src/transcripts/delete.output.md @@ -5,7 +5,7 @@ The delete command can delete both terms and types. First, let's make sure it complains when we try to delete a name that doesn't exist. -```ucm +``` ucm .> delete.verbose foo ⚠️ @@ -22,7 +22,7 @@ foo = 1 structural type Foo = Foo () ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -62,7 +62,7 @@ foo = 1 bar = 2 ``` -```ucm +``` ucm ☝️ The namespace .a is empty. .a> add @@ -79,7 +79,7 @@ bar = 2 ``` A delete should remove both versions of the term. -```ucm +``` ucm .> delete.verbose a.foo Removed definitions: @@ -106,7 +106,7 @@ structural type Foo = Foo () structural type Bar = Bar ``` -```ucm +``` ucm .a> add ⍟ I've added these definitions: @@ -149,7 +149,7 @@ foo = 1 structural type foo = Foo () ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -175,7 +175,7 @@ b = "b" c = "c" ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -204,7 +204,7 @@ b = "b" c = "c" ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -242,7 +242,7 @@ We can delete a type and its constructors structural type Foo = Foo () ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -273,7 +273,7 @@ c = 3 d = a + b + c ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -306,7 +306,7 @@ g = 13 + f h = e + f + g ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -338,7 +338,7 @@ incrementFoo = cases (Foo n) -> n + 1 ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -366,7 +366,7 @@ g = 13 + f h = e + f + g ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -391,7 +391,7 @@ ping _ = 1 Nat.+ !pong pong _ = 4 Nat.+ !ping ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/dependents-dependencies-debugfile.output.md b/unison-src/transcripts/dependents-dependencies-debugfile.output.md index 19b2526d75..a02c491694 100644 --- a/unison-src/transcripts/dependents-dependencies-debugfile.output.md +++ b/unison-src/transcripts/dependents-dependencies-debugfile.output.md @@ -16,7 +16,7 @@ inside.q x = x + p * p inside.r = d ``` -```ucm +``` ucm scratch/main> debug.file type inside.M#h37a56c5ep @@ -35,7 +35,7 @@ This will help me make progress in some situations when UCM is being deficient o But wait, there's more. I can check the dependencies and dependents of a definition: -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/destructuring-binds.output.md b/unison-src/transcripts/destructuring-binds.output.md index ec7f39182e..371864ee95 100644 --- a/unison-src/transcripts/destructuring-binds.output.md +++ b/unison-src/transcripts/destructuring-binds.output.md @@ -14,7 +14,7 @@ ex1 tup = c + d ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -28,7 +28,7 @@ ex1 tup = ex1 : (a, b, (Nat, Nat)) -> Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -58,7 +58,7 @@ ex2 tup = match tup with (a, b, (c,d)) -> c + d ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -82,7 +82,7 @@ ex4 = "Doesn't typecheck" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -116,7 +116,7 @@ ex5a _ = match (99 + 1, "hi") with _ -> "impossible" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -130,7 +130,7 @@ ex5a _ = match (99 + 1, "hi") with ex5a : 'Text ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -162,7 +162,7 @@ ex6 x = match x with For clarity, the pretty-printer leaves this alone, even though in theory it could be written `(x,y) = x; x + y`: -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md index 2c327bc833..32cfbb27ba 100644 --- a/unison-src/transcripts/diff-namespace.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -6,7 +6,7 @@ b2.fslkdjflskdjflksjdf = 23 b2.abc = 23 ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -22,7 +22,7 @@ b2.abc = 23 Done. ``` -```ucm +``` ucm .> diff.namespace b1 b2 Resolved name conflicts: @@ -78,7 +78,7 @@ structural type A a = A () structural ability X a1 a2 where x : () ``` -```ucm +``` ucm ☝️ The namespace .ns1 is empty. .ns1> add @@ -108,7 +108,7 @@ structural ability X a1 a2 where x : () ``` Here's what we've done so far: -```ucm +``` ucm .> diff.namespace nothing ns1 ⚠️ @@ -116,7 +116,7 @@ Here's what we've done so far: The namespace .nothing is empty. Was there a typo? ``` -```ucm +``` ucm .> diff.namespace ns1 ns2 The namespaces are identical. @@ -126,7 +126,7 @@ Here's what we've done so far: junk = "asldkfjasldkfj" ``` -```ucm +``` ucm .ns1> add ⍟ I've added these definitions: @@ -151,7 +151,7 @@ f = 6 unique type Y a b = Y a b ``` -```ucm +``` ucm .ns2> update.old ⍟ I've added these definitions: @@ -287,7 +287,7 @@ unique type Y a b = Y a b bdependent = "banana" ``` -```ucm +``` ucm .ns3> update.old ⍟ I've updated these names to your new definition: @@ -321,7 +321,7 @@ a = 333 b = a + 1 ``` -```ucm +``` ucm ☝️ The namespace .nsx is empty. .nsx> add @@ -344,7 +344,7 @@ b = a + 1 a = 444 ``` -```ucm +``` ucm .nsy> update.old ⍟ I've updated these names to your new definition: @@ -356,7 +356,7 @@ a = 444 a = 555 ``` -```ucm +``` ucm .nsz> update.old ⍟ I've updated these names to your new definition: @@ -376,7 +376,7 @@ a = 555 Done. ``` -```ucm +``` ucm .> diff.namespace nsx nsw New name conflicts: @@ -416,7 +416,7 @@ a = 555 x = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -429,7 +429,7 @@ x = 1 x : ##Nat ``` -```ucm +``` ucm ☝️ The namespace .hashdiff is empty. .hashdiff> add @@ -443,7 +443,7 @@ x = 1 y = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -456,7 +456,7 @@ y = 2 y : ##Nat ``` -```ucm +``` ucm .hashdiff> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/doc-formatting.output.md b/unison-src/transcripts/doc-formatting.output.md index a99d2ca4ba..9a8d60c8bd 100644 --- a/unison-src/transcripts/doc-formatting.output.md +++ b/unison-src/transcripts/doc-formatting.output.md @@ -9,7 +9,7 @@ foo n = n + 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,7 +22,7 @@ foo n = foo : Nat -> Nat ``` -```ucm +``` ucm scratch/main> view foo foo : Nat -> Nat @@ -38,7 +38,7 @@ Note that `@` and `:]` must be escaped within docs. escaping = [: Docs look [: like \@this \:] :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -51,7 +51,7 @@ escaping = [: Docs look [: like \@this \:] :] escaping : Doc ``` -```ucm +``` ucm scratch/main> view escaping escaping : Doc @@ -70,7 +70,7 @@ commented = [: :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -83,7 +83,7 @@ commented = [: commented : Doc ``` -```ucm +``` ucm scratch/main> view commented commented : Doc @@ -105,7 +105,7 @@ Handling of indenting in docs between the parser and pretty-printer is a bit fid doc1 = [: hi :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -118,7 +118,7 @@ doc1 = [: hi :] doc1 : Doc ``` -```ucm +``` ucm scratch/main> view doc1 doc1 : Doc @@ -137,7 +137,7 @@ doc2 = [: hello and the rest. :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -150,7 +150,7 @@ doc2 = [: hello doc2 : Doc ``` -```ucm +``` ucm scratch/main> view doc2 doc2 : Doc @@ -176,7 +176,7 @@ Note that because of the special treatment of the first line mentioned above, wh :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -189,7 +189,7 @@ Note that because of the special treatment of the first line mentioned above, wh doc3 : Doc ``` -```ucm +``` ucm scratch/main> view doc3 doc3 : Doc @@ -223,7 +223,7 @@ doc4 = [: Here's another example of some paragraphs. - Apart from this one. :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -236,7 +236,7 @@ doc4 = [: Here's another example of some paragraphs. doc4 : Doc ``` -```ucm +``` ucm scratch/main> view doc4 doc4 : Doc @@ -258,7 +258,7 @@ doc5 = [: - foo and the rest. :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -271,7 +271,7 @@ doc5 = [: - foo doc5 : Doc ``` -```ucm +``` ucm scratch/main> view doc5 doc5 : Doc @@ -290,7 +290,7 @@ doc6 = [: :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -303,7 +303,7 @@ doc6 = [: doc6 : Doc ``` -```ucm +``` ucm scratch/main> view doc6 doc6 : Doc @@ -323,7 +323,7 @@ empty = [::] expr = foo 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -337,7 +337,7 @@ expr = foo 1 expr : Nat ``` -```ucm +``` ucm scratch/main> view empty empty : Doc @@ -384,7 +384,7 @@ para line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolo :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -397,7 +397,7 @@ para line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolo test1 : Doc ``` -```ucm +``` ucm scratch/main> view test1 test1 : Doc @@ -466,7 +466,7 @@ reg1363 = [: `@List.take foo` bar baz :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -479,7 +479,7 @@ reg1363 = [: `@List.take foo` bar reg1363 : Doc ``` -```ucm +``` ucm scratch/main> view reg1363 reg1363 : Doc @@ -496,7 +496,7 @@ test2 = [: :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -511,7 +511,7 @@ test2 = [: ``` View is fine. -```ucm +``` ucm scratch/main> view test2 test2 : Doc @@ -523,7 +523,7 @@ scratch/main> view test2 ``` But note it's not obvious how display should best be handling this. At the moment it just does the simplest thing: -```ucm +``` ucm scratch/main> display test2 Take a look at this: diff --git a/unison-src/transcripts/doc-type-link-keywords.output.md b/unison-src/transcripts/doc-type-link-keywords.output.md index 3229bed192..e1b04a715c 100644 --- a/unison-src/transcripts/doc-type-link-keywords.output.md +++ b/unison-src/transcripts/doc-type-link-keywords.output.md @@ -25,7 +25,7 @@ docs.example4 = {{A doc that links to the {type Labels} type}} Now we check that each doc links to the object of the correct name: -```ucm +``` ucm scratch/main> display docs.example1 A doc that links to the abilityPatterns term diff --git a/unison-src/transcripts/doc1.output.md b/unison-src/transcripts/doc1.output.md index bd5b5b2557..3c15677bab 100644 --- a/unison-src/transcripts/doc1.output.md +++ b/unison-src/transcripts/doc1.output.md @@ -2,7 +2,7 @@ Unison documentation is written in Unison. Documentation is a value of the following type: -```ucm +``` ucm scratch/main> view lib.builtins.Doc type lib.builtins.Doc @@ -26,7 +26,7 @@ Can link to definitions like @List.drop or @List :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -58,7 +58,7 @@ List.take.ex1 = take 0 [1,2,3,4,5] List.take.ex2 = take 2 [1,2,3,4,5] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -72,7 +72,7 @@ List.take.ex2 = take 2 [1,2,3,4,5] List.take.ex2 : [Nat] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -100,7 +100,7 @@ List.take.doc = [: :] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -115,7 +115,7 @@ List.take.doc = [: ``` Let's add it to the codebase. -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -125,7 +125,7 @@ scratch/main> add ``` We can view it with `docs`, which shows the `Doc` value that is associated with a definition. -```ucm +``` ucm scratch/main> docs List.take `List.take n xs` returns the first `n` elements of `xs`. (No @@ -150,7 +150,7 @@ scratch/main> docs List.take ``` Note that if we view the source of the documentation, the various references are *not* expanded. -```ucm +``` ucm scratch/main> view List.take builtin lib.builtins.List.take : diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md index 0d09b5618c..dc8330c537 100644 --- a/unison-src/transcripts/doc2.output.md +++ b/unison-src/transcripts/doc2.output.md @@ -109,7 +109,7 @@ Inline '' text literal with 1 space of padding '' in the middle of a sentence. Format it to check that everything pretty-prints in a valid way. -```ucm +``` ucm scratch/main> debug.format ``` diff --git a/unison-src/transcripts/doc2markdown.output.md b/unison-src/transcripts/doc2markdown.output.md index e670bff8cd..d8a6b69428 100644 --- a/unison-src/transcripts/doc2markdown.output.md +++ b/unison-src/transcripts/doc2markdown.output.md @@ -81,7 +81,7 @@ Table }} ``` -```ucm +``` ucm scratch/main> debug.doc-to-markdown fulldoc Heres some text with a soft line break @@ -174,7 +174,7 @@ unique type MyUniqueType = MyUniqueType structural type MyStructuralType = MyStructuralType ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md b/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md index 5bbf2fb0b2..9e369c57ca 100644 --- a/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md +++ b/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md @@ -8,7 +8,7 @@ lib.new.foo = 19 mything = lib.old.foo + lib.old.foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ mything = lib.old.foo + lib.old.foo mything : Nat ``` -```ucm +``` ucm foo/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/duplicate-names.output.md b/unison-src/transcripts/duplicate-names.output.md index a9d9f2ad0e..7e1e838515 100644 --- a/unison-src/transcripts/duplicate-names.output.md +++ b/unison-src/transcripts/duplicate-names.output.md @@ -10,7 +10,7 @@ Stream.send : a -> () Stream.send _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -33,7 +33,7 @@ X.x : a -> () X.x _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -55,7 +55,7 @@ structural ability X where x : () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -76,7 +76,7 @@ X.x.set = () X.x = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -109,7 +109,7 @@ structural type X = Z X = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -124,7 +124,7 @@ X = () X : () ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/duplicate-term-detection.output.md b/unison-src/transcripts/duplicate-term-detection.output.md index 3751e75f8f..b726a6a94d 100644 --- a/unison-src/transcripts/duplicate-term-detection.output.md +++ b/unison-src/transcripts/duplicate-term-detection.output.md @@ -7,7 +7,7 @@ x = 1 x = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ x = 1 x = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -47,7 +47,7 @@ Record.x.set = 2 Record.x.modify = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -85,7 +85,7 @@ structural ability AnAbility where AnAbility.thing = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/ed25519.output.md b/unison-src/transcripts/ed25519.output.md index 2679028d45..0647c3199f 100644 --- a/unison-src/transcripts/ed25519.output.md +++ b/unison-src/transcripts/ed25519.output.md @@ -19,7 +19,7 @@ sigOkay = match signature with > sigOkay ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/edit-command.output.md b/unison-src/transcripts/edit-command.output.md index 8470de9484..e13d5cea9c 100644 --- a/unison-src/transcripts/edit-command.output.md +++ b/unison-src/transcripts/edit-command.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -16,7 +16,7 @@ mytest = [Ok "ok"] ``` -```ucm +``` ucm Loading changes detected in /private/tmp/scratch.u. @@ -31,7 +31,7 @@ mytest = [Ok "ok"] mytest : [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -71,7 +71,7 @@ foo = 123 test> mytest = [Ok "ok"] ``` -```ucm +``` ucm scratch/main> edit missing ⚠️ diff --git a/unison-src/transcripts/edit-namespace.output.md b/unison-src/transcripts/edit-namespace.output.md index 67e24e064f..452a5d3889 100644 --- a/unison-src/transcripts/edit-namespace.output.md +++ b/unison-src/transcripts/edit-namespace.output.md @@ -17,7 +17,7 @@ lib.project.ignoreMe = 30 unique type Foo = { bar : Nat, baz : Nat } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,7 +44,7 @@ unique type Foo = { bar : Nat, baz : Nat } toplevel : Text ``` -```ucm +``` ucm project/main> add ⍟ I've added these definitions: @@ -68,7 +68,7 @@ project/main> add ``` `edit.namespace` edits the whole namespace (minus the top-level `lib`). -```ucm +``` ucm project/main> edit.namespace ☝️ @@ -110,7 +110,7 @@ toplevel = "hi" `edit.namespace` can also accept explicit paths -```ucm +``` ucm project/main> edit.namespace nested simple ☝️ diff --git a/unison-src/transcripts/empty-namespaces.output.md b/unison-src/transcripts/empty-namespaces.output.md index 4bea6f5b50..409dfcd51c 100644 --- a/unison-src/transcripts/empty-namespaces.output.md +++ b/unison-src/transcripts/empty-namespaces.output.md @@ -6,13 +6,13 @@ mynamespace.x = 1 The deleted namespace shouldn't appear in `ls` output. -```ucm +``` ucm scratch/main> ls nothing to show ``` -```ucm +``` ucm scratch/main> find.verbose ☝️ @@ -29,7 +29,7 @@ scratch/main> find.verbose namespace. ``` -```ucm +``` ucm scratch/main> find mynamespace ☝️ @@ -50,7 +50,7 @@ scratch/main> find mynamespace The history of the namespace should be empty. -```ucm +``` ucm scratch/main> history mynamespace ☝️ The namespace mynamespace is empty. @@ -67,7 +67,7 @@ stuff.thing = 2 I should be allowed to fork over a deleted namespace -```ucm +``` ucm scratch/main> fork stuff deleted Done. @@ -75,7 +75,7 @@ scratch/main> fork stuff deleted ``` The history from the `deleted` namespace should have been overwritten by the history from `stuff`. -```ucm +``` ucm scratch/main> history stuff Note: The most recent namespace hash is immediately below this @@ -105,7 +105,7 @@ moveme.y = 2 I should be able to move a namespace over-top of a deleted namespace. The history should be that of the moved namespace. -```ucm +``` ucm scratch/main> delete.namespace moveoverme Done. diff --git a/unison-src/transcripts/emptyCodebase.output.md b/unison-src/transcripts/emptyCodebase.output.md index 4a8b1cff18..86c4b63ff2 100644 --- a/unison-src/transcripts/emptyCodebase.output.md +++ b/unison-src/transcripts/emptyCodebase.output.md @@ -6,7 +6,7 @@ Not even `Nat` or `+`\! BEHOLD\!\!\! -```ucm +``` ucm scratch/main> ls nothing to show @@ -14,7 +14,7 @@ scratch/main> ls ``` Technically, the definitions all exist, but they have no names. `builtins.merge` brings them into existence, under the current namespace: -```ucm +``` ucm scratch/main> builtins.merge lib.builtins Done. @@ -26,7 +26,7 @@ scratch/main> ls lib ``` And for a limited time, you can get even more builtin goodies: -```ucm +``` ucm scratch/main> builtins.mergeio lib.builtinsio Done. diff --git a/unison-src/transcripts/error-messages.output.md b/unison-src/transcripts/error-messages.output.md index 694f20f4ce..ed5d4c1784 100644 --- a/unison-src/transcripts/error-messages.output.md +++ b/unison-src/transcripts/error-messages.output.md @@ -10,7 +10,7 @@ Some basic errors of literals. x = 1. -- missing some digits after the decimal ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ x = 1. -- missing some digits after the decimal x = 1e -- missing an exponent ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -42,7 +42,7 @@ x = 1e -- missing an exponent x = 1e- -- missing an exponent ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -58,7 +58,7 @@ x = 1e- -- missing an exponent x = 1E+ -- missing an exponent ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -76,7 +76,7 @@ x = 1E+ -- missing an exponent x = 0xoogabooga -- invalid hex chars ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -92,7 +92,7 @@ x = 0xoogabooga -- invalid hex chars x = 0o987654321 -- 9 and 8 are not valid octal char ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -108,7 +108,7 @@ x = 0o987654321 -- 9 and 8 are not valid octal char x = 0xsf -- odd number of hex chars in a bytes literal ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -124,7 +124,7 @@ x = 0xsf -- odd number of hex chars in a bytes literal x = 0xsnotvalidhexchars -- invalid hex chars in a bytes literal ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -142,7 +142,7 @@ x = 0xsnotvalidhexchars -- invalid hex chars in a bytes literal foo = else -- not matching if ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -156,7 +156,7 @@ foo = else -- not matching if foo = then -- unclosed ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -170,7 +170,7 @@ foo = then -- unclosed foo = with -- unclosed ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -187,7 +187,7 @@ foo = with -- unclosed foo = match 1 with ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -205,7 +205,7 @@ foo = match 1 with 2 -- no right-hand-side ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -229,7 +229,7 @@ foo = cases 3 -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -252,7 +252,7 @@ x = match Some a with 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -280,7 +280,7 @@ x = match Some a with -> 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -302,7 +302,7 @@ x = match Some a with | true -> 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -324,7 +324,7 @@ x = match Some a with > ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -340,7 +340,7 @@ x = match Some a with use.keyword.in.namespace = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -357,7 +357,7 @@ use.keyword.in.namespace = 1 a ! b = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/escape-sequences.output.md b/unison-src/transcripts/escape-sequences.output.md index 0834375f17..955b6e8fe6 100644 --- a/unison-src/transcripts/escape-sequences.output.md +++ b/unison-src/transcripts/escape-sequences.output.md @@ -4,7 +4,7 @@ > "古池や蛙飛びこむ水の音" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/find-by-type.output.md b/unison-src/transcripts/find-by-type.output.md index 476f6ff807..c45fcd6a88 100644 --- a/unison-src/transcripts/find-by-type.output.md +++ b/unison-src/transcripts/find-by-type.output.md @@ -12,7 +12,7 @@ baz = cases A t -> t ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -39,7 +39,7 @@ scratch/main> find : A ``` -```ucm +``` ucm scratch/main> find : Text ☝️ diff --git a/unison-src/transcripts/find-command.output.md b/unison-src/transcripts/find-command.output.md index e4c4f6fe73..7abbe26f0d 100644 --- a/unison-src/transcripts/find-command.output.md +++ b/unison-src/transcripts/find-command.output.md @@ -8,7 +8,7 @@ cat.lib.bar = 6 somewhere.bar = 7 ``` -```ucm +``` ucm scratch/main> find foo 1. cat.foo : Nat @@ -34,7 +34,7 @@ scratch/main> view 1 cat.foo = 4 ``` -```ucm +``` ucm scratch/main> find-in cat foo 1. foo : Nat @@ -59,7 +59,7 @@ scratch/main> view 1 ``` Finding within a namespace -```ucm +``` ucm scratch/main> find bar 1. somewhere.bar : Nat @@ -73,7 +73,7 @@ scratch/main> find-in somewhere bar ``` -```ucm +``` ucm scratch/main> find baz ☝️ @@ -90,7 +90,7 @@ scratch/main> find baz namespace. ``` -```ucm +``` ucm scratch/main> find.global notHere 😶 diff --git a/unison-src/transcripts/fix-1381-excess-propagate.output.md b/unison-src/transcripts/fix-1381-excess-propagate.output.md index 3732899702..edc30e9f25 100644 --- a/unison-src/transcripts/fix-1381-excess-propagate.output.md +++ b/unison-src/transcripts/fix-1381-excess-propagate.output.md @@ -7,7 +7,7 @@ a = "a term" X.foo = "a namespace" ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -22,7 +22,7 @@ Here is an update which should not affect `X`: a = "an update" ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be @@ -33,7 +33,7 @@ scratch/main> update ``` As of the time of this writing, the history for `X` should be a single node, `#4eeuo5bsfr`; -```ucm +``` ucm scratch/main> history X Note: The most recent namespace hash is immediately below this @@ -46,7 +46,7 @@ scratch/main> history X ``` however, as of release/M1i, we saw an extraneous node appear. If your `ucm` is fixed, you won't see it below: -```ucm +``` ucm scratch/main> history #7nl6ppokhg 😶 diff --git a/unison-src/transcripts/fix-big-list-crash.output.md b/unison-src/transcripts/fix-big-list-crash.output.md index 5661b03392..f6db0fb0bb 100644 --- a/unison-src/transcripts/fix-big-list-crash.output.md +++ b/unison-src/transcripts/fix-big-list-crash.output.md @@ -8,7 +8,7 @@ unique type Direction = U | D | L | R x = [(R,1005),(U,563),(R,417),(U,509),(L,237),(U,555),(R,397),(U,414),(L,490),(U,336),(L,697),(D,682),(L,180),(U,951),(L,189),(D,547),(R,697),(U,583),(L,172),(D,859),(L,370),(D,114),(L,519),(U,829),(R,389),(U,608),(R,66),(D,634),(L,320),(D,49),(L,931),(U,137),(L,349),(D,689),(L,351),(D,829),(R,819),(D,138),(L,118),(D,849),(R,230),(U,858),(L,509),(D,311),(R,815),(U,217),(R,359),(U,840),(R,77),(U,230),(R,361),(U,322),(R,300),(D,646),(R,348),(U,815),(R,793),(D,752),(R,967),(U,128),(R,948),(D,499),(R,359),(U,572),(L,566),(U,815),(R,630),(D,290),(L,829),(D,736),(R,358),(U,778),(R,891),(U,941),(R,544),(U,889),(L,920),(U,913),(L,447),(D,604),(R,538),(U,818),(L,215),(D,437),(R,447),(U,576),(R,452),(D,794),(R,864),(U,269),(L,325),(D,35),(L,268),(D,639),(L,101),(U,777),(L,776),(U,958),(R,105),(U,517),(R,667),(D,423),(R,603),(U,469),(L,125),(D,919),(R,879),(U,994),(R,665),(D,377),(R,456),(D,570),(L,685),(U,291),(R,261),(U,846),(R,840),(U,418),(L,974),(D,270),(L,312),(D,426),(R,621),(D,334),(L,855),(D,378),(R,694),(U,845),(R,481),(U,895),(L,362),(D,840),(L,712),(U,57),(R,276),(D,643),(R,566),(U,348),(R,361),(D,144),(L,287),(D,864),(L,556),(U,610),(L,927),(U,322),(R,271),(D,90),(L,741),(U,446),(R,181),(D,527),(R,56),(U,805),(L,907),(D,406),(L,286),(U,873),(L,79),(D,280),(L,153),(D,377),(R,253),(D,61),(R,475),(D,804),(R,788),(U,393),(L,660),(U,314),(R,489),(D,491),(L,234),(D,712),(L,253),(U,651),(L,777),(D,726),(R,146),(U,47),(R,630),(U,517),(R,226),(U,624),(L,834),(D,153),(L,513),(U,799),(R,287),(D,868),(R,982),(U,390),(L,296),(D,373),(R,9),(U,994),(R,105),(D,673),(L,657),(D,868),(R,738),(D,277),(R,374),(U,828),(R,860),(U,247),(R,484),(U,986),(L,723),(D,847),(L,578),(U,487),(L,51),(D,865),(L,328),(D,199),(R,812),(D,726),(R,355),(D,463),(R,761),(U,69),(R,508),(D,753),(L,81),(D,50),(L,345),(D,66),(L,764),(D,466),(L,975),(U,619),(R,59),(D,788),(L,737),(D,360),(R,14),(D,253),(L,512),(D,417),(R,828),(D,188),(L,394),(U,212),(R,658),(U,369),(R,920),(U,927),(L,339),(U,552),(R,856),(D,458),(R,407),(U,41),(L,930),(D,460),(R,809),(U,467),(L,410),(D,800),(L,135),(D,596),(R,678),(D,4),(L,771),(D,637),(L,876),(U,192),(L,406),(D,136),(R,666),(U,730),(R,711),(D,291),(L,586),(U,845),(R,606),(U,2),(L,228),(D,759),(R,244),(U,946),(R,948),(U,160),(R,397),(U,134),(R,188),(U,850),(R,623),(D,315),(L,219),(D,450),(R,489),(U,374),(R,299),(D,474),(L,767),(D,679),(L,160),(D,403),(L,708)] ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix-ls.output.md b/unison-src/transcripts/fix-ls.output.md index abf280b23d..b99f0f5877 100644 --- a/unison-src/transcripts/fix-ls.output.md +++ b/unison-src/transcripts/fix-ls.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm test-ls/main> builtins.merge Done. @@ -10,7 +10,7 @@ foo.bar.add x y = x Int.+ y foo.bar.subtract x y = x Int.- y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ foo.bar.subtract x y = x Int.- y foo.bar.subtract : Int -> Int -> Int ``` -```ucm +``` ucm test-ls/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix1063.output.md b/unison-src/transcripts/fix1063.output.md index ca9f0ad573..57ab0b23d8 100644 --- a/unison-src/transcripts/fix1063.output.md +++ b/unison-src/transcripts/fix1063.output.md @@ -8,7 +8,7 @@ use Boolean not noop = not `.` not ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,7 +22,7 @@ noop = not `.` not noop : Boolean -> Boolean ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix1334.output.md b/unison-src/transcripts/fix1334.output.md index b9b6f6a89c..dfadcbe0ad 100644 --- a/unison-src/transcripts/fix1334.output.md +++ b/unison-src/transcripts/fix1334.output.md @@ -4,7 +4,7 @@ With this PR, the source of an alias can be a short hash (even of a definition t Let's make some hash-only aliases, now that we can. :mad-with-power-emoji: -```ucm +``` ucm scratch/main> alias.type ##Nat Cat Done. diff --git a/unison-src/transcripts/fix1390.output.md b/unison-src/transcripts/fix1390.output.md index 4d50e86afc..340a34e2ca 100644 --- a/unison-src/transcripts/fix1390.output.md +++ b/unison-src/transcripts/fix1390.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -13,7 +13,7 @@ List.map f = go [] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ List.map f = List.map : (i ->{g} o) -> [i] ->{g} [o] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -53,7 +53,7 @@ List.map2 f = go [] ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix1532.output.md b/unison-src/transcripts/fix1532.output.md index 41ea7b2b94..0412312d87 100644 --- a/unison-src/transcripts/fix1532.output.md +++ b/unison-src/transcripts/fix1532.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -12,7 +12,7 @@ foo.y = 100 bar.z = x + y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,7 +27,7 @@ bar.z = x + y foo.y : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -39,7 +39,7 @@ scratch/main> add ``` Let's see what we have created... -```ucm +``` ucm scratch/main> ls 1. bar/ (1 term) @@ -49,7 +49,7 @@ scratch/main> ls ``` Now, if we try deleting the namespace `foo`, we get an error, as expected. -```ucm +``` ucm scratch/main> delete.namespace foo ⚠️ @@ -68,7 +68,7 @@ scratch/main> delete.namespace foo ``` Any numbered arguments should refer to `bar.z`. -```ucm +``` ucm scratch/main> debug.numberedArgs 1. bar.z @@ -77,7 +77,7 @@ scratch/main> debug.numberedArgs ``` We can then delete the dependent term, and then delete `foo`. -```ucm +``` ucm scratch/main> delete.term 1 Done. diff --git a/unison-src/transcripts/fix1696.output.md b/unison-src/transcripts/fix1696.output.md index 47c1159a37..772f10e6c2 100644 --- a/unison-src/transcripts/fix1696.output.md +++ b/unison-src/transcripts/fix1696.output.md @@ -16,7 +16,7 @@ dialog = Ask.provide 'zoot '("Awesome number: " ++ Nat.toText Ask.ask ++ "!") > dialog ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix1709.output.md b/unison-src/transcripts/fix1709.output.md index 3aacb9753e..7159b5b54b 100644 --- a/unison-src/transcripts/fix1709.output.md +++ b/unison-src/transcripts/fix1709.output.md @@ -6,7 +6,7 @@ id2 x = id x ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -20,7 +20,7 @@ id2 x = id2 : x -> x ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -33,7 +33,7 @@ scratch/main> add > id2 "hi" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix1731.output.md b/unison-src/transcripts/fix1731.output.md index 8c8a7610a4..be55bbb4b2 100644 --- a/unison-src/transcripts/fix1731.output.md +++ b/unison-src/transcripts/fix1731.output.md @@ -12,7 +12,7 @@ repro = cases input -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix1800.output.md b/unison-src/transcripts/fix1800.output.md index 8fb9e9297e..97f93ed409 100644 --- a/unison-src/transcripts/fix1800.output.md +++ b/unison-src/transcripts/fix1800.output.md @@ -20,7 +20,7 @@ Testing a few variations here: - Should be able to run annotated and unannotated main functions in the current file. - Should be able to run annotated and unannotated main functions from the codebase. -```ucm +``` ucm scratch/main> run main1 () @@ -57,7 +57,7 @@ scratch/main> rename.term main3 code.main3 ``` The renaming just ensures that when running `code.main1`, it has to get that main from the codebase rather than the scratch file: -```ucm +``` ucm scratch/main> run code.main1 () @@ -83,7 +83,7 @@ main5 _ = () This shouldn't work since `main4` and `main5` don't have the right type. -```ucm +``` ucm scratch/main> run main4 😶 @@ -97,7 +97,7 @@ scratch/main> run main4 main4 : '{IO, Exception} result ``` -```ucm +``` ucm scratch/main> run main5 😶 diff --git a/unison-src/transcripts/fix1844.output.md b/unison-src/transcripts/fix1844.output.md index bbc28208c0..0f6f428178 100644 --- a/unison-src/transcripts/fix1844.output.md +++ b/unison-src/transcripts/fix1844.output.md @@ -9,7 +9,7 @@ snoc k aN = match k with > snoc (One 1) 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix1926.output.md b/unison-src/transcripts/fix1926.output.md index 6326666d2d..1c940cc22f 100644 --- a/unison-src/transcripts/fix1926.output.md +++ b/unison-src/transcripts/fix1926.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -10,7 +10,7 @@ scratch/main> builtins.merge sq = 2934892384 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -36,7 +36,7 @@ sq = 2934892384 sq = 2934892384 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2026.output.md b/unison-src/transcripts/fix2026.output.md index 5718d9516e..254fcb72c7 100644 --- a/unison-src/transcripts/fix2026.output.md +++ b/unison-src/transcripts/fix2026.output.md @@ -35,7 +35,7 @@ Exception.unsafeRun! e _ = handle !e with h ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -63,7 +63,7 @@ Exception.unsafeRun! e _ = toException : Either Failure a ->{Exception} a ``` -```ucm +``` ucm scratch/main> run ex () diff --git a/unison-src/transcripts/fix2027.output.md b/unison-src/transcripts/fix2027.output.md index cb959dcc5d..3d224d6446 100644 --- a/unison-src/transcripts/fix2027.output.md +++ b/unison-src/transcripts/fix2027.output.md @@ -44,7 +44,7 @@ myServer = unsafeRun! '(hello "127.0.0.1" "0") ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -77,7 +77,7 @@ myServer = unsafeRun! '(hello "127.0.0.1" "0") toException : Either Failure a ->{Exception} a ``` -```ucm +``` ucm scratch/main> run myServer 💔💥 diff --git a/unison-src/transcripts/fix2049.output.md b/unison-src/transcripts/fix2049.output.md index 492729b03e..a9354446f8 100644 --- a/unison-src/transcripts/fix2049.output.md +++ b/unison-src/transcripts/fix2049.output.md @@ -48,7 +48,7 @@ Fold.Stream.fold = !res Universal.== false ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -106,7 +106,7 @@ tests _ = ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -120,7 +120,7 @@ tests _ = tests : ∀ _. _ ->{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix2053.output.md b/unison-src/transcripts/fix2053.output.md index 39766e272d..ae97366dfb 100644 --- a/unison-src/transcripts/fix2053.output.md +++ b/unison-src/transcripts/fix2053.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> display List.map f a -> diff --git a/unison-src/transcripts/fix2156.output.md b/unison-src/transcripts/fix2156.output.md index acad8adb9e..4a15b1accb 100644 --- a/unison-src/transcripts/fix2156.output.md +++ b/unison-src/transcripts/fix2156.output.md @@ -8,7 +8,7 @@ sqr n = n * n > sqr ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2167.output.md b/unison-src/transcripts/fix2167.output.md index 0a5c34eb10..d4e630f596 100644 --- a/unison-src/transcripts/fix2167.output.md +++ b/unison-src/transcripts/fix2167.output.md @@ -15,7 +15,7 @@ R.near1 region loc = match R.near 42 with ls -> R.die () ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2187.output.md b/unison-src/transcripts/fix2187.output.md index 45fb5de8b4..12a1aab7ff 100644 --- a/unison-src/transcripts/fix2187.output.md +++ b/unison-src/transcripts/fix2187.output.md @@ -13,7 +13,7 @@ lexicalScopeEx = ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2231.output.md b/unison-src/transcripts/fix2231.output.md index 5dfb0b791c..d0e410477d 100644 --- a/unison-src/transcripts/fix2231.output.md +++ b/unison-src/transcripts/fix2231.output.md @@ -20,7 +20,7 @@ foldl f a = cases txt = foldl (Text.++) "" ["a", "b", "c"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -36,7 +36,7 @@ txt = foldl (Text.++) "" ["a", "b", "c"] txt : Text ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix2238.output.md b/unison-src/transcripts/fix2238.output.md index 0133809e1f..0958d7182d 100644 --- a/unison-src/transcripts/fix2238.output.md +++ b/unison-src/transcripts/fix2238.output.md @@ -6,7 +6,7 @@ structural ability Abort where abort : x ex = {{ @eval{abort} }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,7 +18,7 @@ ex = {{ @eval{abort} }} ``` This file should also not typecheck - it has a triple backticks block that uses abilities. -```ucm +``` ucm scratch/main> load unison-src/transcripts/fix2238.u Loading changes detected in unison-src/transcripts/fix2238.u. diff --git a/unison-src/transcripts/fix2244.output.md b/unison-src/transcripts/fix2244.output.md index 63ac780c2c..2341d1a265 100644 --- a/unison-src/transcripts/fix2244.output.md +++ b/unison-src/transcripts/fix2244.output.md @@ -1,6 +1,6 @@ Ensure closing token is emitted by closing brace in doc eval block. -```ucm +``` ucm scratch/main> load ./unison-src/transcripts/fix2244.u Loading changes detected in diff --git a/unison-src/transcripts/fix2254.output.md b/unison-src/transcripts/fix2254.output.md index 7abb352337..0c60b4dc73 100644 --- a/unison-src/transcripts/fix2254.output.md +++ b/unison-src/transcripts/fix2254.output.md @@ -32,7 +32,7 @@ g = cases We'll make our edits in a new branch. -```ucm +``` ucm scratch/a> add ⍟ I've added these definitions: @@ -65,7 +65,7 @@ unique type A a b c d Let's do the update now, and verify that the definitions all look good and there's nothing `todo`: -```ucm +``` ucm scratch/a2> update.old ⍟ I've updated these names to your new definition: @@ -121,7 +121,7 @@ structural type Rec = { uno : Nat, dos : Nat } combine r = uno r + dos r ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -141,7 +141,7 @@ combine r = uno r + dos r combine : Rec -> Nat ``` -```ucm +``` ucm scratch/r1> add ⍟ I've added these definitions: @@ -167,7 +167,7 @@ scratch/r1> branch r2 structural type Rec = { uno : Nat, dos : Nat, tres : Text } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -195,7 +195,7 @@ structural type Rec = { uno : Nat, dos : Nat, tres : Text } ``` And checking that after updating this record, there's nothing `todo`: -```ucm +``` ucm scratch/r2> update.old ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix2268.output.md b/unison-src/transcripts/fix2268.output.md index 1c170dd548..79da655962 100644 --- a/unison-src/transcripts/fix2268.output.md +++ b/unison-src/transcripts/fix2268.output.md @@ -15,7 +15,7 @@ test _ = toNat x ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2334.output.md b/unison-src/transcripts/fix2334.output.md index 03e65bdcde..ab20adb8e7 100644 --- a/unison-src/transcripts/fix2334.output.md +++ b/unison-src/transcripts/fix2334.output.md @@ -14,7 +14,7 @@ f = cases > f 1 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2344.output.md b/unison-src/transcripts/fix2344.output.md index 4c35e7211d..1d57076149 100644 --- a/unison-src/transcripts/fix2344.output.md +++ b/unison-src/transcripts/fix2344.output.md @@ -16,7 +16,7 @@ sneezy dee _ = dee 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2350.output.md b/unison-src/transcripts/fix2350.output.md index 4fcf50790f..5f6f273c32 100644 --- a/unison-src/transcripts/fix2350.output.md +++ b/unison-src/transcripts/fix2350.output.md @@ -24,7 +24,7 @@ save : a ->{Storage d g, g} (d a) save a = !(save.impl a) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2353.output.md b/unison-src/transcripts/fix2353.output.md index 72d0c465eb..a6a8be6b6c 100644 --- a/unison-src/transcripts/fix2353.output.md +++ b/unison-src/transcripts/fix2353.output.md @@ -11,7 +11,7 @@ pure.run a0 a = Scope.run a' ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2354.output.md b/unison-src/transcripts/fix2354.output.md index 4dab203483..226d20bc54 100644 --- a/unison-src/transcripts/fix2354.output.md +++ b/unison-src/transcripts/fix2354.output.md @@ -8,7 +8,7 @@ f id = id 0 x = 'f ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2355.output.md b/unison-src/transcripts/fix2355.output.md index 27337dbd65..b162860a9f 100644 --- a/unison-src/transcripts/fix2355.output.md +++ b/unison-src/transcripts/fix2355.output.md @@ -19,7 +19,7 @@ example = 'let A.await r ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2378.output.md b/unison-src/transcripts/fix2378.output.md index 73c63de736..0c63239cc5 100644 --- a/unison-src/transcripts/fix2378.output.md +++ b/unison-src/transcripts/fix2378.output.md @@ -38,7 +38,7 @@ x : '{} (Either () Nat) x _ = Ex.catch '(C.pure.run '(A.pure.run ex)) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2423.output.md b/unison-src/transcripts/fix2423.output.md index cc17ad15cb..40d2fa6509 100644 --- a/unison-src/transcripts/fix2423.output.md +++ b/unison-src/transcripts/fix2423.output.md @@ -26,7 +26,7 @@ Split.zipSame sa sb _ = handle !sa with go sb ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2474.output.md b/unison-src/transcripts/fix2474.output.md index 4a0d8a08ee..0daf2d3ba0 100644 --- a/unison-src/transcripts/fix2474.output.md +++ b/unison-src/transcripts/fix2474.output.md @@ -16,7 +16,7 @@ should be typed in the following way: Previously this was being checked as `o ->{E0} r`, where `E0` is the ability that contains `e`. -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -35,7 +35,7 @@ Stream.uncons s = handle !s with go ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2628.output.md b/unison-src/transcripts/fix2628.output.md index cb51cf0d72..87aa68a672 100644 --- a/unison-src/transcripts/fix2628.output.md +++ b/unison-src/transcripts/fix2628.output.md @@ -4,7 +4,7 @@ unique type foo.bar.baz.MyRecord = { } ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix2663.output.md b/unison-src/transcripts/fix2663.output.md index fcb73c75db..6153dc0421 100644 --- a/unison-src/transcripts/fix2663.output.md +++ b/unison-src/transcripts/fix2663.output.md @@ -18,7 +18,7 @@ bad x = match Some (Some x) with > bad 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2693.output.md b/unison-src/transcripts/fix2693.output.md index 94961fc9e3..e5414c32a8 100644 --- a/unison-src/transcripts/fix2693.output.md +++ b/unison-src/transcripts/fix2693.output.md @@ -8,7 +8,7 @@ range : Nat -> List Nat range = loop [] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,7 +22,7 @@ range = loop [] range : Nat -> [Nat] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -35,7 +35,7 @@ scratch/main> add > range 2000 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -2057,7 +2057,7 @@ Should be cached: > range 2000 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2712.output.md b/unison-src/transcripts/fix2712.output.md index 04c8c46e3e..4181235105 100644 --- a/unison-src/transcripts/fix2712.output.md +++ b/unison-src/transcripts/fix2712.output.md @@ -5,7 +5,7 @@ mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b mapWithKey f m = Tip ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ mapWithKey f m = Tip mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -40,7 +40,7 @@ naiomi = ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix2795.output.md b/unison-src/transcripts/fix2795.output.md index 09ae558fca..39da527ba0 100644 --- a/unison-src/transcripts/fix2795.output.md +++ b/unison-src/transcripts/fix2795.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.mergeio Done. diff --git a/unison-src/transcripts/fix2840.output.md b/unison-src/transcripts/fix2840.output.md index a84e33e4df..d6e9c3eef0 100644 --- a/unison-src/transcripts/fix2840.output.md +++ b/unison-src/transcripts/fix2840.output.md @@ -2,7 +2,7 @@ This bugfix addresses an issue where embedded Unison code in UCM was expected to First, a few \[hidden\] definitions necessary for typechecking a simple Doc2. -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -25,7 +25,7 @@ Hi }} ``` -```ucm +``` ucm scratch/main> display README Hi diff --git a/unison-src/transcripts/fix2970.output.md b/unison-src/transcripts/fix2970.output.md index 2d4915f4a2..7f5bddca1b 100644 --- a/unison-src/transcripts/fix2970.output.md +++ b/unison-src/transcripts/fix2970.output.md @@ -1,6 +1,6 @@ Also fixes \#1519 (it's the same issue). -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -11,7 +11,7 @@ foo.+.doc : Nat foo.+.doc = 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3037.output.md b/unison-src/transcripts/fix3037.output.md index be813afc7b..aebd61c502 100644 --- a/unison-src/transcripts/fix3037.output.md +++ b/unison-src/transcripts/fix3037.output.md @@ -13,7 +13,7 @@ runner : Runner {IO} runner = pureRunner ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -47,7 +47,7 @@ h _ = () > h anA ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3171.output.md b/unison-src/transcripts/fix3171.output.md index 0fdaf8377a..8778f0442e 100644 --- a/unison-src/transcripts/fix3171.output.md +++ b/unison-src/transcripts/fix3171.output.md @@ -9,7 +9,7 @@ f x y z _ = x + y * z > f 1 2 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3196.output.md b/unison-src/transcripts/fix3196.output.md index 95f0764c02..3b8f046472 100644 --- a/unison-src/transcripts/fix3196.output.md +++ b/unison-src/transcripts/fix3196.output.md @@ -26,7 +26,7 @@ w2 = cases W -> W > w2 w1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3215.output.md b/unison-src/transcripts/fix3215.output.md index 492d69016d..2f5128ffbc 100644 --- a/unison-src/transcripts/fix3215.output.md +++ b/unison-src/transcripts/fix3215.output.md @@ -16,7 +16,7 @@ f = cases {x} -> 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3244.output.md b/unison-src/transcripts/fix3244.output.md index 5eca2f4f7a..00899d4c5a 100644 --- a/unison-src/transcripts/fix3244.output.md +++ b/unison-src/transcripts/fix3244.output.md @@ -15,7 +15,7 @@ foo t = > foo (10,20) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3265.output.md b/unison-src/transcripts/fix3265.output.md index 2db3893b80..1f70863dc7 100644 --- a/unison-src/transcripts/fix3265.output.md +++ b/unison-src/transcripts/fix3265.output.md @@ -21,7 +21,7 @@ are three cases that need to be 'fixed up.' g (z -> x + f0 z)) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -66,7 +66,7 @@ discard its arguments, where `f` also occurs. f x 20) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3634.output.md b/unison-src/transcripts/fix3634.output.md index e06cd8fbc4..ac92ec60c2 100644 --- a/unison-src/transcripts/fix3634.output.md +++ b/unison-src/transcripts/fix3634.output.md @@ -10,7 +10,7 @@ d = {{ }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -25,7 +25,7 @@ d = {{ d : Doc2 ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix3678.output.md b/unison-src/transcripts/fix3678.output.md index 3b2754bdd0..321c493f21 100644 --- a/unison-src/transcripts/fix3678.output.md +++ b/unison-src/transcripts/fix3678.output.md @@ -8,7 +8,7 @@ arr = Scope.run do > compare arr arr ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3752.output.md b/unison-src/transcripts/fix3752.output.md index fb52acd219..b22b33408e 100644 --- a/unison-src/transcripts/fix3752.output.md +++ b/unison-src/transcripts/fix3752.output.md @@ -15,7 +15,7 @@ bar = do id "hello" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3759.output.md b/unison-src/transcripts/fix3759.output.md index 4f0db3fe59..1102f45357 100644 --- a/unison-src/transcripts/fix3759.output.md +++ b/unison-src/transcripts/fix3759.output.md @@ -47,7 +47,7 @@ blah.frobnicate = "Yay!" > blah.frobnicate Text.++ " 🎉" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix3773.output.md b/unison-src/transcripts/fix3773.output.md index e7f355fd0b..360dd25783 100644 --- a/unison-src/transcripts/fix3773.output.md +++ b/unison-src/transcripts/fix3773.output.md @@ -7,7 +7,7 @@ foo = > foo + 20 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4172.output.md b/unison-src/transcripts/fix4172.output.md index 436f797154..b94add30ab 100644 --- a/unison-src/transcripts/fix4172.output.md +++ b/unison-src/transcripts/fix4172.output.md @@ -11,7 +11,7 @@ bool = true allowDebug = debug [1,2,3] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -34,7 +34,7 @@ allowDebug = debug [1,2,3] ✅ Passed Yay ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -59,7 +59,7 @@ scratch/main> test bool = false ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -73,7 +73,7 @@ bool = false bool : Boolean ``` -```ucm +``` ucm scratch/main> update.old ⍟ I've updated these names to your new definition: diff --git a/unison-src/transcripts/fix4280.output.md b/unison-src/transcripts/fix4280.output.md index 4c7fbb2de2..65561ba2a5 100644 --- a/unison-src/transcripts/fix4280.output.md +++ b/unison-src/transcripts/fix4280.output.md @@ -7,7 +7,7 @@ bonk = _baz ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4397.output.md b/unison-src/transcripts/fix4397.output.md index 2cb173290f..5d62c12276 100644 --- a/unison-src/transcripts/fix4397.output.md +++ b/unison-src/transcripts/fix4397.output.md @@ -7,7 +7,7 @@ unique type Bar = Bar Baz ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4415.output.md b/unison-src/transcripts/fix4415.output.md index 90d57f289e..b17f16ddc4 100644 --- a/unison-src/transcripts/fix4415.output.md +++ b/unison-src/transcripts/fix4415.output.md @@ -3,7 +3,7 @@ unique type Foo = Foo unique type sub.Foo = ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4424.output.md b/unison-src/transcripts/fix4424.output.md index 1eb07ab2d6..2c7c4b4b63 100644 --- a/unison-src/transcripts/fix4424.output.md +++ b/unison-src/transcripts/fix4424.output.md @@ -8,7 +8,7 @@ countCat = cases Cat.Dog.Mouse x -> Bird ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -24,7 +24,7 @@ Now I want to add a constructor. unique type Rat.Dog = Bird | Mouse ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/fix4482.output.md b/unison-src/transcripts/fix4482.output.md index 26a73068d7..5f641c2047 100644 --- a/unison-src/transcripts/fix4482.output.md +++ b/unison-src/transcripts/fix4482.output.md @@ -6,7 +6,7 @@ lib.foo1.lib.bonk2.qux = 1 mybar = bar + bar ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,7 +23,7 @@ mybar = bar + bar mybar : Nat ``` -```ucm +``` ucm myproj/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix4498.output.md b/unison-src/transcripts/fix4498.output.md index 149d3406ff..49cc9735f2 100644 --- a/unison-src/transcripts/fix4498.output.md +++ b/unison-src/transcripts/fix4498.output.md @@ -5,7 +5,7 @@ lib.dep0.lib.dep1.foo = 6 myterm = foo + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,7 +21,7 @@ myterm = foo + 2 myterm : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix4515.output.md b/unison-src/transcripts/fix4515.output.md index 925195662a..9e4b3ee657 100644 --- a/unison-src/transcripts/fix4515.output.md +++ b/unison-src/transcripts/fix4515.output.md @@ -8,7 +8,7 @@ useBar = cases Bar.X _ -> 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ useBar = cases useBar : Bar -> Nat ``` -```ucm +``` ucm myproject/main> add ⍟ I've added these definitions: @@ -39,7 +39,7 @@ myproject/main> add unique type Foo = Foo1 | Foo2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -53,7 +53,7 @@ unique type Foo = Foo1 | Foo2 type Foo ``` -```ucm +``` ucm myproject/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/fix4528.output.md b/unison-src/transcripts/fix4528.output.md index 8b2d96fc3f..0266eef0a2 100644 --- a/unison-src/transcripts/fix4528.output.md +++ b/unison-src/transcripts/fix4528.output.md @@ -5,7 +5,7 @@ main : () -> Foo main _ = MkFoo 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ main _ = MkFoo 5 main : 'Foo ``` -```ucm +``` ucm foo/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix4556.output.md b/unison-src/transcripts/fix4556.output.md index f36c030d2a..23bdc3a9f2 100644 --- a/unison-src/transcripts/fix4556.output.md +++ b/unison-src/transcripts/fix4556.output.md @@ -5,7 +5,7 @@ bar.hello = 5 + thing hey = foo.hello ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,7 +21,7 @@ hey = foo.hello thing : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -36,7 +36,7 @@ scratch/main> add thing = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,7 +50,7 @@ thing = 2 thing : Nat ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/fix4592.output.md b/unison-src/transcripts/fix4592.output.md index 1644f6c33c..a6a05b76d6 100644 --- a/unison-src/transcripts/fix4592.output.md +++ b/unison-src/transcripts/fix4592.output.md @@ -3,7 +3,7 @@ doc = {{ {{ bug "bug" 52 }} }} ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4618.output.md b/unison-src/transcripts/fix4618.output.md index 144c13a8d3..a364ddc8f1 100644 --- a/unison-src/transcripts/fix4618.output.md +++ b/unison-src/transcripts/fix4618.output.md @@ -3,7 +3,7 @@ foo = 5 unique type Bugs.Zonk = Bugs ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,7 +17,7 @@ unique type Bugs.Zonk = Bugs foo : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -31,7 +31,7 @@ foo = 4 unique type Bugs = ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -49,7 +49,7 @@ unique type Bugs = foo : Nat ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/fix4722.output.md b/unison-src/transcripts/fix4722.output.md index 91b071e5fe..faa963b196 100644 --- a/unison-src/transcripts/fix4722.output.md +++ b/unison-src/transcripts/fix4722.output.md @@ -34,7 +34,7 @@ foo = cases f (_ -> ()) (foo l) (foo r) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4780.output.md b/unison-src/transcripts/fix4780.output.md index 392060c340..5fefbd4ccf 100644 --- a/unison-src/transcripts/fix4780.output.md +++ b/unison-src/transcripts/fix4780.output.md @@ -5,7 +5,7 @@ builtins decompile properly. > (+) 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix4898.output.md b/unison-src/transcripts/fix4898.output.md index 62c4d63772..9bacabb90d 100644 --- a/unison-src/transcripts/fix4898.output.md +++ b/unison-src/transcripts/fix4898.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -12,7 +12,7 @@ redouble : Int -> Int redouble x = double x + double x ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ redouble x = double x + double x redouble : Int -> Int ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix5055.output.md b/unison-src/transcripts/fix5055.output.md index 475edc5bdc..005e47585e 100644 --- a/unison-src/transcripts/fix5055.output.md +++ b/unison-src/transcripts/fix5055.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm test-5055/main> builtins.merge Done. @@ -10,7 +10,7 @@ foo.add x y = x Int.+ y foo.subtract x y = x Int.- y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ foo.subtract x y = x Int.- y foo.subtract : Int -> Int -> Int ``` -```ucm +``` ucm test-5055/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md index 67468e1b85..f64f9c84ff 100644 --- a/unison-src/transcripts/fix5080.output.md +++ b/unison-src/transcripts/fix5080.output.md @@ -3,7 +3,7 @@ test> fix5080.tests.success = [Ok "success"] test> fix5080.tests.failure = [Fail "fail"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -28,7 +28,7 @@ test> fix5080.tests.failure = [Fail "fail"] 🚫 FAILED fail ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -49,7 +49,7 @@ scratch/main> test Tip: Use view 1 to view the source of a test. ``` -```ucm +``` ucm scratch/main> delete.term 2 Done. diff --git a/unison-src/transcripts/fix614.output.md b/unison-src/transcripts/fix614.output.md index 770489a098..97ec65e00a 100644 --- a/unison-src/transcripts/fix614.output.md +++ b/unison-src/transcripts/fix614.output.md @@ -11,7 +11,7 @@ ex1 = do 42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -33,7 +33,7 @@ ex2 = do 42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -55,7 +55,7 @@ ex3 = do () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -78,7 +78,7 @@ ex4 = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -100,7 +100,7 @@ ex4 = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix689.output.md b/unison-src/transcripts/fix689.output.md index 06689cf642..ed8ea04102 100644 --- a/unison-src/transcripts/fix689.output.md +++ b/unison-src/transcripts/fix689.output.md @@ -7,7 +7,7 @@ structural ability SystemTime where tomorrow = '(SystemTime.systemTime + 24 * 60 * 60) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix693.output.md b/unison-src/transcripts/fix693.output.md index 753e434f21..35e07bec56 100644 --- a/unison-src/transcripts/fix693.output.md +++ b/unison-src/transcripts/fix693.output.md @@ -6,7 +6,7 @@ structural ability Abort where abort : a ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -20,7 +20,7 @@ structural ability Abort where structural ability X t ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -41,7 +41,7 @@ h0 req = match req with { d } -> Some d ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -69,7 +69,7 @@ h1 req = match req with { d } -> Some d ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -98,7 +98,7 @@ h2 req = match req with { r } -> r ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -121,7 +121,7 @@ h3 = cases { X.x b _ -> _ } -> Some b ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix845.output.md b/unison-src/transcripts/fix845.output.md index 6b910d67eb..c192583c63 100644 --- a/unison-src/transcripts/fix845.output.md +++ b/unison-src/transcripts/fix845.output.md @@ -8,7 +8,7 @@ Text.zonk : Text -> Text Text.zonk txt = txt ++ "!! " ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -29,7 +29,7 @@ Now, typecheck a file with a reference to `Blah.zonk` (which doesn't exist in th > Blah.zonk [1,2,3] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -61,7 +61,7 @@ ex = baz ++ ", world!" > ex ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -91,7 +91,7 @@ ex = zonk "hi" > ex ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -123,7 +123,7 @@ ex = zonk "hi" -- should resolve to Text.zonk, from the codebase > ex ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix849.output.md b/unison-src/transcripts/fix849.output.md index f1775f6306..c6c5c13904 100644 --- a/unison-src/transcripts/fix849.output.md +++ b/unison-src/transcripts/fix849.output.md @@ -6,7 +6,7 @@ x = 42 > x ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/fix942.output.md b/unison-src/transcripts/fix942.output.md index 13d68377a7..13dd97532b 100644 --- a/unison-src/transcripts/fix942.output.md +++ b/unison-src/transcripts/fix942.output.md @@ -6,7 +6,7 @@ y = x + 1 z = y + 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,7 +21,7 @@ z = y + 2 z : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -37,7 +37,7 @@ Now we edit `x` to be `7`, which should make `z` equal `10`: x = 7 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -51,7 +51,7 @@ x = 7 x : Nat ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be @@ -85,7 +85,7 @@ Uh oh\! `z` is still referencing the old version. Just to confirm: test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -105,7 +105,7 @@ test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] ✅ Passed great ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/fix987.output.md b/unison-src/transcripts/fix987.output.md index e816b3808e..a128fa6c0a 100644 --- a/unison-src/transcripts/fix987.output.md +++ b/unison-src/transcripts/fix987.output.md @@ -10,7 +10,7 @@ spaceAttack1 x = "All done" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ spaceAttack1 x = ``` Add it to the codebase: -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -44,7 +44,7 @@ spaceAttack2 x = "All done" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -57,7 +57,7 @@ spaceAttack2 x = spaceAttack2 : x ->{DeathStar} Text ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/formatter.output.md b/unison-src/transcripts/formatter.output.md index 1b16b7def5..54c9a12327 100644 --- a/unison-src/transcripts/formatter.output.md +++ b/unison-src/transcripts/formatter.output.md @@ -83,7 +83,7 @@ with a strike-through block~ }} ``` -```ucm +``` ucm scratch/main> debug.format ``` @@ -171,7 +171,7 @@ Formatter should leave things alone if the file doesn't typecheck. brokenDoc = {{ hello }} + 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -199,7 +199,7 @@ brokenDoc = {{ hello }} + 1 (Nat.+) : Nat -> Nat -> Nat ``` -```ucm +``` ucm scratch/main> debug.format ``` diff --git a/unison-src/transcripts/fuzzy-options.output.md b/unison-src/transcripts/fuzzy-options.output.md index f07d399060..d83fd4341b 100644 --- a/unison-src/transcripts/fuzzy-options.output.md +++ b/unison-src/transcripts/fuzzy-options.output.md @@ -2,7 +2,7 @@ If an argument is required but doesn't have a fuzzy resolver, the command should just print the help. -```ucm +``` ucm -- The second argument of move.term is a 'new-name' and doesn't have a fuzzy resolver scratch/main> move.term @@ -12,7 +12,7 @@ scratch/main> move.term If a fuzzy resolver doesn't have any options available it should print a message instead of opening an empty fuzzy-select. -```ucm +``` ucm scratch/empty> view ⚠️ @@ -28,7 +28,7 @@ nested.optionTwo = 2 Definition args -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -45,7 +45,7 @@ scratch/main> debug.fuzzy-options view _ ``` Namespace args -```ucm +``` ucm scratch/main> add ⊡ Ignored previously added definitions: nested.optionTwo @@ -59,7 +59,7 @@ scratch/main> debug.fuzzy-options find-in _ ``` Project Branch args -```ucm +``` ucm myproject/main> branch mybranch Done. I've created the mybranch branch based off of main. diff --git a/unison-src/transcripts/generic-parse-errors.output.md b/unison-src/transcripts/generic-parse-errors.output.md index b0f6d6a5ba..c66d0c5948 100644 --- a/unison-src/transcripts/generic-parse-errors.output.md +++ b/unison-src/transcripts/generic-parse-errors.output.md @@ -5,7 +5,7 @@ x = foo.123 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ x = namespace.blah = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -42,7 +42,7 @@ namespace.blah = 1 x = 1 ] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -56,7 +56,7 @@ x = 1 ] x = a.#abc ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -72,7 +72,7 @@ x = a.#abc x = "hi ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -93,7 +93,7 @@ x = "hi y : a ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/hello.output.md b/unison-src/transcripts/hello.output.md index 3c5d9bc8c2..720cd6d3ff 100644 --- a/unison-src/transcripts/hello.output.md +++ b/unison-src/transcripts/hello.output.md @@ -27,7 +27,7 @@ x = 42 ``` -```ucm +``` ucm Loading changes detected in myfile.u. @@ -42,7 +42,7 @@ x = 42 ``` Let's go ahead and add that to the codebase, then make sure it's there: -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -78,7 +78,7 @@ hmm : .builtin.Nat hmm = "Not, in fact, a number" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/help.output.md b/unison-src/transcripts/help.output.md index 54662d0c95..019bc30929 100644 --- a/unison-src/transcripts/help.output.md +++ b/unison-src/transcripts/help.output.md @@ -1,6 +1,6 @@ # Shows `help` output -```ucm +``` ucm scratch/main> help add diff --git a/unison-src/transcripts/higher-rank.output.md b/unison-src/transcripts/higher-rank.output.md index f4c2dbf502..449617d84f 100644 --- a/unison-src/transcripts/higher-rank.output.md +++ b/unison-src/transcripts/higher-rank.output.md @@ -9,7 +9,7 @@ f id = (id 1, id "hi") > f (x -> x) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -38,7 +38,7 @@ f id _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -66,7 +66,7 @@ Functor.blah = cases Functor f -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -110,7 +110,7 @@ Loc.transform2 nt = cases Loc f -> Loc f' ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -139,7 +139,7 @@ structural type HigherRanked = HigherRanked (forall a. a -> a) We should be able to add and view records with higher-rank fields. -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/input-parse-errors.output.md b/unison-src/transcripts/input-parse-errors.output.md index 2e00b284c4..f349b8a889 100644 --- a/unison-src/transcripts/input-parse-errors.output.md +++ b/unison-src/transcripts/input-parse-errors.output.md @@ -6,7 +6,7 @@ x = 55 `handleNameArg` parse error in `add` -```ucm +``` ucm scratch/main> add . ⚠️ @@ -61,7 +61,7 @@ todo: aliasMany: skipped -- similar to `add` -```ucm +``` ucm scratch/main> update arg ⚠️ diff --git a/unison-src/transcripts/io-test-command.output.md b/unison-src/transcripts/io-test-command.output.md index 65abcdab64..0e1d8cbbdc 100644 --- a/unison-src/transcripts/io-test-command.output.md +++ b/unison-src/transcripts/io-test-command.output.md @@ -17,7 +17,7 @@ lib.ioAndExceptionTestInLib = do Run a IO tests one by one -```ucm +``` ucm scratch/main> io.test ioAndExceptionTest New test results: @@ -41,7 +41,7 @@ scratch/main> io.test ioTest ``` `io.test` doesn't cache results -```ucm +``` ucm scratch/main> io.test ioAndExceptionTest New test results: @@ -55,7 +55,7 @@ scratch/main> io.test ioAndExceptionTest ``` `io.test.all` will run all matching tests except those in the `lib` namespace. -```ucm +``` ucm scratch/main> io.test.all diff --git a/unison-src/transcripts/io.output.md b/unison-src/transcripts/io.output.md index 2cdaeea0ef..ef385d897d 100644 --- a/unison-src/transcripts/io.output.md +++ b/unison-src/transcripts/io.output.md @@ -45,7 +45,7 @@ testCreateRename _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -58,7 +58,7 @@ testCreateRename _ = testCreateRename : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -127,7 +127,7 @@ testOpenClose _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -140,7 +140,7 @@ testOpenClose _ = testOpenClose : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -217,7 +217,7 @@ testGetSomeBytes _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -230,7 +230,7 @@ testGetSomeBytes _ = testGetSomeBytes : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -324,7 +324,7 @@ testAppend _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -338,7 +338,7 @@ testAppend _ = testSeek : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -385,7 +385,7 @@ testSystemTime _ = runTest test ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -398,7 +398,7 @@ testSystemTime _ = testSystemTime : '{IO} [Result] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -428,7 +428,7 @@ testGetTempDirectory _ = runTest test ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -459,7 +459,7 @@ testGetCurrentDirectory _ = runTest test ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -492,7 +492,7 @@ testDirContents _ = runTest test ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -525,7 +525,7 @@ testGetEnv _ = runTest test ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -580,7 +580,7 @@ testGetArgs.runMeWithTwoArgs = 'let Test that they can be run with the right number of args. -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -605,7 +605,7 @@ scratch/main> run runMeWithTwoArgs foo bar ``` Calling our examples with the wrong number of args will error. -```ucm +``` ucm scratch/main> run runMeWithNoArgs foo 💔💥 @@ -618,7 +618,7 @@ scratch/main> run runMeWithNoArgs foo ##raise ``` -```ucm +``` ucm scratch/main> run runMeWithOneArg 💔💥 @@ -631,7 +631,7 @@ scratch/main> run runMeWithOneArg ##raise ``` -```ucm +``` ucm scratch/main> run runMeWithOneArg foo bar 💔💥 @@ -645,7 +645,7 @@ scratch/main> run runMeWithOneArg foo bar ##raise ``` -```ucm +``` ucm scratch/main> run runMeWithTwoArgs 💔💥 @@ -667,7 +667,7 @@ testTimeZone = do () ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -690,7 +690,7 @@ testRandom = do runTest test ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/kind-inference.output.md b/unison-src/transcripts/kind-inference.output.md index 46a335a20a..c40961bc71 100644 --- a/unison-src/transcripts/kind-inference.output.md +++ b/unison-src/transcripts/kind-inference.output.md @@ -6,7 +6,7 @@ conflicting constraints on the kind of `a` in a product unique type T a = T a (a Nat) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ unique type T a | StarStar (a Nat) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,7 +44,7 @@ unique type Ping a = Ping Pong unique type Pong = Pong (Ping Optional) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -66,7 +66,7 @@ unique type Ping a = Ping a Pong unique type Pong = Pong (Ping Optional) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -85,7 +85,7 @@ unique ability Pong a where pong : Ping Optional -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -107,7 +107,7 @@ unique ability Pong a where pong : Ping Optional -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -126,7 +126,7 @@ unique type T a = T a unique type S = S (T Nat) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -150,7 +150,7 @@ unique type T a = T unique type S = S (T Optional) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -172,7 +172,7 @@ unique type T a = T a unique type S = S (T Optional) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -192,7 +192,7 @@ test : Nat Nat test = 0 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -210,7 +210,7 @@ test : Optional -> () test _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -230,7 +230,7 @@ test : T Nat -> () test _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -254,7 +254,7 @@ test _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -277,7 +277,7 @@ test : Foo -> () test _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -295,7 +295,7 @@ test : {Nat} () test _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -313,7 +313,7 @@ test _ = () unique type T a = T (a a) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -329,7 +329,7 @@ unique type T a = T (a a) unique type T a b = T (a b) (b a) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -346,7 +346,7 @@ unique type Ping a = Ping (a Pong) unique type Pong a = Pong (a Ping) ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/lambdacase.output.md b/unison-src/transcripts/lambdacase.output.md index 86fd5b234d..c7c6e01c24 100644 --- a/unison-src/transcripts/lambdacase.output.md +++ b/unison-src/transcripts/lambdacase.output.md @@ -8,7 +8,7 @@ isEmpty x = match x with _ -> false ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -29,7 +29,7 @@ isEmpty2 = cases _ -> false ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -45,7 +45,7 @@ isEmpty2 = cases ``` Notice that Unison detects this as an alias of `isEmpty`, and if we view `isEmpty` -```ucm +``` ucm scratch/main> view isEmpty isEmpty : [t] -> Boolean @@ -70,7 +70,7 @@ merge xs ys = match (xs, ys) with else h2 +: merge (h +: t) t2 ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -90,7 +90,7 @@ merge2 = cases else h2 +: merge2 (h +: t) t2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -106,7 +106,7 @@ merge2 = cases ``` Notice that Unison detects this as an alias of `merge`, and if we view `merge` -```ucm +``` ucm scratch/main> view merge merge : [a] -> [a] -> [a] @@ -139,7 +139,7 @@ blorf = cases > blorf T F ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -180,7 +180,7 @@ merge3 = cases | otherwise -> h2 +: merge3 (h +: t) t2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -193,7 +193,7 @@ merge3 = cases merge3 : [a] -> [a] -> [a] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -222,7 +222,7 @@ merge4 a b = match (a,b) with h +: t, h2 +: t2 | otherwise -> h2 +: merge4 (h +: t) t2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/lsp-fold-ranges.output.md b/unison-src/transcripts/lsp-fold-ranges.output.md index f2af4461bc..46e0a9c76c 100644 --- a/unison-src/transcripts/lsp-fold-ranges.output.md +++ b/unison-src/transcripts/lsp-fold-ranges.output.md @@ -23,7 +23,7 @@ test> z = let [Ok (x ++ y)] ``` -```ucm +``` ucm scratch/main> debug.lsp.fold-ranges 《{{ Type doc }}》 diff --git a/unison-src/transcripts/lsp-name-completion.output.md b/unison-src/transcripts/lsp-name-completion.output.md index 0b57f6a985..9c310ea871 100644 --- a/unison-src/transcripts/lsp-name-completion.output.md +++ b/unison-src/transcripts/lsp-name-completion.output.md @@ -17,7 +17,7 @@ sorted by number of name segments, shortest first. Individual LSP clients may still handle sorting differently, e.g. doing a fuzzy match over returned results, or prioritizing exact matches over partial matches. We don't have any control over that. -```ucm +``` ucm scratch/main> debug.lsp-name-completion foldMap Matching Path Name Hash @@ -30,7 +30,7 @@ scratch/main> debug.lsp-name-completion foldMap ``` Should still find the term which has a matching hash to a better name if the better name doesn't match. -```ucm +``` ucm scratch/main> debug.lsp-name-completion transitive_same_hash.foldMap Matching Path Name Hash diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index d67d0355b9..77350b1130 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -3,7 +3,7 @@ The `merge` command merges together two branches in the same project: the current branch (unspecificed), and the target branch. For example, to merge `topic` into `main`, switch to `main` and run `merge topic`: -```ucm +``` ucm scratch/main> help merge merge @@ -45,7 +45,7 @@ bar = "bobs bar" Merge result: -```ucm +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -82,7 +82,7 @@ bar = "bobs bar" Merge result: -```ucm +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -121,7 +121,7 @@ bar : Text bar = foo ++ " - " ++ foo ``` -```ucm +``` ucm project/bob> display bar "old foo - old foo" @@ -129,7 +129,7 @@ project/bob> display bar ``` Merge result: -```ucm +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -175,7 +175,7 @@ bar : Text bar = "alices bar" ``` -```ucm +``` ucm project/alice> display foo "foo - alices bar - old baz" @@ -188,7 +188,7 @@ baz : Text baz = "bobs baz" ``` -```ucm +``` ucm project/bob> display foo "foo - old bar - bobs baz" @@ -196,7 +196,7 @@ project/bob> display foo ``` Merge result: -```ucm +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -236,7 +236,7 @@ baz : Text baz = "old baz" ``` -```ucm +``` ucm project/main> display foo "old foo - old bar - old baz" @@ -249,7 +249,7 @@ baz : Text baz = "alices baz" ``` -```ucm +``` ucm project/alice> display foo "old foo - old bar - alices baz" @@ -262,7 +262,7 @@ bar : Text bar = "bobs bar" ++ " - " ++ baz ``` -```ucm +``` ucm project/bob> display foo "old foo - bobs bar - old baz" @@ -270,7 +270,7 @@ project/bob> display foo ``` Merge result: -```ucm +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -315,7 +315,7 @@ foo = "alices foo" Bob's changes: -```ucm +``` ucm project/bob> delete.term foo Done. @@ -323,7 +323,7 @@ project/bob> delete.term foo ``` Merge result: -```ucm +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -368,7 +368,7 @@ lib.bothDifferent.baz = 21 Merge result: -```ucm +``` ucm project/alice> merge bob I merged project/bob into project/alice. @@ -395,7 +395,7 @@ project/alice> view foo bar baz If Bob is equals Alice, then merging Bob into Alice looks like this. -```ucm +``` ucm project/main> branch alice Done. I've created the alice branch based off of main. @@ -421,7 +421,7 @@ project/alice> merge /bob If Bob is behind Alice, then merging Bob into Alice looks like this. -```ucm +``` ucm project/main> branch alice Done. I've created the alice branch based off of main. @@ -444,7 +444,7 @@ foo : Text foo = "foo" ``` -```ucm +``` ucm project/alice> add ⍟ I've added these definitions: @@ -462,7 +462,7 @@ project/alice> merge /bob If Bob is ahead of Alice, then merging Bob into Alice looks like this. -```ucm +``` ucm project/main> branch alice Done. I've created the alice branch based off of main. @@ -485,7 +485,7 @@ foo : Text foo = "foo" ``` -```ucm +``` ucm project/bob> add ⍟ I've added these definitions: @@ -499,7 +499,7 @@ project/alice> merge /bob ``` ## No-op merge: merge empty namespace into empty namespace -```ucm +``` ucm project/main> branch topic Done. I've created the topic branch based off of main. @@ -531,7 +531,7 @@ foo = "foo" Alice's delete: -```ucm +``` ucm project/alice> delete.term foo Done. @@ -544,7 +544,7 @@ bar : Text bar = foo ++ " - " ++ foo ``` -```ucm +``` ucm project/bob> add ⍟ I've added these definitions: @@ -605,7 +605,7 @@ bar : Text bar = foo ++ " - " ++ foo ``` -```ucm +``` ucm project/alice> merge /bob I couldn't automatically merge project/bob into project/alice. @@ -671,7 +671,7 @@ baz : Text baz = "bobs baz" ``` -```ucm +``` ucm project/alice> merge /bob I couldn't automatically merge project/bob into project/alice. @@ -710,7 +710,7 @@ qux = ``` -```ucm +``` ucm project/merge-bob-into-alice> view bar baz bar : Text @@ -742,7 +742,7 @@ Bob's changes: unique type Foo = MkFoo Nat Text ``` -```ucm +``` ucm project/alice> merge /bob I couldn't automatically merge project/bob into project/alice. @@ -793,7 +793,7 @@ Bob's renames `Qux` to `BobQux`: unique type Foo = Baz Nat | BobQux Text ``` -```ucm +``` ucm project/alice> merge /bob I couldn't automatically merge project/bob into project/alice. @@ -834,7 +834,7 @@ unique type Foo = Baz Nat | Qux Text Alice's rename: -```ucm +``` ucm project/alice> move.term Foo.Baz Foo.Alice Done. @@ -842,13 +842,13 @@ project/alice> move.term Foo.Baz Foo.Alice ``` Bob's rename: -```ucm +``` ucm project/bob> move.term Foo.Qux Foo.Bob Done. ``` -```ucm +``` ucm project/alice> merge bob I couldn't automatically merge project/bob into project/alice. @@ -895,7 +895,7 @@ unique ability my.cool where thing : Nat -> Nat ``` -```ucm +``` ucm project/alice> merge bob I couldn't automatically merge project/bob into project/alice. @@ -944,7 +944,7 @@ unique type Foo = Alice Nat Bob adds the type `Foo` with constructor `Foo.Bar`, replacing the original `Foo.Bar` term: -```ucm +``` ucm project/bob> delete.term Foo.Bar Done. @@ -956,7 +956,7 @@ unique type Foo = Bar Nat Nat These won't cleanly merge. -```ucm +``` ucm project/alice> merge bob I couldn't automatically merge project/bob into project/alice. @@ -1004,7 +1004,7 @@ Foo.Bar.Hello = 17 Alice deletes this type entirely, and repurposes its constructor names for other terms. She also updates the term. -```ucm +``` ucm project/alice> view Foo.Bar.Baz Foo.Bar.Qux Foo.Bar.Hello Foo.Bar.Baz : Nat @@ -1019,7 +1019,7 @@ project/alice> view Foo.Bar.Baz Foo.Bar.Qux Foo.Bar.Hello ``` Bob, meanwhile, first deletes the term, then sort of deletes the type and re-adds it under another name, but one constructor's fully qualified names doesn't actually change. The other constructor reuses the name of the deleted term. -```ucm +``` ucm project/bob> view Foo.Bar type Foo.Bar = Baz Nat | Hello Nat Nat @@ -1029,7 +1029,7 @@ At this point, Bob and alice have both updated the name `Foo.Bar.Hello` in diffe Notably, Alice's "unconflicted" update on the name "Foo.Bar.Baz" (because she changed its hash and Bob didn't touch it) is nonetheless considered conflicted with Bob's "Foo.Bar.Baz". -```ucm +``` ucm project/alice> merge bob I couldn't automatically merge project/bob into project/alice. @@ -1089,7 +1089,7 @@ bob : Foo -> Nat bob _ = 19 ``` -```ucm +``` ucm project/alice> merge bob I couldn't automatically merge project/bob into project/alice. @@ -1157,7 +1157,7 @@ foo = "bobs foo" Attempt to merge: -```ucm +``` ucm project/alice> merge /bob I couldn't automatically merge project/bob into project/alice. @@ -1195,7 +1195,7 @@ foo : Text foo = "alice and bobs foo" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1208,7 +1208,7 @@ foo = "alice and bobs foo" foo : Text ``` -```ucm +``` ucm project/merge-bob-into-alice> update Okay, I'm searching the branch for code that needs to be @@ -1238,7 +1238,7 @@ project/alice> branches `merge.commit` can only be run on a "merge branch". -```ucm +``` ucm project/main> branch topic Done. I've created the topic branch based off of main. @@ -1247,7 +1247,7 @@ project/main> branch topic `switch /main` then `merge /topic`. ``` -```ucm +``` ucm project/topic> merge.commit It doesn't look like there's a merge in progress. @@ -1288,7 +1288,7 @@ baz : Text baz = "baz" ``` -```ucm +``` ucm project/alice> merge /bob Sorry, I wasn't able to perform the merge: @@ -1318,7 +1318,7 @@ One way to fix this in the future would be to introduce a syntax for defining al Alice's branch: -```ucm +``` ucm project/alice> alias.type lib.builtins.Nat MyNat Done. @@ -1330,7 +1330,7 @@ Bob's branch: unique type MyNat = MyNat Nat ``` -```ucm +``` ucm project/alice> merge /bob Sorry, I wasn't able to perform the merge: @@ -1354,7 +1354,7 @@ Alice's branch: unique type Foo = Bar ``` -```ucm +``` ucm project/alice> alias.term Foo.Bar Foo.some.other.Alias Done. @@ -1367,7 +1367,7 @@ bob : Nat bob = 100 ``` -```ucm +``` ucm project/alice> merge /bob Sorry, I wasn't able to perform the merge: @@ -1392,7 +1392,7 @@ Alice's branch: unique type Foo = Bar ``` -```ucm +``` ucm project/alice> delete.term Foo.Bar Done. @@ -1405,7 +1405,7 @@ bob : Nat bob = 100 ``` -```ucm +``` ucm project/alice> merge /bob Sorry, I wasn't able to perform the merge: @@ -1429,7 +1429,7 @@ structural type A = B Nat | C Nat Nat structural type A.inner.X = Y Nat | Z Nat Nat ``` -```ucm +``` ucm project/alice> names A Type @@ -1446,7 +1446,7 @@ bob : Nat bob = 100 ``` -```ucm +``` ucm project/alice> merge /bob On project/alice, the type A.inner.X is an alias of A. I'm not @@ -1461,7 +1461,7 @@ Constructors may only exist within the corresponding decl's namespace. Alice's branch: -```ucm +``` ucm project/alice> add ⍟ I've added these definitions: @@ -1475,7 +1475,7 @@ project/alice> alias.term Foo.Bar AliasOutsideFooNamespace ``` Bob's branch: -```ucm +``` ucm project/bob> add ⍟ I've added these definitions: @@ -1483,7 +1483,7 @@ project/bob> add bob : Nat ``` -```ucm +``` ucm project/alice> merge bob Sorry, I wasn't able to perform the merge, because I need all @@ -1514,7 +1514,7 @@ bob : Nat bob = 100 ``` -```ucm +``` ucm project/alice> merge /bob Sorry, I wasn't able to perform the merge: @@ -1539,7 +1539,7 @@ LCA: structural type Foo = Bar Nat | Baz Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1552,7 +1552,7 @@ structural type Foo = Bar Nat | Baz Nat Nat structural type Foo ``` -```ucm +``` ucm project/main> add ⍟ I've added these definitions: @@ -1566,7 +1566,7 @@ project/main> delete.term Foo.Baz ``` Alice's branch: -```ucm +``` ucm project/main> branch alice Done. I've created the alice branch based off of main. @@ -1588,7 +1588,7 @@ alice : Nat alice = 100 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1601,7 +1601,7 @@ alice = 100 alice : Nat ``` -```ucm +``` ucm project/alice> add ⍟ I've added these definitions: @@ -1611,7 +1611,7 @@ project/alice> add ``` Bob's branch: -```ucm +``` ucm project/main> branch bob Done. I've created the bob branch based off of main. @@ -1633,7 +1633,7 @@ bob : Nat bob = 101 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1646,7 +1646,7 @@ bob = 101 bob : Nat ``` -```ucm +``` ucm project/bob> add ⍟ I've added these definitions: @@ -1656,7 +1656,7 @@ project/bob> add ``` Now we merge: -```ucm +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -1671,7 +1671,7 @@ foo = 17 bar = 17 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1685,7 +1685,7 @@ bar = 17 foo : Nat ``` -```ucm +``` ucm project/main> add ⍟ I've added these definitions: @@ -1709,7 +1709,7 @@ project/alice> delete.term bar foo = 18 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1723,7 +1723,7 @@ foo = 18 foo : Nat ``` -```ucm +``` ucm project/alice> update Okay, I'm searching the branch for code that needs to be @@ -1743,7 +1743,7 @@ project/main> branch bob bob = 101 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1756,7 +1756,7 @@ bob = 101 bob : Nat ``` -```ucm +``` ucm project/bob> add ⍟ I've added these definitions: @@ -1764,7 +1764,7 @@ project/bob> add bob : Nat ``` -```ucm +``` ucm project/alice> merge /bob I merged project/bob into project/alice. @@ -1776,7 +1776,7 @@ project/alice> merge /bob type Foo = Bar | Baz ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1789,7 +1789,7 @@ type Foo = Bar | Baz type Foo ``` -```ucm +``` ucm project/main> add ⍟ I've added these definitions: @@ -1808,7 +1808,7 @@ project/main> branch topic boop = "boop" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1821,7 +1821,7 @@ boop = "boop" boop : Text ``` -```ucm +``` ucm project/topic> add ⍟ I've added these definitions: @@ -1833,7 +1833,7 @@ project/topic> add type Foo = Bar ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1847,7 +1847,7 @@ type Foo = Bar type Foo ``` -```ucm +``` ucm project/main> update Okay, I'm searching the branch for code that needs to be @@ -1856,7 +1856,7 @@ project/main> update Done. ``` -```ucm +``` ucm project/main> merge topic I merged project/topic into project/main. @@ -1883,7 +1883,7 @@ baz : Text baz = "lca" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1898,7 +1898,7 @@ baz = "lca" foo : Nat ``` -```ucm +``` ucm project/alice> add ⍟ I've added these definitions: @@ -1922,7 +1922,7 @@ baz : Text baz = "bob" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1936,7 +1936,7 @@ baz = "bob" baz : Text ``` -```ucm +``` ucm project/bob> update Okay, I'm searching the branch for code that needs to be @@ -1955,7 +1955,7 @@ baz : Text baz = "alice" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1970,7 +1970,7 @@ baz = "alice" foo : Nat ``` -```ucm +``` ucm project/alice> update Okay, I'm searching the branch for code that needs to be @@ -1986,7 +1986,7 @@ project/alice> update When we try to merge Bob into Alice, we should see both versions of `baz`, with Alice's unconflicted `foo` and `bar` in the underlying namespace. -```ucm +``` ucm project/alice> merge /bob I couldn't automatically merge project/bob into project/alice. @@ -2038,7 +2038,7 @@ Let's make three identical namespaces with different histories: a = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -2051,7 +2051,7 @@ a = 1 a : ##Nat ``` -```ucm +``` ucm project/alice> add ⍟ I've added these definitions: @@ -2063,7 +2063,7 @@ project/alice> add b = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -2076,7 +2076,7 @@ b = 2 b : ##Nat ``` -```ucm +``` ucm project/alice> add ⍟ I've added these definitions: @@ -2088,7 +2088,7 @@ project/alice> add b = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -2096,7 +2096,7 @@ b = 2 file has been previously added to the codebase. ``` -```ucm +``` ucm project/bob> add ⍟ I've added these definitions: @@ -2108,7 +2108,7 @@ project/bob> add a = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -2121,7 +2121,7 @@ a = 1 a : ##Nat ``` -```ucm +``` ucm project/bob> add ⍟ I've added these definitions: @@ -2134,7 +2134,7 @@ a = 1 b = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -2142,7 +2142,7 @@ b = 2 file has been previously added to the codebase. ``` -```ucm +``` ucm project/carol> add ⍟ I've added these definitions: @@ -2193,7 +2193,7 @@ bar = foo + foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -2208,7 +2208,7 @@ bar = ignore : a -> () ``` -```ucm +``` ucm scratch/alice> add ⍟ I've added these definitions: @@ -2232,7 +2232,7 @@ bar = foo + foo + foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -2246,7 +2246,7 @@ bar = bar : Nat ``` -```ucm +``` ucm scratch/bob> update Okay, I'm searching the branch for code that needs to be @@ -2263,7 +2263,7 @@ foo : Nat foo = 19 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -2277,7 +2277,7 @@ foo = 19 foo : Nat ``` -```ucm +``` ucm scratch/alice> update Okay, I'm searching the branch for code that needs to be @@ -2290,7 +2290,7 @@ scratch/alice> update Done. ``` -```ucm +``` ucm scratch/alice> merge /bob I merged scratch/bob into scratch/alice. diff --git a/unison-src/transcripts/move-all.output.md b/unison-src/transcripts/move-all.output.md index cd68b319c3..36116ad2bf 100644 --- a/unison-src/transcripts/move-all.output.md +++ b/unison-src/transcripts/move-all.output.md @@ -11,7 +11,7 @@ Foo.termInA = 1 unique type Foo.T = T ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,7 +27,7 @@ unique type Foo.T = T Foo.termInA : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -43,7 +43,7 @@ Foo.termInA = 2 unique type Foo.T = T1 | T2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -59,7 +59,7 @@ unique type Foo.T = T1 | T2 (also named Foo) ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be @@ -70,7 +70,7 @@ scratch/main> update ``` Should be able to move the term, type, and namespace, including its types, terms, and sub-namespaces. -```ucm +``` ucm scratch/main> move Foo Bar Done. @@ -113,7 +113,7 @@ scratch/main> history Bar bonk = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -126,7 +126,7 @@ bonk = 5 bonk : Nat ``` -```ucm +``` ucm z/main> builtins.merge Done. @@ -153,7 +153,7 @@ z/main> ls bonk.zonk = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -167,7 +167,7 @@ bonk.zonk = 5 (also named zonk) ``` -```ucm +``` ucm a/main> builtins.merge Done. @@ -195,7 +195,7 @@ a/main> view zonk.zonk ``` ## Sad Path - No term, type, or namespace named src -```ucm +``` ucm scratch/main> move doesntexist foo ⚠️ diff --git a/unison-src/transcripts/move-namespace.output.md b/unison-src/transcripts/move-namespace.output.md index 57b010c0d7..627edf4a95 100644 --- a/unison-src/transcripts/move-namespace.output.md +++ b/unison-src/transcripts/move-namespace.output.md @@ -8,7 +8,7 @@ I should be able to move the root into a sub-namespace foo = 1 ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -41,7 +41,7 @@ foo = 1 □ 1. #g97lh1m2v7 (start of history) ``` -```ucm +``` ucm .> ls .root.at.path 1. foo (##Nat) @@ -58,7 +58,7 @@ foo = 1 ``` I should be able to move a sub namespace *over* the root. -```ucm +``` ucm -- Should request confirmation .> move.namespace .root.at.path . @@ -85,7 +85,7 @@ I should be able to move a sub namespace *over* the root. □ 1. #08a6hgi6s4 (start of history) ``` -```ucm +``` ucm -- should be empty .> ls .root.at.path @@ -105,7 +105,7 @@ a.termInA = 1 unique type a.T = T ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -119,7 +119,7 @@ unique type a.T = T a.termInA : Nat ``` -```ucm +``` ucm scratch/happy> add ⍟ I've added these definitions: @@ -133,7 +133,7 @@ a.termInA = 2 unique type a.T = T1 | T2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -148,7 +148,7 @@ unique type a.T = T1 | T2 a.termInA : Nat ``` -```ucm +``` ucm scratch/happy> update Okay, I'm searching the branch for code that needs to be @@ -159,7 +159,7 @@ scratch/happy> update ``` Should be able to move the namespace, including its types, terms, and sub-namespaces. -```ucm +``` ucm scratch/happy> move.namespace a b Done. @@ -197,7 +197,7 @@ a.termInA = 1 b.termInB = 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -211,7 +211,7 @@ b.termInB = 10 b.termInB : Nat ``` -```ucm +``` ucm scratch/history> add ⍟ I've added these definitions: @@ -225,7 +225,7 @@ a.termInA = 2 b.termInB = 11 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -240,7 +240,7 @@ b.termInB = 11 b.termInB : Nat ``` -```ucm +``` ucm scratch/history> update Okay, I'm searching the branch for code that needs to be @@ -253,7 +253,7 @@ Deleting a namespace should not leave behind any history, if we move another to that location we expect the history to simply be the history of the moved namespace. -```ucm +``` ucm scratch/history> delete.namespace b Done. @@ -291,7 +291,7 @@ a.termInA = 1 b.termInB = 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -305,7 +305,7 @@ b.termInB = 10 b.termInB : Nat ``` -```ucm +``` ucm scratch/existing> add ⍟ I've added these definitions: @@ -319,7 +319,7 @@ a.termInA = 2 b.termInB = 11 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -334,7 +334,7 @@ b.termInB = 11 b.termInB : Nat ``` -```ucm +``` ucm scratch/existing> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/name-segment-escape.output.md b/unison-src/transcripts/name-segment-escape.output.md index f324018ff7..4a58422746 100644 --- a/unison-src/transcripts/name-segment-escape.output.md +++ b/unison-src/transcripts/name-segment-escape.output.md @@ -1,6 +1,6 @@ You can use a keyword or reserved operator as a name segment if you surround it with backticks. -```ucm +``` ucm scratch/main> view `match` ⚠️ @@ -20,7 +20,7 @@ You can also use backticks to expand the set of valid symbols in a symboly name This allows you to spell `.` or `()` as name segments (which historically have appeared in the namespace). -```ucm +``` ucm scratch/main> view `.` ⚠️ diff --git a/unison-src/transcripts/name-selection.output.md b/unison-src/transcripts/name-selection.output.md index 0df0ba3a0a..f76c6796f5 100644 --- a/unison-src/transcripts/name-selection.output.md +++ b/unison-src/transcripts/name-selection.output.md @@ -12,7 +12,7 @@ a.aaa.but.more.segments = 0 + 1 Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment length alias), and show that it isn't used when viewing `a`: -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -47,7 +47,7 @@ a3.d = a3.c + 10 a3.long.name.but.shortest.suffixification = 1 ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -84,7 +84,7 @@ At this point, `a3` is conflicted for symbols `c` and `d`, so those are depriori The original `a2` namespace has an unconflicted definition for `c` and `d`, but since there are multiple 'c's in scope, `a2.c` is chosen because although the suffixified version has fewer segments, its fully-qualified name has the fewest segments. -```ucm +``` ucm .> view a b c d a.a : Nat @@ -125,7 +125,7 @@ deeply.nested.num = 10 a = 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -140,7 +140,7 @@ a = 10 deeply.nested.term : Nat ``` -```ucm +``` ucm .biasing> add ⍟ I've added these definitions: @@ -166,7 +166,7 @@ Add another term with `num` suffix to force longer suffixification of `deeply.ne other.num = 20 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -179,7 +179,7 @@ other.num = 20 other.num : Nat ``` -```ucm +``` ucm .biasing> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index 13d62fd7bf..287782fa2a 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -12,7 +12,7 @@ somewhere.z = 1 somewhere.y = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -29,7 +29,7 @@ somewhere.y = 2 somewhere.z : ##Nat ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -43,7 +43,7 @@ somewhere.y = 2 ``` `names` searches relative to the current path. -```ucm +``` ucm -- We can search by suffix and find all definitions named 'x', and each of their aliases respectively. -- But we don't see somewhere.z which is has the same value but is out of our namespace .some> names x @@ -78,7 +78,7 @@ somewhere.y = 2 ``` `names.global` searches from the root, and absolutely qualifies results -```ucm +``` ucm -- We can search by suffix and find all definitions in the codebase named 'x', and each of their aliases respectively. .some> names.global x diff --git a/unison-src/transcripts/namespace-deletion-regression.output.md b/unison-src/transcripts/namespace-deletion-regression.output.md index 21e0866f75..1730897d3e 100644 --- a/unison-src/transcripts/namespace-deletion-regression.output.md +++ b/unison-src/transcripts/namespace-deletion-regression.output.md @@ -7,7 +7,7 @@ If branch operations aren't performed in the correct order it's possible to end Previously the following sequence delete the current namespace unexpectedly 😬. -```ucm +``` ucm scratch/main> alias.term ##Nat.+ Nat.+ Done. diff --git a/unison-src/transcripts/namespace-dependencies.output.md b/unison-src/transcripts/namespace-dependencies.output.md index ae41b95183..80ea30e391 100644 --- a/unison-src/transcripts/namespace-dependencies.output.md +++ b/unison-src/transcripts/namespace-dependencies.output.md @@ -6,7 +6,7 @@ external.mynat = 1 mynamespace.dependsOnText = const external.mynat 10 ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/numbered-args.output.md b/unison-src/transcripts/numbered-args.output.md index ba6016b962..0567bcac3f 100644 --- a/unison-src/transcripts/numbered-args.output.md +++ b/unison-src/transcripts/numbered-args.output.md @@ -11,7 +11,7 @@ quux = "quux" corge = "corge" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -29,7 +29,7 @@ corge = "corge" qux : Text ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -45,7 +45,7 @@ scratch/main> add We can get the list of things in the namespace, and UCM will give us a numbered list: -```ucm +``` ucm scratch/main> find 1. bar : Text @@ -60,7 +60,7 @@ scratch/main> find ``` We can ask to `view` the second element of this list: -```ucm +``` ucm scratch/main> find 1. bar : Text @@ -80,7 +80,7 @@ scratch/main> view 2 ``` And we can `view` multiple elements by separating with spaces: -```ucm +``` ucm scratch/main> find 1. bar : Text @@ -106,7 +106,7 @@ scratch/main> view 2 3 5 ``` We can also ask for a range: -```ucm +``` ucm scratch/main> find 1. bar : Text @@ -132,7 +132,7 @@ scratch/main> view 2-4 ``` And we can ask for multiple ranges and use mix of ranges and numbers: -```ucm +``` ucm scratch/main> find 1. bar : Text diff --git a/unison-src/transcripts/old-fold-right.output.md b/unison-src/transcripts/old-fold-right.output.md index f054ba9596..a74a317a49 100644 --- a/unison-src/transcripts/old-fold-right.output.md +++ b/unison-src/transcripts/old-fold-right.output.md @@ -11,7 +11,7 @@ pecan = 'let oldRight f la ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/pattern-match-coverage.output.md b/unison-src/transcripts/pattern-match-coverage.output.md index ea249e9f72..575c35cab0 100644 --- a/unison-src/transcripts/pattern-match-coverage.output.md +++ b/unison-src/transcripts/pattern-match-coverage.output.md @@ -10,7 +10,7 @@ test = cases A -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -36,7 +36,7 @@ test = cases (B, None) -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -65,7 +65,7 @@ test = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -86,7 +86,7 @@ test = cases (A, Some A) -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -108,7 +108,7 @@ test = cases Some None -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -132,7 +132,7 @@ test0 = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -151,7 +151,7 @@ test = cases Some _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -170,7 +170,7 @@ test = cases () | false -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -191,7 +191,7 @@ test = cases | isEven x -> x ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -217,7 +217,7 @@ test = cases | otherwise -> 0 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -244,7 +244,7 @@ test = cases Some None -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -268,7 +268,7 @@ test = cases Some (Some A) -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -297,7 +297,7 @@ test = cases 0 -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -318,7 +318,7 @@ test = cases true -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -342,7 +342,7 @@ test = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -364,7 +364,7 @@ test = cases false -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -389,7 +389,7 @@ test = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -408,7 +408,7 @@ test = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -428,7 +428,7 @@ test = cases x +: xs -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -449,7 +449,7 @@ test = cases [] -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -468,7 +468,7 @@ test = cases x +: xs -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -487,7 +487,7 @@ test = cases xs :+ x -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -507,7 +507,7 @@ test = cases [] -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -528,7 +528,7 @@ test = cases x0 +: [] -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -554,7 +554,7 @@ test = cases [] -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -586,7 +586,7 @@ test = cases true +: xs -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -611,7 +611,7 @@ test = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -636,7 +636,7 @@ test = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -655,7 +655,7 @@ unit2t = cases () -> A ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -669,7 +669,7 @@ unit2t = cases unit2t : 'T ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -692,7 +692,7 @@ witht = match unit2t () with x -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -712,7 +712,7 @@ evil : Unit -> V evil = bug "" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -726,7 +726,7 @@ evil = bug "" evil : 'V ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -741,7 +741,7 @@ withV = match evil () with x -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -754,7 +754,7 @@ withV = match evil () with unique type SomeType = A ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -767,7 +767,7 @@ unique type SomeType = A type SomeType ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -782,7 +782,7 @@ get x = match x with R y -> y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -800,7 +800,7 @@ get x = match x with unique type R = { someType : SomeType } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -831,7 +831,7 @@ result f = handle !f with cases { abort -> _ } -> bug "aborted" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -858,7 +858,7 @@ result f = handle !f with cases { abort -> _ } -> bug "aborted" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -889,7 +889,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -919,7 +919,7 @@ handleMulti c = handle !c with impl [] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -947,7 +947,7 @@ result f = handle !f with cases { abort -> _ } -> bug "aborted" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -974,7 +974,7 @@ result f = handle !f with cases { abort -> _ } -> bug "aborted" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1000,7 +1000,7 @@ result f = handle !f with cases { give A -> resume } -> result resume ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1030,7 +1030,7 @@ handleMulti c = handle !c with impl [] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1059,7 +1059,7 @@ result f = handle !f with cases { give A -> resume } -> result resume ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1083,7 +1083,7 @@ result f = handle !f with cases { abortWithMessage msg -> _ } -> abortWithMessage ("aborting: " ++ msg) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1111,7 +1111,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1139,7 +1139,7 @@ result f = handle !f with cases { abortWithMessage msg -> _ } -> abortWithMessage ("aborting: " ++ msg) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1179,7 +1179,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1208,7 +1208,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1236,7 +1236,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1265,7 +1265,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1295,7 +1295,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -1323,7 +1323,7 @@ result f = handle !f with impl ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/pattern-pretty-print-2345.output.md b/unison-src/transcripts/pattern-pretty-print-2345.output.md index 15ebf87401..7112974125 100644 --- a/unison-src/transcripts/pattern-pretty-print-2345.output.md +++ b/unison-src/transcripts/pattern-pretty-print-2345.output.md @@ -59,7 +59,7 @@ doc = cases _ -> () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -86,7 +86,7 @@ doc = cases tremulous : (Nat, Nat) -> () ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/patternMatchTls.output.md b/unison-src/transcripts/patternMatchTls.output.md index 7d207ef375..1e6e9ced27 100644 --- a/unison-src/transcripts/patternMatchTls.output.md +++ b/unison-src/transcripts/patternMatchTls.output.md @@ -20,7 +20,7 @@ assertRight = cases Left _ -> bug "expected a right but got a left" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -34,7 +34,7 @@ assertRight = cases frank : '{IO} () ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/patterns.output.md b/unison-src/transcripts/patterns.output.md index 054c9224ea..f68423848f 100644 --- a/unison-src/transcripts/patterns.output.md +++ b/unison-src/transcripts/patterns.output.md @@ -7,7 +7,7 @@ p1 = join [literal "blue", literal "frog"] > Pattern.run (many.corrected p1) "bluefrogbluegoat" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/propagate.output.md b/unison-src/transcripts/propagate.output.md index 036681f1b6..14da5ae23e 100644 --- a/unison-src/transcripts/propagate.output.md +++ b/unison-src/transcripts/propagate.output.md @@ -9,7 +9,7 @@ fooToInt : Foo -> Int fooToInt _ = +42 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -25,7 +25,7 @@ fooToInt _ = +42 ``` And then we add it. -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -58,7 +58,7 @@ Then if we change the type `Foo`... unique type Foo = Foo | Bar ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -74,7 +74,7 @@ unique type Foo = Foo | Bar ``` and update the codebase to use the new type `Foo`... -```ucm +``` ucm scratch/main> update.old ⍟ I've updated these names to your new definition: @@ -84,7 +84,7 @@ scratch/main> update.old ``` ... it should automatically propagate the type to `fooToInt`. -```ucm +``` ucm scratch/main> view fooToInt fooToInt : Foo -> Int @@ -104,7 +104,7 @@ preserve.otherTerm : Optional baz -> Optional baz preserve.otherTerm y = someTerm y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -120,7 +120,7 @@ preserve.otherTerm y = someTerm y ``` Add that to the codebase: -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -136,7 +136,7 @@ preserve.someTerm : Optional x -> Optional x preserve.someTerm _ = None ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -152,7 +152,7 @@ preserve.someTerm _ = None ``` Update... -```ucm +``` ucm scratch/main> update.old ⍟ I've updated these names to your new definition: @@ -163,7 +163,7 @@ scratch/main> update.old Now the type of `someTerm` should be `Optional x -> Optional x` and the type of `otherTerm` should remain the same. -```ucm +``` ucm scratch/main> view preserve.someTerm preserve.someTerm : Optional x -> Optional x @@ -179,7 +179,7 @@ scratch/main> view preserve.otherTerm Cleaning up a bit... -```ucm +``` ucm ☝️ The namespace .subpath.lib is empty. .subpath.lib> builtins.merge @@ -197,7 +197,7 @@ one.otherTerm : Optional baz -> Optional baz one.otherTerm y = someTerm y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -213,7 +213,7 @@ one.otherTerm y = someTerm y ``` We'll make two copies of this namespace. -```ucm +``` ucm .subpath> add ⍟ I've added these definitions: @@ -233,7 +233,7 @@ someTerm : Optional x -> Optional x someTerm _ = None ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -248,7 +248,7 @@ someTerm _ = None ``` ... in one of the namespaces... -```ucm +``` ucm .subpath.one> update.old ⍟ I've updated these names to your new definition: @@ -258,7 +258,7 @@ someTerm _ = None ``` The other namespace should be left alone. -```ucm +``` ucm .subpath> view two.someTerm two.someTerm : Optional foo -> Optional foo diff --git a/unison-src/transcripts/pull-errors.output.md b/unison-src/transcripts/pull-errors.output.md index 063c439dd5..38afde71c9 100644 --- a/unison-src/transcripts/pull-errors.output.md +++ b/unison-src/transcripts/pull-errors.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm test/main> pull @aryairani/test-almost-empty/main lib.base_latest The use of `pull` to install libraries is now deprecated. diff --git a/unison-src/transcripts/records.output.md b/unison-src/transcripts/records.output.md index 8d2be7417c..3e3d66245c 100644 --- a/unison-src/transcripts/records.output.md +++ b/unison-src/transcripts/records.output.md @@ -6,7 +6,7 @@ Ensure that Records keep their syntax after being added to the codebase unique type Record1 = { a : Text } ``` -```ucm +``` ucm scratch/main> view Record1 type Record1 = { a : Text } @@ -18,7 +18,7 @@ scratch/main> view Record1 unique type Record2 = { a : Text, b : Int } ``` -```ucm +``` ucm scratch/main> view Record2 type Record2 = { a : Text, b : Int } @@ -30,7 +30,7 @@ scratch/main> view Record2 unique type Record3 = { a : Text, b : Int, c : Nat } ``` -```ucm +``` ucm scratch/main> view Record3 type Record3 = { a : Text, b : Int, c : Nat } @@ -50,7 +50,7 @@ unique type Record4 = } ``` -```ucm +``` ucm scratch/main> view Record4 type Record4 @@ -91,7 +91,7 @@ unique type Record5 = { } ``` -```ucm +``` ucm scratch/main> view Record5 type Record5 @@ -130,7 +130,7 @@ unique type RecordWithUserType = { a : Text, b : Record4, c : UserType } If you `view` or `edit` it, it *should* be treated as a record type, but it does not (which is a bug) -```ucm +``` ucm scratch/main> view RecordWithUserType type RecordWithUserType @@ -148,7 +148,7 @@ unique type Record5 = } ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index a608b04a9a..c78f00a839 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -5,7 +5,7 @@ for the `reflog` command to display: x = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,7 +18,7 @@ x = 1 x : Nat ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -30,7 +30,7 @@ x = 1 y = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -43,7 +43,7 @@ y = 2 y : Nat ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -56,7 +56,7 @@ y = 2 y = 2 ``` -```ucm +``` ucm .> reflog Here is a log of the root namespace hashes, starting with the @@ -82,13 +82,13 @@ y = 2 ``` If we `reset-root` to its previous value, `y` disappears. -```ucm +``` ucm .> reset-root 2 Done. ``` -```ucm +``` ucm .> view y ⚠️ diff --git a/unison-src/transcripts/release-draft-command.output.md b/unison-src/transcripts/release-draft-command.output.md index 58077a37e0..3354e764f9 100644 --- a/unison-src/transcripts/release-draft-command.output.md +++ b/unison-src/transcripts/release-draft-command.output.md @@ -6,7 +6,7 @@ Some setup: someterm = 18 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ someterm = 18 someterm : Nat ``` -```ucm +``` ucm foo/main> add ⍟ I've added these definitions: @@ -31,7 +31,7 @@ Now, the `release.draft` demo: `release.draft` accepts a single semver argument. -```ucm +``` ucm foo/main> release.draft 1.2.3 😎 Great! I've created a draft release for you at @@ -51,7 +51,7 @@ foo/main> release.draft 1.2.3 ``` It's an error to try to create a `releases/drafts/x.y.z` branch that already exists. -```ucm +``` ucm foo/main> release.draft 1.2.3 foo/releases/drafts/1.2.3 already exists. You can switch to it diff --git a/unison-src/transcripts/reset.output.md b/unison-src/transcripts/reset.output.md index 1858250abc..8fa6362a9a 100644 --- a/unison-src/transcripts/reset.output.md +++ b/unison-src/transcripts/reset.output.md @@ -4,7 +4,7 @@ a = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,7 +17,7 @@ a = 5 a : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -55,7 +55,7 @@ scratch/main> history foo.a = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -68,7 +68,7 @@ foo.a = 5 foo.a : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -103,7 +103,7 @@ scratch/main> ls foo.foo ``` # reset branch -```ucm +``` ucm foo/main> history ☝️ The namespace is empty. @@ -113,7 +113,7 @@ foo/main> history a = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -126,7 +126,7 @@ a = 5 a : ##Nat ``` -```ucm +``` ucm foo/main> add ⍟ I've added these definitions: @@ -154,7 +154,7 @@ foo/main> history a = 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -168,7 +168,7 @@ a = 3 a : ##Nat ``` -```ucm +``` ucm foo/main> update Okay, I'm searching the branch for code that needs to be @@ -198,7 +198,7 @@ foo/main> history main.a = 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -211,7 +211,7 @@ main.a = 3 main.a : ##Nat ``` -```ucm +``` ucm foo/main> add ⍟ I've added these definitions: @@ -250,7 +250,7 @@ foo/main> reset 2 main main.a = 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -258,7 +258,7 @@ main.a = 3 file has been previously added to the codebase. ``` -```ucm +``` ucm foo/main> switch /topic foo/topic> add diff --git a/unison-src/transcripts/resolution-failures.output.md b/unison-src/transcripts/resolution-failures.output.md index 262f6f744d..d30deb4240 100644 --- a/unison-src/transcripts/resolution-failures.output.md +++ b/unison-src/transcripts/resolution-failures.output.md @@ -14,7 +14,7 @@ one.ambiguousTerm = "term one" two.ambiguousTerm = "term two" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -30,7 +30,7 @@ two.ambiguousTerm = "term two" two.ambiguousTerm : ##Text ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -65,7 +65,7 @@ separateAmbiguousTypeUsage : AmbiguousType -> () separateAmbiguousTypeUsage _ = () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -100,7 +100,7 @@ but expect it to eventually be handled by the above machinery. useAmbiguousTerm = ambiguousTerm ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/rsa.output.md b/unison-src/transcripts/rsa.output.md index a5994b24bd..98e735c2ed 100644 --- a/unison-src/transcripts/rsa.output.md +++ b/unison-src/transcripts/rsa.output.md @@ -30,7 +30,7 @@ sigKo = match signature with > sigKo ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/scope-ref.output.md b/unison-src/transcripts/scope-ref.output.md index 1319186623..c356bc531d 100644 --- a/unison-src/transcripts/scope-ref.output.md +++ b/unison-src/transcripts/scope-ref.output.md @@ -13,7 +13,7 @@ test = Scope.run 'let > test ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/suffixes.output.md b/unison-src/transcripts/suffixes.output.md index 5752f29187..43aa678efd 100644 --- a/unison-src/transcripts/suffixes.output.md +++ b/unison-src/transcripts/suffixes.output.md @@ -15,7 +15,7 @@ optional.isNone = cases This also affects commands like find. Notice lack of qualified names in output: -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -35,7 +35,7 @@ scratch/main> find take ``` The `view` and `display` commands also benefit from this: -```ucm +``` ucm scratch/main> view List.drop builtin builtin.List.drop : builtin.Nat -> [a] -> [a] @@ -49,7 +49,7 @@ In the signature, we don't see `base.Nat`, just `Nat`. The full declaration name Type-based search also benefits from this, we can just say `Nat` rather than `.base.Nat`: -```ucm +``` ucm scratch/main> find : Nat -> [a] -> [a] 1. builtin.List.drop : Nat -> [a] -> [a] @@ -68,7 +68,7 @@ lib.distributed.baz.qux = "direct dependency 2" lib.distributed.lib.baz.qux = "indirect dependency" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -84,7 +84,7 @@ lib.distributed.lib.baz.qux = "indirect dependency" lib.distributed.lib.baz.qux : Text ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -99,7 +99,7 @@ scratch/main> add > abra.cadabra ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -121,7 +121,7 @@ scratch/main> add > baz.qux ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -137,7 +137,7 @@ scratch/main> add "direct dependency 2" ``` -```ucm +``` ucm scratch/main> view abra.cadabra cool.abra.cadabra : Text @@ -154,7 +154,7 @@ scratch/main> view baz.qux ``` Note that we can always still view indirect dependencies by using more name segments: -```ucm +``` ucm scratch/main> view distributed.abra.cadabra lib.distributed.abra.cadabra : Text @@ -180,7 +180,7 @@ foo.a = 23 bar = 100 ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -207,7 +207,7 @@ fn = cases _ -> todo "hmm" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/sum-type-update-conflicts.output.md b/unison-src/transcripts/sum-type-update-conflicts.output.md index f28ec5dd41..ba70632b86 100644 --- a/unison-src/transcripts/sum-type-update-conflicts.output.md +++ b/unison-src/transcripts/sum-type-update-conflicts.output.md @@ -8,7 +8,7 @@ First we add a sum-type to the codebase. structural type X = x ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,7 +22,7 @@ structural type X = x (also named lib.builtins.Unit) ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -43,7 +43,7 @@ X.x = "some text that's not in the codebase" dependsOnX = Text.size X.x ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -66,7 +66,7 @@ dependsOnX = Text.size X.x This update should succeed since the conflicted constructor is removed in the same update that the new term is being added. -```ucm +``` ucm scratch/main> update.old ⍟ I've added these definitions: diff --git a/unison-src/transcripts/switch-command.output.md b/unison-src/transcripts/switch-command.output.md index f00a15723c..96778f99d7 100644 --- a/unison-src/transcripts/switch-command.output.md +++ b/unison-src/transcripts/switch-command.output.md @@ -6,7 +6,7 @@ Setup stuff. someterm = 18 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ someterm = 18 someterm : Nat ``` -```ucm +``` ucm foo/main> add ⍟ I've added these definitions: @@ -45,7 +45,7 @@ Now, the demo. When unambiguous, `switch` switches to either a project or a bran the current project can be preceded by a forward slash (which makes it unambiguous). A project can be followed by a forward slash (which makes it unambiguous). -```ucm +``` ucm scratch/main> switch foo scratch/main> switch foo/topic @@ -59,7 +59,7 @@ foo/main> switch bar/ ``` It's an error to try to switch to something ambiguous. -```ucm +``` ucm foo/main> switch bar I'm not sure if you wanted to switch to the branch foo/bar or @@ -73,20 +73,20 @@ foo/main> switch bar ``` It's an error to try to switch to something that doesn't exist, of course. -```ucm +``` ucm scratch/main> switch foo/no-such-branch foo/no-such-branch does not exist. ``` -```ucm +``` ucm scratch/main> switch no-such-project Neither project no-such-project nor branch /no-such-project exists. ``` -```ucm +``` ucm foo/main> switch no-such-project-or-branch Neither project no-such-project-or-branch nor branch diff --git a/unison-src/transcripts/tab-completion.output.md b/unison-src/transcripts/tab-completion.output.md index 86a7b552e3..98c26e77f3 100644 --- a/unison-src/transcripts/tab-completion.output.md +++ b/unison-src/transcripts/tab-completion.output.md @@ -4,7 +4,7 @@ Test that tab completion works as expected. ## Tab Complete Command Names -```ucm +``` ucm scratch/main> debug.tab-complete vi view @@ -34,7 +34,7 @@ othernamespace.someName = 4 unique type subnamespace.AType = A | B ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -51,7 +51,7 @@ unique type subnamespace.AType = A | B subnamespace2.thing : ##Nat ``` -```ucm +``` ucm -- Should tab complete namespaces since they may contain terms/types scratch/main> debug.tab-complete view sub @@ -93,7 +93,7 @@ scratch/main> debug.tab-complete view subnamespace.someOther absolute.term = "absolute" ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -108,7 +108,7 @@ absolute.term = "absolute" ``` ## Tab complete namespaces -```ucm +``` ucm -- Should tab complete namespaces scratch/main> debug.tab-complete find-in sub @@ -149,7 +149,7 @@ add : a -> a add b = b ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -163,7 +163,7 @@ add b = b add : a -> a ``` -```ucm +``` ucm scratch/main> update.old ⍟ I've added these definitions: @@ -183,7 +183,7 @@ scratch/main> debug.tab-complete delete.term add ``` ## Tab complete projects and branches -```ucm +``` ucm myproject/main> branch mybranch Done. I've created the mybranch branch based off of main. @@ -206,7 +206,7 @@ Commands which complete namespaces OR branches should list both mybranchsubnamespace.term = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -219,7 +219,7 @@ mybranchsubnamespace.term = 1 mybranchsubnamespace.term : ##Nat ``` -```ucm +``` ucm myproject/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/test-command.output.md b/unison-src/transcripts/test-command.output.md index 4182b223ce..f603bc3f1b 100644 --- a/unison-src/transcripts/test-command.output.md +++ b/unison-src/transcripts/test-command.output.md @@ -10,7 +10,7 @@ foo.test2 : [Result] foo.test2 = [Ok "test2"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ foo.test2 = [Ok "test2"] test1 : [Result] ``` -```ucm +``` ucm scratch/main> test ✅ @@ -49,7 +49,7 @@ scratch/main> test ``` Tests should be cached if unchanged. -```ucm +``` ucm scratch/main> test Cached test results (`help testcache` to learn more) @@ -69,7 +69,7 @@ lib.dep.testInLib : [Result] lib.dep.testInLib = [Ok "testInLib"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -82,7 +82,7 @@ lib.dep.testInLib = [Ok "testInLib"] lib.dep.testInLib : [Result] ``` -```ucm +``` ucm scratch/main> test Cached test results (`help testcache` to learn more) @@ -121,7 +121,7 @@ scratch/main> test.all ``` `test` WILL run tests within `lib` if specified explicitly. -```ucm +``` ucm scratch/main> test lib.dep Cached test results (`help testcache` to learn more) @@ -135,7 +135,7 @@ scratch/main> test lib.dep ``` `test` can be given a relative path, in which case it will only run tests found somewhere in that namespace. -```ucm +``` ucm scratch/main> test foo Cached test results (`help testcache` to learn more) diff --git a/unison-src/transcripts/text-literals.output.md b/unison-src/transcripts/text-literals.output.md index f9d4311f25..b023a3d062 100644 --- a/unison-src/transcripts/text-literals.output.md +++ b/unison-src/transcripts/text-literals.output.md @@ -31,7 +31,7 @@ lit2 = """" > Some lit2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -85,7 +85,7 @@ lit2 = """" "This is a raw text literal, indented.\nIt can start with 3 or more \",\nand is terminated by the same number of quotes.\nNothing is escaped. \\n\n\nThis doesn't terminate the literal - \"\"\"" ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/todo-bug-builtins.output.md b/unison-src/transcripts/todo-bug-builtins.output.md index 104d6bf86f..932353888f 100644 --- a/unison-src/transcripts/todo-bug-builtins.output.md +++ b/unison-src/transcripts/todo-bug-builtins.output.md @@ -6,7 +6,7 @@ > todo "implement me later" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -33,7 +33,7 @@ > bug "there's a bug in my code" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -64,7 +64,7 @@ complicatedMathStuff x = todo "Come back and to something with x here" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -87,7 +87,7 @@ test = match true with false -> bug "Wow, that's unexpected" ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index 434e7a43d4..c29c70e12b 100644 --- a/unison-src/transcripts/todo.output.md +++ b/unison-src/transcripts/todo.output.md @@ -2,7 +2,7 @@ When there's nothing to do, `todo` says this: -```ucm +``` ucm project/main> todo You have no pending todo items. Good work! ✅ @@ -24,7 +24,7 @@ bar : Nat bar = foo + foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -38,7 +38,7 @@ bar = foo + foo foo : Nat ``` -```ucm +``` ucm project/main> add ⍟ I've added these definitions: @@ -63,7 +63,7 @@ foo.bar = 15 baz = foo.bar + foo.bar ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -77,7 +77,7 @@ baz = foo.bar + foo.bar foo.bar : Nat ``` -```ucm +``` ucm project/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/top-level-exceptions.output.md b/unison-src/transcripts/top-level-exceptions.output.md index 4a889dedcd..ded6bdda0e 100644 --- a/unison-src/transcripts/top-level-exceptions.output.md +++ b/unison-src/transcripts/top-level-exceptions.output.md @@ -2,7 +2,7 @@ A simple transcript to test the use of exceptions that bubble to the top level. FYI, here are the `Exception` and `Failure` types: -```ucm +``` ucm scratch/main> view Exception Failure structural ability builtin.Exception where @@ -24,7 +24,7 @@ mytest : '{IO, Exception} [Test.Result] mytest _ = [Ok "Great"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -38,7 +38,7 @@ mytest _ = [Ok "Great"] mytest : '{IO, Exception} [Result] ``` -```ucm +``` ucm scratch/main> run main () @@ -73,7 +73,7 @@ error msg a = unique type RuntimeError = ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -88,7 +88,7 @@ unique type RuntimeError = main2 : '{Exception} r ``` -```ucm +``` ucm scratch/main> run main2 💔💥 diff --git a/unison-src/transcripts/transcript-parser-commands.output.md b/unison-src/transcripts/transcript-parser-commands.output.md index 842ea130cc..f6971c59e2 100644 --- a/unison-src/transcripts/transcript-parser-commands.output.md +++ b/unison-src/transcripts/transcript-parser-commands.output.md @@ -6,7 +6,7 @@ The transcript parser is meant to parse `ucm` and `unison` blocks. x = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ x = 1 x : Nat ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: @@ -35,7 +35,7 @@ z ``` -```ucm +``` ucm .> delete foo ⚠️ @@ -44,7 +44,7 @@ z foo ``` -```ucm +``` ucm .> delete lineToken.call ⚠️ diff --git a/unison-src/transcripts/type-deps.output.md b/unison-src/transcripts/type-deps.output.md index 24ab0e2885..fb04cc34c4 100644 --- a/unison-src/transcripts/type-deps.output.md +++ b/unison-src/transcripts/type-deps.output.md @@ -15,7 +15,7 @@ structural type Z = Z Y structural type Y = Y Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -36,7 +36,7 @@ structural type Y = Y Nat ``` Adding should fail for BOTH definitions, `Y` needs an update and `Z` is blocked by `Y`. -```ucm +``` ucm scratch/main> add x These definitions failed: diff --git a/unison-src/transcripts/type-modifier-are-optional.output.md b/unison-src/transcripts/type-modifier-are-optional.output.md index 34c562d153..6cd6812daa 100644 --- a/unison-src/transcripts/type-modifier-are-optional.output.md +++ b/unison-src/transcripts/type-modifier-are-optional.output.md @@ -12,7 +12,7 @@ unique ability MyAbilityU where const : a structural ability MyAbilityS where const : a ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/unique-type-churn.output.md b/unison-src/transcripts/unique-type-churn.output.md index f633292e86..ea00586436 100644 --- a/unison-src/transcripts/unique-type-churn.output.md +++ b/unison-src/transcripts/unique-type-churn.output.md @@ -8,7 +8,7 @@ unique type B = B C unique type C = C B ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,7 +23,7 @@ unique type C = C B type C ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -40,7 +40,7 @@ unique type B = B C unique type C = C B ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,7 +50,7 @@ unique type C = C B ``` If the name stays the same, the churn is even prevented if the type is updated and then reverted to the original form. -```ucm +``` ucm scratch/main> names A Type @@ -68,7 +68,7 @@ scratch/main> names A unique type A = A () ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -82,7 +82,7 @@ unique type A = A () type A ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be @@ -107,7 +107,7 @@ scratch/main> names A unique type A = A ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -123,7 +123,7 @@ unique type A = A ``` Note that `A` is back to its original hash. -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/unitnamespace.output.md b/unison-src/transcripts/unitnamespace.output.md index 9bc4274342..0a4833afee 100644 --- a/unison-src/transcripts/unitnamespace.output.md +++ b/unison-src/transcripts/unitnamespace.output.md @@ -2,7 +2,7 @@ `()`.foo = "bar" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,7 +15,7 @@ `()`.foo : ##Text ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: diff --git a/unison-src/transcripts/universal-cmp.output.md b/unison-src/transcripts/universal-cmp.output.md index af4bced3e2..5b8913fffa 100644 --- a/unison-src/transcripts/universal-cmp.output.md +++ b/unison-src/transcripts/universal-cmp.output.md @@ -10,7 +10,7 @@ threadEyeDeez _ = (t1 == t2, t1 < t2) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -24,7 +24,7 @@ threadEyeDeez _ = threadEyeDeez : ∀ _. _ ->{IO} (Boolean, Boolean) ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -44,7 +44,7 @@ scratch/main> run threadEyeDeez > termLink threadEyeDeez == termLink threadEyeDeez ``` -```ucm +``` ucm Loading changes detected in scratch.u. diff --git a/unison-src/transcripts/unsafe-coerce.output.md b/unison-src/transcripts/unsafe-coerce.output.md index 73ed1c6253..20380cb69f 100644 --- a/unison-src/transcripts/unsafe-coerce.output.md +++ b/unison-src/transcripts/unsafe-coerce.output.md @@ -11,7 +11,7 @@ main _ = if n == 5 then [Ok ""] else [Fail ""] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ main _ = main : '{IO, Exception} [Result] ``` -```ucm +``` ucm scratch/main> find unsafe.coerceAbilities 1. builtin.unsafe.coerceAbilities : (a ->{e1} b) -> a -> b diff --git a/unison-src/transcripts/update-ignores-lib-namespace.output.md b/unison-src/transcripts/update-ignores-lib-namespace.output.md index ffc4147d0d..dc03596d08 100644 --- a/unison-src/transcripts/update-ignores-lib-namespace.output.md +++ b/unison-src/transcripts/update-ignores-lib-namespace.output.md @@ -7,7 +7,7 @@ foo = 100 lib.foo = 100 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,7 +21,7 @@ lib.foo = 100 lib.foo : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -34,7 +34,7 @@ scratch/main> add foo = 200 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -49,7 +49,7 @@ foo = 200 (The old definition is also named lib.foo.) ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-on-conflict.output.md b/unison-src/transcripts/update-on-conflict.output.md index 8d05b394f2..373d3ac22d 100644 --- a/unison-src/transcripts/update-on-conflict.output.md +++ b/unison-src/transcripts/update-on-conflict.output.md @@ -7,7 +7,7 @@ x = 1 temp = 2 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,7 +21,7 @@ temp = 2 x : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -42,7 +42,7 @@ scratch/main> delete.term temp x = 3 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -56,7 +56,7 @@ x = 3 x : Nat ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-suffixifies-properly.output.md b/unison-src/transcripts/update-suffixifies-properly.output.md index a2a938fead..b76176388b 100644 --- a/unison-src/transcripts/update-suffixifies-properly.output.md +++ b/unison-src/transcripts/update-suffixifies-properly.output.md @@ -7,7 +7,7 @@ d.y.y.y.y = foo + 10 bar = a.x.x.x.x + c.y.y.y.y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -25,7 +25,7 @@ bar = a.x.x.x.x + c.y.y.y.y foo : Nat ``` -```ucm +``` ucm myproject/main> add ⍟ I've added these definitions: @@ -42,7 +42,7 @@ myproject/main> add foo = +30 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -56,7 +56,7 @@ foo = +30 foo : Int ``` -```ucm +``` ucm myproject/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-term-aliases-in-different-ways.output.md b/unison-src/transcripts/update-term-aliases-in-different-ways.output.md index 3d16a9254a..5b0e7bf65d 100644 --- a/unison-src/transcripts/update-term-aliases-in-different-ways.output.md +++ b/unison-src/transcripts/update-term-aliases-in-different-ways.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -12,7 +12,7 @@ bar : Nat bar = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ bar = 5 foo : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -43,7 +43,7 @@ bar : Nat bar = 7 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -60,7 +60,7 @@ bar = 7 (The old definition is also named bar.) ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-term-to-different-type.output.md b/unison-src/transcripts/update-term-to-different-type.output.md index a525811da4..c1f65aacac 100644 --- a/unison-src/transcripts/update-term-to-different-type.output.md +++ b/unison-src/transcripts/update-term-to-different-type.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -9,7 +9,7 @@ foo : Nat foo = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,7 +22,7 @@ foo = 5 foo : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -35,7 +35,7 @@ foo : Int foo = +5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -49,7 +49,7 @@ foo = +5 foo : Int ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-term-with-alias.output.md b/unison-src/transcripts/update-term-with-alias.output.md index 03124e7945..b0fbeab2ae 100644 --- a/unison-src/transcripts/update-term-with-alias.output.md +++ b/unison-src/transcripts/update-term-with-alias.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -12,7 +12,7 @@ bar : Nat bar = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ bar = 5 foo : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -40,7 +40,7 @@ foo : Nat foo = 6 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -55,7 +55,7 @@ foo = 6 (The old definition is also named bar.) ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md index aef8fcb1e9..02eeabcfc2 100644 --- a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md +++ b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -12,7 +12,7 @@ bar : Nat bar = foo + 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ bar = foo + 10 foo : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -40,7 +40,7 @@ foo : Int foo = +5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -54,7 +54,7 @@ foo = +5 foo : Int ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-term-with-dependent.output.md b/unison-src/transcripts/update-term-with-dependent.output.md index 79aee87f34..42ae8158f5 100644 --- a/unison-src/transcripts/update-term-with-dependent.output.md +++ b/unison-src/transcripts/update-term-with-dependent.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -12,7 +12,7 @@ bar : Nat bar = foo + 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -26,7 +26,7 @@ bar = foo + 10 foo : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -40,7 +40,7 @@ foo : Nat foo = 6 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -54,7 +54,7 @@ foo = 6 foo : Nat ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-term.output.md b/unison-src/transcripts/update-term.output.md index 982c3b23ab..54abb8e06a 100644 --- a/unison-src/transcripts/update-term.output.md +++ b/unison-src/transcripts/update-term.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -9,7 +9,7 @@ foo : Nat foo = 5 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -22,7 +22,7 @@ foo = 5 foo : Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -35,7 +35,7 @@ foo : Nat foo = 6 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -49,7 +49,7 @@ foo = 6 foo : Nat ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-test-to-non-test.output.md b/unison-src/transcripts/update-test-to-non-test.output.md index fc9363d5a6..5275b97eb3 100644 --- a/unison-src/transcripts/update-test-to-non-test.output.md +++ b/unison-src/transcripts/update-test-to-non-test.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.merge Done. @@ -8,7 +8,7 @@ scratch/main> builtins.merge test> foo = [] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -29,7 +29,7 @@ test> foo = [] ``` After adding the test `foo`, we expect `view` to render it like a test. (Bug: It doesn't.) -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -46,7 +46,7 @@ scratch/main> view foo foo = 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -62,7 +62,7 @@ foo = 1 ``` After updating `foo` to not be a test, we expect `view` to not render it like a test. -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-test-watch-roundtrip.output.md b/unison-src/transcripts/update-test-watch-roundtrip.output.md index 5ba534cd3b..31aa18ea23 100644 --- a/unison-src/transcripts/update-test-watch-roundtrip.output.md +++ b/unison-src/transcripts/update-test-watch-roundtrip.output.md @@ -8,7 +8,7 @@ test> mynamespace.foo.test = if (foo n) == 2 then [ Ok "passed" ] else [ Fail "wat" ] ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -23,7 +23,7 @@ if we change the type of the dependency, the test should show in the scratch fil foo n = "hello, world!" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -37,7 +37,7 @@ foo n = "hello, world!" foo : n -> Text ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-add-constructor.output.md b/unison-src/transcripts/update-type-add-constructor.output.md index 5f58f745cc..c87b1b7cd8 100644 --- a/unison-src/transcripts/update-type-add-constructor.output.md +++ b/unison-src/transcripts/update-type-add-constructor.output.md @@ -3,7 +3,7 @@ unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -16,7 +16,7 @@ unique type Foo type Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -30,7 +30,7 @@ unique type Foo | Baz Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,7 +44,7 @@ unique type Foo type Foo ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-add-field.output.md b/unison-src/transcripts/update-type-add-field.output.md index b96464e02f..6741c27a09 100644 --- a/unison-src/transcripts/update-type-add-field.output.md +++ b/unison-src/transcripts/update-type-add-field.output.md @@ -2,7 +2,7 @@ unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,7 +15,7 @@ unique type Foo = Bar Nat type Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -27,7 +27,7 @@ scratch/main> add unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -41,7 +41,7 @@ unique type Foo = Bar Nat Nat type Foo ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-add-new-record.output.md b/unison-src/transcripts/update-type-add-new-record.output.md index 4e10132bc4..a96ce90c24 100644 --- a/unison-src/transcripts/update-type-add-new-record.output.md +++ b/unison-src/transcripts/update-type-add-new-record.output.md @@ -2,7 +2,7 @@ unique type Foo = { bar : Nat } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,7 +18,7 @@ unique type Foo = { bar : Nat } Foo.bar.set : Nat -> Foo -> Foo ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-add-record-field.output.md b/unison-src/transcripts/update-type-add-record-field.output.md index 1997eb2acd..23365f09b7 100644 --- a/unison-src/transcripts/update-type-add-record-field.output.md +++ b/unison-src/transcripts/update-type-add-record-field.output.md @@ -2,7 +2,7 @@ unique type Foo = { bar : Nat } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,7 +18,7 @@ unique type Foo = { bar : Nat } Foo.bar.set : Nat -> Foo -> Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -33,7 +33,7 @@ scratch/main> add unique type Foo = { bar : Nat, baz : Int } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -56,7 +56,7 @@ unique type Foo = { bar : Nat, baz : Int } Foo.bar.set : Nat -> Foo -> Foo ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-constructor-alias.output.md b/unison-src/transcripts/update-type-constructor-alias.output.md index 76291ee05f..e8d95fafe0 100644 --- a/unison-src/transcripts/update-type-constructor-alias.output.md +++ b/unison-src/transcripts/update-type-constructor-alias.output.md @@ -2,7 +2,7 @@ unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,7 +15,7 @@ unique type Foo = Bar Nat type Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -31,7 +31,7 @@ scratch/main> alias.term Foo.Bar Foo.BarAlias unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -47,7 +47,7 @@ unique type Foo = Bar Nat Nat ``` Bug: we leave `Foo.BarAlias` in the namespace with a nameless decl. -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md index 3eca077a5d..977866e321 100644 --- a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md +++ b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md @@ -9,7 +9,7 @@ foo = cases Baz n m -> n + m ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -23,7 +23,7 @@ foo = cases foo : Foo -> Nat ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -37,7 +37,7 @@ unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -51,7 +51,7 @@ unique type Foo type Foo ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-delete-constructor.output.md b/unison-src/transcripts/update-type-delete-constructor.output.md index 05d18c2598..31afdb7d41 100644 --- a/unison-src/transcripts/update-type-delete-constructor.output.md +++ b/unison-src/transcripts/update-type-delete-constructor.output.md @@ -4,7 +4,7 @@ unique type Foo | Baz Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,7 +17,7 @@ unique type Foo type Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -30,7 +30,7 @@ unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,7 +44,7 @@ unique type Foo type Foo ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-delete-record-field.output.md b/unison-src/transcripts/update-type-delete-record-field.output.md index dcdfa6d51d..876edca300 100644 --- a/unison-src/transcripts/update-type-delete-record-field.output.md +++ b/unison-src/transcripts/update-type-delete-record-field.output.md @@ -2,7 +2,7 @@ unique type Foo = { bar : Nat, baz : Int } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,7 +21,7 @@ unique type Foo = { bar : Nat, baz : Int } Foo.baz.set : Int -> Foo -> Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -39,7 +39,7 @@ scratch/main> add unique type Foo = { bar : Nat } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -58,7 +58,7 @@ unique type Foo = { bar : Nat } ``` We want the field accessors to go away; but for now they are here, causing the update to fail. -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-missing-constructor.output.md b/unison-src/transcripts/update-type-missing-constructor.output.md index 2344e4319a..c9c8bc2eca 100644 --- a/unison-src/transcripts/update-type-missing-constructor.output.md +++ b/unison-src/transcripts/update-type-missing-constructor.output.md @@ -2,7 +2,7 @@ unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,7 +15,7 @@ unique type Foo = Bar Nat type Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -33,7 +33,7 @@ Now we've set up a situation where the original constructor missing. unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -47,7 +47,7 @@ unique type Foo = Bar Nat Nat type Foo ``` -```ucm +``` ucm scratch/main> view Foo type Foo = #b509v3eg4k#0 Nat diff --git a/unison-src/transcripts/update-type-nested-decl-aliases.output.md b/unison-src/transcripts/update-type-nested-decl-aliases.output.md index e67a1c4b14..706efd6414 100644 --- a/unison-src/transcripts/update-type-nested-decl-aliases.output.md +++ b/unison-src/transcripts/update-type-nested-decl-aliases.output.md @@ -5,7 +5,7 @@ structural type A.B = OneAlias Foo structural type A = B.TheOtherAlias Foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -20,7 +20,7 @@ structural type A = B.TheOtherAlias Foo type Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -34,7 +34,7 @@ scratch/main> add unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -52,7 +52,7 @@ Bug: we want this update to be rejected earlier, because it violates the "decl c only one name for each constructor. We instead get too far in the update process, and are delivered a bogus scratch.u file to stare at. -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-no-op-record.output.md b/unison-src/transcripts/update-type-no-op-record.output.md index 159f9aa865..763a1aba59 100644 --- a/unison-src/transcripts/update-type-no-op-record.output.md +++ b/unison-src/transcripts/update-type-no-op-record.output.md @@ -2,7 +2,7 @@ unique type Foo = { bar : Nat } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,7 +18,7 @@ unique type Foo = { bar : Nat } Foo.bar.set : Nat -> Foo -> Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -31,7 +31,7 @@ scratch/main> add ``` Bug: this no-op update should (of course) succeed. -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-stray-constructor-alias.output.md b/unison-src/transcripts/update-type-stray-constructor-alias.output.md index 54a1e59653..c6f65667bf 100644 --- a/unison-src/transcripts/update-type-stray-constructor-alias.output.md +++ b/unison-src/transcripts/update-type-stray-constructor-alias.output.md @@ -2,7 +2,7 @@ unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,7 +15,7 @@ unique type Foo = Bar Nat type Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -31,7 +31,7 @@ scratch/main> alias.term Foo.Bar Stray.BarAlias unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -47,7 +47,7 @@ unique type Foo = Bar Nat Nat ``` Bug: we leave `Stray.BarAlias` in the namespace with a nameless decl. -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-stray-constructor.output.md b/unison-src/transcripts/update-type-stray-constructor.output.md index 999c57ae43..4554fd53d3 100644 --- a/unison-src/transcripts/update-type-stray-constructor.output.md +++ b/unison-src/transcripts/update-type-stray-constructor.output.md @@ -2,7 +2,7 @@ unique type Foo = Bar Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,7 +15,7 @@ unique type Foo = Bar Nat type Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -33,7 +33,7 @@ Now we've set up a situation where the constructor is not where it's supposed to unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -49,7 +49,7 @@ unique type Foo = Bar Nat Nat ``` Note that the constructor name shown here (implied to be called `Foo.Stray.Bar`) doesn't really exist, it's just showing up due to a pretty-printer bug. -```ucm +``` ucm scratch/main> view Foo type Foo = Stray.Bar Nat diff --git a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md index cff0653a02..b6daa83021 100644 --- a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md +++ b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md @@ -5,7 +5,7 @@ makeFoo : Nat -> Foo makeFoo n = Bar (n+10) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ makeFoo n = Bar (n+10) makeFoo : Nat -> Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -35,7 +35,7 @@ Foo.Bar : Nat -> Foo Foo.Bar n = internal.Bar n ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -50,7 +50,7 @@ Foo.Bar n = internal.Bar n Foo.Bar : Nat -> Foo ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-turn-non-record-into-record.output.md b/unison-src/transcripts/update-type-turn-non-record-into-record.output.md index a9a3bf4674..edeb85642e 100644 --- a/unison-src/transcripts/update-type-turn-non-record-into-record.output.md +++ b/unison-src/transcripts/update-type-turn-non-record-into-record.output.md @@ -2,7 +2,7 @@ unique type Foo = Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -15,7 +15,7 @@ unique type Foo = Nat type Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -27,7 +27,7 @@ scratch/main> add unique type Foo = { bar : Nat } ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -47,7 +47,7 @@ unique type Foo = { bar : Nat } type Foo ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-with-dependent-term.output.md b/unison-src/transcripts/update-type-with-dependent-term.output.md index 09d0a63f5d..b5db3f2646 100644 --- a/unison-src/transcripts/update-type-with-dependent-term.output.md +++ b/unison-src/transcripts/update-type-with-dependent-term.output.md @@ -5,7 +5,7 @@ incrFoo : Foo -> Foo incrFoo = cases Bar n -> Bar (n+1) ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ incrFoo = cases Bar n -> Bar (n+1) incrFoo : Foo -> Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -32,7 +32,7 @@ scratch/main> add unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -46,7 +46,7 @@ unique type Foo = Bar Nat Nat type Foo ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md index ea8d652422..8ffbf3b88f 100644 --- a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md +++ b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md @@ -3,7 +3,7 @@ unique type Foo = Bar Nat unique type Baz = Qux Foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,7 +17,7 @@ unique type Baz = Qux Foo type Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -30,7 +30,7 @@ scratch/main> add unique type Foo a = Bar Nat a ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,7 +44,7 @@ unique type Foo a = Bar Nat a type Foo a ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-type-with-dependent-type.output.md b/unison-src/transcripts/update-type-with-dependent-type.output.md index 474a8ceef8..6effd150c3 100644 --- a/unison-src/transcripts/update-type-with-dependent-type.output.md +++ b/unison-src/transcripts/update-type-with-dependent-type.output.md @@ -3,7 +3,7 @@ unique type Foo = Bar Nat unique type Baz = Qux Foo ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -17,7 +17,7 @@ unique type Baz = Qux Foo type Foo ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -30,7 +30,7 @@ scratch/main> add unique type Foo = Bar Nat Nat ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -44,7 +44,7 @@ unique type Foo = Bar Nat Nat type Foo ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/update-watch.output.md b/unison-src/transcripts/update-watch.output.md index 36bc89ae21..feb53dc173 100644 --- a/unison-src/transcripts/update-watch.output.md +++ b/unison-src/transcripts/update-watch.output.md @@ -2,7 +2,7 @@ > 1 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -18,7 +18,7 @@ 1 ``` -```ucm +``` ucm scratch/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/upgrade-happy-path.output.md b/unison-src/transcripts/upgrade-happy-path.output.md index 33c8b6c8d2..127b0c4897 100644 --- a/unison-src/transcripts/upgrade-happy-path.output.md +++ b/unison-src/transcripts/upgrade-happy-path.output.md @@ -4,7 +4,7 @@ lib.new.foo = 18 thingy = lib.old.foo + 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ thingy = lib.old.foo + 10 thingy : Nat ``` -```ucm +``` ucm proj/main> add ⍟ I've added these definitions: @@ -31,7 +31,7 @@ proj/main> add ``` Test tab completion and fzf options of upgrade command. -```ucm +``` ucm proj/main> debug.tab-complete upgrade ol old @@ -51,7 +51,7 @@ proj/main> debug.fuzzy-options upgrade old _ * old ``` -```ucm +``` ucm proj/main> upgrade old new I upgraded old to new, and removed old. diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md index d25d2f8c4e..54c7b546c1 100644 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ b/unison-src/transcripts/upgrade-sad-path.output.md @@ -4,7 +4,7 @@ lib.new.foo = +18 thingy = lib.old.foo + 10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -19,7 +19,7 @@ thingy = lib.old.foo + 10 thingy : Nat ``` -```ucm +``` ucm proj/main> add ⍟ I've added these definitions: @@ -29,7 +29,7 @@ proj/main> add thingy : Nat ``` -```ucm +``` ucm proj/main> upgrade old new I couldn't automatically upgrade old to new. However, I've @@ -62,7 +62,7 @@ Resolve the error and commit the upgrade. thingy = foo + +10 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -76,7 +76,7 @@ thingy = foo + +10 thingy : Int ``` -```ucm +``` ucm proj/upgrade-old-to-new> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/upgrade-suffixifies-properly.output.md b/unison-src/transcripts/upgrade-suffixifies-properly.output.md index cacefecf8a..0440acc2ac 100644 --- a/unison-src/transcripts/upgrade-suffixifies-properly.output.md +++ b/unison-src/transcripts/upgrade-suffixifies-properly.output.md @@ -8,7 +8,7 @@ d.y.y.y.y = lib.old.foo + 10 bar = a.x.x.x.x + c.y.y.y.y ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -27,7 +27,7 @@ bar = a.x.x.x.x + c.y.y.y.y lib.old.foo : Nat ``` -```ucm +``` ucm myproject/main> add ⍟ I've added these definitions: @@ -41,7 +41,7 @@ myproject/main> add lib.old.foo : Nat ``` -```ucm +``` ucm myproject/main> upgrade old new I couldn't automatically upgrade old to new. However, I've diff --git a/unison-src/transcripts/upgrade-with-old-alias.output.md b/unison-src/transcripts/upgrade-with-old-alias.output.md index 46b0736166..9afef6c22b 100644 --- a/unison-src/transcripts/upgrade-with-old-alias.output.md +++ b/unison-src/transcripts/upgrade-with-old-alias.output.md @@ -5,7 +5,7 @@ bar = 141 mything = lib.old.foo + 100 ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -21,7 +21,7 @@ mything = lib.old.foo + 100 mything : Nat ``` -```ucm +``` ucm myproject/main> update Okay, I'm searching the branch for code that needs to be diff --git a/unison-src/transcripts/view.output.md b/unison-src/transcripts/view.output.md index c300d96d3b..b5cc5149d1 100644 --- a/unison-src/transcripts/view.output.md +++ b/unison-src/transcripts/view.output.md @@ -5,7 +5,7 @@ a.thing = "a" b.thing = "b" ``` -```ucm +``` ucm -- Should suffix-search and find values in sub-namespaces .> view thing diff --git a/unison-src/transcripts/watch-expressions.output.md b/unison-src/transcripts/watch-expressions.output.md index 0641ab1a6a..096f08e7a3 100644 --- a/unison-src/transcripts/watch-expressions.output.md +++ b/unison-src/transcripts/watch-expressions.output.md @@ -1,4 +1,4 @@ -```ucm +``` ucm scratch/main> builtins.mergeio Done. @@ -8,7 +8,7 @@ scratch/main> builtins.mergeio test> pass = [Ok "Passed"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -28,7 +28,7 @@ test> pass = [Ok "Passed"] ✅ Passed Passed ``` -```ucm +``` ucm scratch/main> add ⍟ I've added these definitions: @@ -40,7 +40,7 @@ scratch/main> add test> pass = [Ok "Passed"] ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -55,7 +55,7 @@ test> pass = [Ok "Passed"] ✅ Passed Passed (cached) ``` -```ucm +``` ucm scratch/main> add ⊡ Ignored previously added definitions: pass @@ -76,7 +76,7 @@ scratch/main> test > ImmutableByteArray.fromBytes 0xs123456 ``` -```ucm +``` ucm Loading changes detected in scratch.u. From b657d0dd5091b042c0c79ab9ff7c4172204e9c05 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 10 Jul 2024 10:27:02 -0600 Subject: [PATCH 435/631] Fix a few transcripts with incorrect Markdown MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit These weren’t errors in any way, but the `cmark`-produced outputs made it clear that some of our transcripts weren’t formatted the way we intended. --- unison-src/transcripts/fix2474.md | 3 +- unison-src/transcripts/fix2474.output.md | 2 +- unison-src/transcripts/fix2663.md | 3 +- unison-src/transcripts/fix2663.output.md | 2 +- unison-src/transcripts/io.md | 44 ++++++++++++---------- unison-src/transcripts/io.output.md | 48 ++++++++++++++---------- 6 files changed, 56 insertions(+), 46 deletions(-) diff --git a/unison-src/transcripts/fix2474.md b/unison-src/transcripts/fix2474.md index 3d48be95b5..e84cd4a9e7 100644 --- a/unison-src/transcripts/fix2474.md +++ b/unison-src/transcripts/fix2474.md @@ -1,9 +1,8 @@ - Tests an issue with a lack of generality of handlers. In general, a set of cases: - { e ... -> k } + { e ... -> k } should be typed in the following way: diff --git a/unison-src/transcripts/fix2474.output.md b/unison-src/transcripts/fix2474.output.md index 0daf2d3ba0..d5863ee876 100644 --- a/unison-src/transcripts/fix2474.output.md +++ b/unison-src/transcripts/fix2474.output.md @@ -2,7 +2,7 @@ Tests an issue with a lack of generality of handlers. In general, a set of cases: -{ e ... -\> k } + { e ... -> k } should be typed in the following way: diff --git a/unison-src/transcripts/fix2663.md b/unison-src/transcripts/fix2663.md index e3b88b0622..ee6a5b749a 100644 --- a/unison-src/transcripts/fix2663.md +++ b/unison-src/transcripts/fix2663.md @@ -1,9 +1,8 @@ - Tests a variable capture problem. After pattern compilation, the match would end up: - T p1 p3 p3 + T p1 p3 p3 and z would end up referring to the first p3 rather than the second. diff --git a/unison-src/transcripts/fix2663.output.md b/unison-src/transcripts/fix2663.output.md index 6153dc0421..d1b0575e12 100644 --- a/unison-src/transcripts/fix2663.output.md +++ b/unison-src/transcripts/fix2663.output.md @@ -2,7 +2,7 @@ Tests a variable capture problem. After pattern compilation, the match would end up: -T p1 p3 p3 + T p1 p3 p3 and z would end up referring to the first p3 rather than the second. diff --git a/unison-src/transcripts/io.md b/unison-src/transcripts/io.md index 0051c7aa69..7db903ebb4 100644 --- a/unison-src/transcripts/io.md +++ b/unison-src/transcripts/io.md @@ -24,11 +24,12 @@ scratch/main> add ### Creating/Deleting/Renaming Directories -Tests: createDirectory, - isDirectory, - fileExists, - renameDirectory, - deleteDirectory +Tests: +- createDirectory, +- isDirectory, +- fileExists, +- renameDirectory, +- deleteDirectory ```unison testCreateRename : '{io2.IO} [Result] @@ -63,9 +64,10 @@ scratch/main> io.test testCreateRename ### Opening / Closing files -Tests: openFile - closeFile - isFileOpen +Tests: +- openFile +- closeFile +- isFileOpen ```unison testOpenClose : '{io2.IO} [Result] @@ -113,10 +115,11 @@ scratch/main> io.test testOpenClose ### Reading files with getSomeBytes -Tests: getSomeBytes - putBytes - isFileOpen - seekHandle +Tests: +- getSomeBytes +- putBytes +- isFileOpen +- seekHandle ```unison testGetSomeBytes : '{io2.IO} [Result] @@ -172,14 +175,15 @@ scratch/main> io.test testGetSomeBytes ### Seeking in open files -Tests: openFile - putBytes - closeFile - isSeekable - isFileEOF - seekHandle - getBytes - getLine +Tests: +- openFile +- putBytes +- closeFile +- isSeekable +- isFileEOF +- seekHandle +- getBytes +- getLine ```unison testSeek : '{io2.IO} [Result] diff --git a/unison-src/transcripts/io.output.md b/unison-src/transcripts/io.output.md index ef385d897d..4ac673c76e 100644 --- a/unison-src/transcripts/io.output.md +++ b/unison-src/transcripts/io.output.md @@ -13,11 +13,13 @@ create a scratch directory which will automatically get cleaned up. ### Creating/Deleting/Renaming Directories -Tests: createDirectory, -isDirectory, -fileExists, -renameDirectory, -deleteDirectory +Tests: + + - createDirectory, + - isDirectory, + - fileExists, + - renameDirectory, + - deleteDirectory ``` unison testCreateRename : '{io2.IO} [Result] @@ -84,9 +86,11 @@ scratch/main> io.test testCreateRename ``` ### Opening / Closing files -Tests: openFile -closeFile -isFileOpen +Tests: + + - openFile + - closeFile + - isFileOpen ``` unison testOpenClose : '{io2.IO} [Result] @@ -165,10 +169,12 @@ scratch/main> io.test testOpenClose ``` ### Reading files with getSomeBytes -Tests: getSomeBytes -putBytes -isFileOpen -seekHandle +Tests: + + - getSomeBytes + - putBytes + - isFileOpen + - seekHandle ``` unison testGetSomeBytes : '{io2.IO} [Result] @@ -257,14 +263,16 @@ scratch/main> io.test testGetSomeBytes ``` ### Seeking in open files -Tests: openFile -putBytes -closeFile -isSeekable -isFileEOF -seekHandle -getBytes -getLine +Tests: + + - openFile + - putBytes + - closeFile + - isSeekable + - isFileEOF + - seekHandle + - getBytes + - getLine ``` unison testSeek : '{io2.IO} [Result] From 8416708a29287cc03542e2aa4b3ec42d7417cf49 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 10 Jul 2024 10:57:36 -0600 Subject: [PATCH 436/631] Add transcripts for fixed issues This shows that this change fixes #1421, #2826, #5141, and #5168. --- unison-src/transcripts/fix1421.md | 8 +++ unison-src/transcripts/fix1421.output.md | 29 +++++++++++ unison-src/transcripts/fix2826.md | 23 +++++++++ unison-src/transcripts/fix2826.output.md | 66 ++++++++++++++++++++++++ unison-src/transcripts/fix5141.md | 5 ++ unison-src/transcripts/fix5141.output.md | 6 +++ unison-src/transcripts/fix5168.md | 4 ++ unison-src/transcripts/fix5168.output.md | 19 +++++++ 8 files changed, 160 insertions(+) create mode 100644 unison-src/transcripts/fix1421.md create mode 100644 unison-src/transcripts/fix1421.output.md create mode 100644 unison-src/transcripts/fix2826.md create mode 100644 unison-src/transcripts/fix2826.output.md create mode 100644 unison-src/transcripts/fix5141.md create mode 100644 unison-src/transcripts/fix5141.output.md create mode 100644 unison-src/transcripts/fix5168.md create mode 100644 unison-src/transcripts/fix5168.output.md diff --git a/unison-src/transcripts/fix1421.md b/unison-src/transcripts/fix1421.md new file mode 100644 index 0000000000..8117928aa4 --- /dev/null +++ b/unison-src/transcripts/fix1421.md @@ -0,0 +1,8 @@ + ```ucm + scratch/main> alias.type ##Nat Nat + scratch/main> alias.term ##Nat.+ Nat.+ + ``` + ```unison + unique type A = A Nat + unique type B = B Nat Nat + ``` diff --git a/unison-src/transcripts/fix1421.output.md b/unison-src/transcripts/fix1421.output.md new file mode 100644 index 0000000000..0f52e9a36e --- /dev/null +++ b/unison-src/transcripts/fix1421.output.md @@ -0,0 +1,29 @@ +``` ucm +scratch/main> alias.type ##Nat Nat + + Done. + +scratch/main> alias.term ##Nat.+ Nat.+ + + Done. + +``` +``` unison +unique type A = A Nat +unique type B = B Nat Nat +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type A + type B + +``` diff --git a/unison-src/transcripts/fix2826.md b/unison-src/transcripts/fix2826.md new file mode 100644 index 0000000000..d2ad94cd51 --- /dev/null +++ b/unison-src/transcripts/fix2826.md @@ -0,0 +1,23 @@ +```ucm +scratch/main> builtins.mergeio +``` + +Supports fences that are longer than three backticks. + +````unison + +doc = {{ + @typecheck ``` + x = 3 + ``` +}} + +```` + +And round-trips properly. + +```ucm +scratch/main> add +scratch/main> edit doc +scratch/main> load scratch.u +``` diff --git a/unison-src/transcripts/fix2826.output.md b/unison-src/transcripts/fix2826.output.md new file mode 100644 index 0000000000..cf691c1b62 --- /dev/null +++ b/unison-src/transcripts/fix2826.output.md @@ -0,0 +1,66 @@ +``` ucm +scratch/main> builtins.mergeio + + Done. + +``` +Supports fences that are longer than three backticks. + +```` unison +doc = {{ + @typecheck ``` + x = 3 + ``` +}} + +```` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + doc : Doc2 + +``` +And round-trips properly. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + doc : Doc2 + +scratch/main> edit doc + + ☝️ + + I added 1 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. + +scratch/main> load scratch.u + + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. + +``` +```` unison:added-by-ucm scratch.u +doc : Doc2 +doc = + {{ + @typecheck ``` + x = 3 + ``` + }} +```` + diff --git a/unison-src/transcripts/fix5141.md b/unison-src/transcripts/fix5141.md new file mode 100644 index 0000000000..0536b6e0a0 --- /dev/null +++ b/unison-src/transcripts/fix5141.md @@ -0,0 +1,5 @@ + diff --git a/unison-src/transcripts/fix5141.output.md b/unison-src/transcripts/fix5141.output.md new file mode 100644 index 0000000000..ab031fee02 --- /dev/null +++ b/unison-src/transcripts/fix5141.output.md @@ -0,0 +1,6 @@ + + diff --git a/unison-src/transcripts/fix5168.md b/unison-src/transcripts/fix5168.md new file mode 100644 index 0000000000..2eda5f0215 --- /dev/null +++ b/unison-src/transcripts/fix5168.md @@ -0,0 +1,4 @@ +The `edit` seems to suppress a following ```` ```unison ```` block: +```unison +b = 2 +``` diff --git a/unison-src/transcripts/fix5168.output.md b/unison-src/transcripts/fix5168.output.md new file mode 100644 index 0000000000..5a7c35e339 --- /dev/null +++ b/unison-src/transcripts/fix5168.output.md @@ -0,0 +1,19 @@ +The `edit` seems to suppress a following ` ```unison ` block: + +``` unison +b = 2 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + b : ##Nat + +``` From 179b8d1bb7bbbabe9581e4e7187cb9f9bef42aeb Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 10 Jul 2024 13:15:33 -0600 Subject: [PATCH 437/631] Terminate API code blocks correctly They were missing trailing newlines, so as you can see in the diff, some transcripts had invalid output. --- unison-cli/src/Unison/Codebase/TranscriptParser.hs | 2 +- unison-src/transcripts/api-doc-rendering.output.md | 3 ++- unison-src/transcripts/api-find.output.md | 3 ++- unison-src/transcripts/api-getDefinition.output.md | 11 ++++++++--- .../transcripts/api-list-projects-branches.output.md | 3 ++- .../transcripts/api-namespace-details.output.md | 3 ++- unison-src/transcripts/api-namespace-list.output.md | 3 ++- unison-src/transcripts/api-summaries.output.md | 7 +++++-- unison-src/transcripts/definition-diff-api.output.md | 7 +++++-- 9 files changed, 29 insertions(+), 13 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/TranscriptParser.hs index bf71f18a87..988a1e55ca 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/unison-cli/src/Unison/Codebase/TranscriptParser.hs @@ -432,7 +432,7 @@ run verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion API apiRequests -> do liftIO (output "``` api\n") liftIO (for_ apiRequests apiRequest) - liftIO (output "```") + liftIO (output "```\n\n") awaitInput Ucm hide errOk cmds -> do liftIO (writeIORef hidden hide) diff --git a/unison-src/transcripts/api-doc-rendering.output.md b/unison-src/transcripts/api-doc-rendering.output.md index 271fac7840..1ecf4f86a3 100644 --- a/unison-src/transcripts/api-doc-rendering.output.md +++ b/unison-src/transcripts/api-doc-rendering.output.md @@ -940,4 +940,5 @@ GET /api/projects/scratch/branches/main/getDefinition?names=term }, "typeDefinitions": {} } -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/api-find.output.md b/unison-src/transcripts/api-find.output.md index 24c34c837e..2d062550b9 100644 --- a/unison-src/transcripts/api-find.output.md +++ b/unison-src/transcripts/api-find.output.md @@ -252,4 +252,5 @@ GET /api/projects/scratch/branches/main/find?query=joey.http } ] ] -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/api-getDefinition.output.md b/unison-src/transcripts/api-getDefinition.output.md index 6daa80c011..edf49323c5 100644 --- a/unison-src/transcripts/api-getDefinition.output.md +++ b/unison-src/transcripts/api-getDefinition.output.md @@ -205,7 +205,9 @@ GET /api/projects/scratch/branches/main/getDefinition?names=%23qkhkl0n238&relati }, "typeDefinitions": {} } -`````` unison +``` + +``` unison doctest.thing.doc = {{ The correct docs for the thing }} doctest.thing = "A thing" doctest.thingalias.doc = {{ Docs for the alias, should not be displayed }} @@ -332,7 +334,9 @@ GET /api/projects/scratch/branches/main/getDefinition?names=thing&relativeTo=doc }, "typeDefinitions": {} } -```If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. +``` + +If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. ``` api GET /api/projects/scratch/branches/main/getDefinition?names=thing.doc&relativeTo=doctest @@ -507,4 +511,5 @@ GET /api/projects/scratch/branches/main/getDefinition?names=thing.doc&relativeTo }, "typeDefinitions": {} } -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/api-list-projects-branches.output.md b/unison-src/transcripts/api-list-projects-branches.output.md index 5768b6454d..0971ab5fc5 100644 --- a/unison-src/transcripts/api-list-projects-branches.output.md +++ b/unison-src/transcripts/api-list-projects-branches.output.md @@ -53,4 +53,5 @@ GET /api/projects/project-one/branches?prefix=branch-t "branchName": "branch-two" } ] -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/api-namespace-details.output.md b/unison-src/transcripts/api-namespace-details.output.md index 124c28e5d5..3ba09740f7 100644 --- a/unison-src/transcripts/api-namespace-details.output.md +++ b/unison-src/transcripts/api-namespace-details.output.md @@ -78,4 +78,5 @@ GET /api/projects/scratch/branches/main/namespaces/nested.names "tag": "Paragraph" } } -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/api-namespace-list.output.md b/unison-src/transcripts/api-namespace-list.output.md index 1378a7d36f..56a6e09498 100644 --- a/unison-src/transcripts/api-namespace-list.output.md +++ b/unison-src/transcripts/api-namespace-list.output.md @@ -131,4 +131,5 @@ GET /api/projects/scratch/branches/main/list?namespace=names&relativeTo=nested "namespaceListingFQN": "nested.names", "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" } -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/api-summaries.output.md b/unison-src/transcripts/api-summaries.output.md index 115dba15a8..7ea0a5d197 100644 --- a/unison-src/transcripts/api-summaries.output.md +++ b/unison-src/transcripts/api-summaries.output.md @@ -667,7 +667,9 @@ GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@@IO.putBytes. }, "tag": "Plain" } -```## Type Summary APIs +``` + +## Type Summary APIs ``` api -- data @@ -823,4 +825,5 @@ GET /api/projects/scratch/branches/main/definitions/types/by-hash/@@Nat/summary? }, "tag": "Data" } -``` \ No newline at end of file +``` + diff --git a/unison-src/transcripts/definition-diff-api.output.md b/unison-src/transcripts/definition-diff-api.output.md index 8d55cc7850..1670f2b05d 100644 --- a/unison-src/transcripts/definition-diff-api.output.md +++ b/unison-src/transcripts/definition-diff-api.output.md @@ -558,7 +558,9 @@ GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=te }, "project": "diffs" } -```Diff types +``` + +Diff types ``` api GET /api/projects/diffs/diff/types?oldBranchRef=main&newBranchRef=new&oldType=Type&newType=Type @@ -804,4 +806,5 @@ GET /api/projects/diffs/diff/types?oldBranchRef=main&newBranchRef=new&oldType=Ty }, "project": "diffs" } -``` \ No newline at end of file +``` + From bf2045995479bc51f78fc511f5f96fea7caaa09a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 10 Jul 2024 11:05:13 -0700 Subject: [PATCH 438/631] Typo --- unison-src/transcripts-round-trip/main.md | 2 +- unison-src/transcripts-round-trip/main.output.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-src/transcripts-round-trip/main.md b/unison-src/transcripts-round-trip/main.md index 7824c9cfe1..7caf8f80e0 100644 --- a/unison-src/transcripts-round-trip/main.md +++ b/unison-src/transcripts-round-trip/main.md @@ -82,7 +82,7 @@ scratch/main> diff.namespace /a3_new:. /a3:. ## Other regression tests not covered by above -### Builtins should appear commended out in the edit command +### Builtins should appear commented out in the edit command Regression test for https://github.com/unisonweb/unison/pull/3548 diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index f8fcb3964e..24cd094464 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -831,7 +831,7 @@ scratch/main> diff.namespace /a3_new:. /a3:. ``` ## Other regression tests not covered by above -### Builtins should appear commended out in the edit command +### Builtins should appear commented out in the edit command Regression test for https://github.com/unisonweb/unison/pull/3548 From 2f4e57d41b8d328bcd89adb345e32f4fc3894e20 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 10 Jul 2024 11:05:13 -0700 Subject: [PATCH 439/631] Fix Upgrade --- .../Codebase/Editor/HandleInput/Upgrade.hs | 17 +++++++++-------- .../transcripts/upgrade-sad-path.output.md | 3 +-- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index b34a92692f..454e530f17 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -19,7 +19,7 @@ import Unison.Cli.ProjectUtils qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch -import Unison.Codebase.Editor.HandleInput.Branch (CreateFrom (CreateFrom'ParentBranch)) +import Unison.Codebase.Editor.HandleInput.Branch (CreateFrom (..)) import Unison.Codebase.Editor.HandleInput.Branch qualified as HandleInput.Branch import Unison.Codebase.Editor.HandleInput.Update2 ( addDefinitionsToUnisonFile, @@ -70,13 +70,14 @@ handleUpgrade oldName newName = do let oldPath = Path.Absolute (Path.fromList [NameSegment.libSegment, oldName]) let newPath = Path.Absolute (Path.fromList [NameSegment.libSegment, newName]) - currentNamespace <- Cli.getCurrentProjectRoot0 - let currentNamespaceSansOld = Branch.deleteLibdep oldName currentNamespace - let currentDeepTermsSansOld = Branch.deepTerms currentNamespaceSansOld - let currentDeepTypesSansOld = Branch.deepTypes currentNamespaceSansOld - let currentLocalNames = Branch.toNames (Branch.deleteLibdeps currentNamespace) + currentNamespace <- Cli.getCurrentProjectRoot + let currentNamespaceSansOld = currentNamespace & Branch.step (Branch.deleteLibdep oldName) + let currentNamespaceSansOld0 = Branch.head currentNamespaceSansOld + let currentDeepTermsSansOld = Branch.deepTerms currentNamespaceSansOld0 + let currentDeepTypesSansOld = Branch.deepTypes currentNamespaceSansOld0 + let currentLocalNames = Branch.toNames (Branch.deleteLibdeps $ Branch.head currentNamespace) let currentLocalConstructorNames = forwardCtorNames currentLocalNames - let currentDeepNamesSansOld = Branch.toNames currentNamespaceSansOld + let currentDeepNamesSansOld = Branch.toNames currentNamespaceSansOld0 oldNamespace <- Cli.expectBranch0AtPath' (Path.AbsolutePath' oldPath) let oldLocalNamespace = Branch.deleteLibdeps oldNamespace @@ -158,7 +159,7 @@ handleUpgrade oldName newName = do (_temporaryBranchId, temporaryBranchName) <- HandleInput.Branch.createBranch textualDescriptionOfUpgrade - (CreateFrom'ParentBranch projectBranch) + (CreateFrom'NamespaceWithParent projectBranch currentNamespaceSansOld) project getTemporaryBranchName scratchFilePath <- diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md index db089be327..f0811cd8ee 100644 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ b/unison-src/transcripts/upgrade-sad-path.output.md @@ -93,13 +93,12 @@ proj/main> view thingy thingy : Int thingy = use Int + - new.foo + +10 + foo + +10 proj/main> ls lib 1. builtin/ (469 terms, 74 types) 2. new/ (1 term) - 3. old/ (1 term) proj/main> branches From cbd533e40f07027c5552e47b8a8d656be78fca52 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 10 Jul 2024 16:04:21 -0600 Subject: [PATCH 440/631] Update a couple transcripts to the new formatting MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit These aren‘t run as part of ./scripts/check.sh, so they got missed in the initial pass. --- .../builtin-tests/interpreter-tests.output.md | 2 +- unison-src/builtin-tests/jit-tests.output.md | 19 ++++++++++--------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/unison-src/builtin-tests/interpreter-tests.output.md b/unison-src/builtin-tests/interpreter-tests.output.md index 9257063d78..7ba9ed8bb7 100644 --- a/unison-src/builtin-tests/interpreter-tests.output.md +++ b/unison-src/builtin-tests/interpreter-tests.output.md @@ -4,7 +4,7 @@ If you want to add or update tests, you can create a branch of that project, and Before merging the PR on Github, we'll merge your branch on Share and restore `runtime_tests_version` to /main or maybe a release. -```ucm +``` ucm runtime-tests/selected> run tests () diff --git a/unison-src/builtin-tests/jit-tests.output.md b/unison-src/builtin-tests/jit-tests.output.md index 36da409296..4bdb6cc29f 100644 --- a/unison-src/builtin-tests/jit-tests.output.md +++ b/unison-src/builtin-tests/jit-tests.output.md @@ -4,7 +4,7 @@ If you want to add or update tests, you can create a branch of that project, and Before merging the PR on Github, we'll merge your branch on Share and restore `runtime_tests_version` to /main or maybe a release. -```ucm +``` ucm runtime-tests/selected> run.native tests () @@ -17,7 +17,8 @@ runtime-tests/selected> run.native tests.jit.only Per Dan: It's testing a flaw in how we were sending code from a scratch file to the native runtime, when that happened multiple times. Related to the verifiable refs and recursive functions. -```unison + +``` unison foo = do go : Nat ->{Exception} () go = cases @@ -26,20 +27,20 @@ foo = do go 1000 ``` -```ucm +``` ucm Loading changes detected in scratch.u. I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: - + foo : '{Exception} () ``` -```ucm +``` ucm scratch/main> run.native foo () @@ -53,14 +54,14 @@ This can also only be tested by separately running this test, because it is exercising the protocol that ucm uses to talk to the jit during an exception. -```ucm +``` ucm runtime-tests/selected> run.native testBug 💔💥 - + I've encountered a call to builtin.bug with the following value: - + "testing" ``` From f382ef1aeb5f2dc2d6a13bddc56d128f694dc704 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 10 Jul 2024 14:49:36 -0700 Subject: [PATCH 441/631] Attempt to fix up update.old --- .../Codebase/Editor/HandleInput/Update.hs | 75 ++++++++++--------- 1 file changed, 40 insertions(+), 35 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs index 39cc4acc23..38bac30323 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs @@ -36,6 +36,7 @@ import Unison.Codebase.Patch (Patch (..)) import Unison.Codebase.Patch qualified as Patch import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.TermEdit qualified as TermEdit import Unison.Codebase.TypeEdit qualified as TypeEdit import Unison.DataDeclaration (Decl) @@ -74,8 +75,8 @@ import Unison.WatchKind (WatchKind) handleUpdate :: Input -> OptionalPatch -> Set Name -> Cli () handleUpdate input optionalPatch requestedNames = do Cli.Env {codebase} <- ask - pp <- Cli.getCurrentProjectPath - currentPath' <- Cli.getCurrentPath + ppRoot <- PP.toRoot <$> Cli.getCurrentProjectPath + currentPathAbs <- Cli.getCurrentPath let patchPath = case optionalPatch of NoPatch -> Nothing @@ -167,52 +168,56 @@ handleUpdate input optionalPatch requestedNames = do p' = foldl' step1 p typeEdits step1 p (_, r, r') = Patch.updateType r (TypeEdit.Replace r') p step2 p (_, r, r') = Patch.updateTerm typing r (TermEdit.Replace r' (typing r r')) p - (p, seg) = Path.toAbsoluteSplit currentPath' patchPath + (p, seg) = Path.toAbsoluteSplit currentPathAbs patchPath updatePatches :: (Monad m) => Branch0 m -> m (Branch0 m) updatePatches = Branch.modifyPatches seg updatePatch pure (updatePatch ye'ol'Patch, updatePatches, p) - when (Slurp.hasAddsOrUpdates sr) $ do - -- First add the new definitions to the codebase - Cli.runTransaction - . Codebase.addDefsToCodebase codebase - . Slurp.filterUnisonFile sr - $ Slurp.originalFile sr - currentBranch <- Cli.getCurrentBranch - -- take a look at the `updates` from the SlurpResult - -- and make a patch diff to record a replacement from the old to new references - updatedBranch <- - currentBranch - & Branch.stepManyAtM - ( [ ( Path.unabsolute currentPath', - pure . doSlurpUpdates typeEdits termEdits termDeprecations - ), - ( Path.unabsolute currentPath', - pure . doSlurpAdds addsAndUpdates (Slurp.originalFile sr) + updatedProjectRootBranch <- + if Slurp.hasAddsOrUpdates sr + then do + -- First add the new definitions to the codebase + Cli.runTransaction + . Codebase.addDefsToCodebase codebase + . Slurp.filterUnisonFile sr + $ Slurp.originalFile sr + projectRootBranch <- Cli.getCurrentProjectRoot + -- take a look at the `updates` from the SlurpResult + -- and make a patch diff to record a replacement from the old to new references + projectRootBranch + & Branch.stepManyAtM + ( [ ( Path.unabsolute currentPathAbs, + pure . doSlurpUpdates typeEdits termEdits termDeprecations + ), + ( Path.unabsolute currentPathAbs, + pure . doSlurpAdds addsAndUpdates (Slurp.originalFile sr) + ) + ] + ++ case patchOps of + Nothing -> [] + Just (_, update, p) -> [(Path.unabsolute p, update)] ) - ] - ++ case patchOps of - Nothing -> [] - Just (_, update, p) -> [(Path.unabsolute p, update)] - ) - & liftIO + & liftIO + else Cli.getCurrentProjectRoot - let codebaseAndFileNames = UF.addNamesFromTypeCheckedUnisonFile (Slurp.originalFile sr) currentCodebaseNames - pped <- Cli.prettyPrintEnvDeclFromNames codebaseAndFileNames - let suffixifiedPPE = PPE.suffixifiedPPE pped - Cli.respond $ SlurpOutput input suffixifiedPPE sr - branchWithPropagatedPatch <- case patchOps of - Nothing -> pure updatedBranch + projectRootBranchWithPropagatedPatch <- case patchOps of + Nothing -> pure updatedProjectRootBranch Just (updatedPatch, _, _) -> do - propagatePatch updatedPatch (Path.unabsolute currentPath') updatedBranch + -- Propagate the patch to the whole project. + let scopePath = Path.empty + propagatePatch updatedPatch scopePath updatedProjectRootBranch let description = case patchPath of Nothing -> "update.nopatch" Just p -> p & Path.unsplit' - & Path.resolve @_ @_ @Path.Absolute currentPath' + & Path.resolve @_ @_ @Path.Absolute currentPathAbs & tShow - void $ Cli.updateAt description pp (const branchWithPropagatedPatch) + void $ Cli.updateAt description ppRoot (const projectRootBranchWithPropagatedPatch) + let codebaseAndFileNames = UF.addNamesFromTypeCheckedUnisonFile (Slurp.originalFile sr) (Branch.toNames $ Branch.head projectRootBranchWithPropagatedPatch) + pped <- Cli.prettyPrintEnvDeclFromNames codebaseAndFileNames + let suffixifiedPPE = PPE.suffixifiedPPE pped + Cli.respond $ SlurpOutput input suffixifiedPPE sr getSlurpResultForUpdate :: Set Name -> Names -> Cli SlurpResult getSlurpResultForUpdate requestedNames slurpCheckNames = do From a455180a08059025b899a0fc7860f0fa464228ad Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 10 Jul 2024 16:14:44 -0700 Subject: [PATCH 442/631] No leading dot on brps From c2958cca28356eec1bde3b105f8737e7bdef7e07 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 11 Jul 2024 12:09:41 -0400 Subject: [PATCH 443/631] Use pretty text in MsgTrace case of debug toText --- parser-typechecker/src/Unison/Runtime/Machine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Runtime/Machine.hs b/parser-typechecker/src/Unison/Runtime/Machine.hs index 473fdb34a0..eecc5cc09b 100644 --- a/parser-typechecker/src/Unison/Runtime/Machine.hs +++ b/parser-typechecker/src/Unison/Runtime/Machine.hs @@ -384,7 +384,7 @@ exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim1 DBTX i) ustk <- bump ustk bstk <- case tracer env False clo of NoTrace -> bstk <$ poke ustk 0 - MsgTrace _ tx _ -> do + MsgTrace _ _ tx -> do poke ustk 1 bstk <- bump bstk bstk <$ pokeBi bstk (Util.Text.pack tx) From 987cd619766753452e49935fb1e0bb648a99bc01 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 11 Jul 2024 09:38:50 -0700 Subject: [PATCH 444/631] Swap branch-relative-paths back to relative --- .../src/Unison/Codebase/ProjectPath.hs | 8 ++++---- .../Unison/CommandLine/BranchRelativePath.hs | 17 +++++++++-------- unison-src/transcripts-round-trip/main.md | 4 ++-- .../transcripts-round-trip/main.output.md | 4 ++-- unison-src/transcripts/branch-relative-path.md | 6 +++--- .../transcripts/branch-relative-path.output.md | 6 +++--- unison-src/transcripts/reflog.output.md | 14 +++++++------- unison-src/transcripts/reset.md | 2 +- unison-src/transcripts/reset.output.md | 2 +- unison-src/transcripts/view.md | 2 +- unison-src/transcripts/view.output.md | 2 +- 11 files changed, 34 insertions(+), 33 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index ffb7b08505..2714c44e4a 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -54,12 +54,12 @@ instance From ProjectPath Text where from = from . toNames instance From ProjectPathNames Text where - from (ProjectPath proj branch path) = - into @Text (ProjectAndBranch proj branch) <> ":" <> Path.absToText path + from (ProjectPath proj branch (Path.Absolute path)) = + into @Text (ProjectAndBranch proj branch) <> ":" <> Path.toText path instance From (ProjectPathG () ProjectBranchName) Text where - from (ProjectPath () branch path) = - "/" <> into @Text branch <> ":" <> Path.absToText path + from (ProjectPath () branch (Path.Absolute path)) = + "/" <> into @Text branch <> ":" <> Path.toText path type ProjectPath = ProjectPathG Project ProjectBranch diff --git a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs index 116dbb60e7..cc49baa3ce 100644 --- a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs +++ b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs @@ -166,13 +166,13 @@ incrementalBranchRelativePathParser = Megaparsec.Parsec Void Text IncrementalBranchRelativePath startingAtColon projStuff = do _ <- Megaparsec.char ':' - p <- optionalEof absPath + p <- optionalEof brPath pure (IncompletePath projStuff p) pathRelativeToCurrentBranch :: Megaparsec.Parsec Void Text IncrementalBranchRelativePath pathRelativeToCurrentBranch = do _ <- Megaparsec.char ':' - p <- absPath + p <- brPath pure (PathRelativeToCurrentBranch p) optionalEof :: Megaparsec.Parsec Void Text a -> Megaparsec.Parsec Void Text (Maybe a) @@ -183,12 +183,13 @@ incrementalBranchRelativePathParser = branchNameParser = Project.projectBranchNameParser False - absPath :: Megaparsec.Parsec Void Text Path.Absolute - absPath = do + brPath :: Megaparsec.Parsec Void Text Path.Absolute + brPath = do offset <- Megaparsec.getOffset path' >>= \(Path.Path' inner) -> case inner of - Left p -> pure p - Right _ -> failureAt offset "Expected an absolute path but found a relative path. Try adding a leading '.' to your path" + Left _ -> failureAt offset "Branch qualified paths don't require a leading '.'" + -- Branch relative paths are written as relative paths, but are always absolute to the branch root + Right (Path.Relative x) -> pure $ Path.Absolute x path' = Megaparsec.try do offset <- Megaparsec.getOffset pathStr <- Megaparsec.takeRest @@ -235,6 +236,6 @@ branchRelativePathParser = toText :: BranchRelativePath -> Text toText = \case - BranchPathInCurrentProject pbName absPath -> ProjectPath () pbName absPath & into @Text - QualifiedBranchPath projName pbName absPath -> ProjectPath projName pbName absPath & into @Text + BranchPathInCurrentProject pbName path -> ProjectPath () pbName path & into @Text + QualifiedBranchPath projName pbName path -> ProjectPath projName pbName path & into @Text UnqualifiedPath path' -> Path.toText' path' diff --git a/unison-src/transcripts-round-trip/main.md b/unison-src/transcripts-round-trip/main.md index 7caf8f80e0..a7d7b01f3e 100644 --- a/unison-src/transcripts-round-trip/main.md +++ b/unison-src/transcripts-round-trip/main.md @@ -41,7 +41,7 @@ scratch/a2> delete.namespace.force lib.builtins This diff should be empty if the two namespaces are equivalent. If it's nonempty, the diff will show us the hashes that differ. ```ucm:error -scratch/main> diff.namespace /a1:. /a2:. +scratch/main> diff.namespace /a1: /a2: ``` Now check that definitions in 'reparses.u' at least parse on round trip: @@ -77,7 +77,7 @@ scratch/a3_new> delete.namespace.force lib.builtins These are currently all expected to have different hashes on round trip. ```ucm -scratch/main> diff.namespace /a3_new:. /a3:. +scratch/main> diff.namespace /a3_new: /a3: ``` ## Other regression tests not covered by above diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index 18b455b304..def5266331 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -771,7 +771,7 @@ a |> f = f a This diff should be empty if the two namespaces are equivalent. If it's nonempty, the diff will show us the hashes that differ. ``` ucm -scratch/main> diff.namespace /a1:. /a2:. +scratch/main> diff.namespace /a1: /a2: The namespaces are identical. @@ -820,7 +820,7 @@ sloppyDocEval = These are currently all expected to have different hashes on round trip. ``` ucm -scratch/main> diff.namespace /a3_new:. /a3:. +scratch/main> diff.namespace /a3_new: /a3: Updates: diff --git a/unison-src/transcripts/branch-relative-path.md b/unison-src/transcripts/branch-relative-path.md index 49bd4863b3..77de247037 100644 --- a/unison-src/transcripts/branch-relative-path.md +++ b/unison-src/transcripts/branch-relative-path.md @@ -14,11 +14,11 @@ donk.bonk = 1 ```ucm p1/main> add -p1/main> fork p0/main:. zzz +p1/main> fork p0/main: zzz p1/main> find zzz -p1/main> fork p0/main:.foo yyy +p1/main> fork p0/main:foo yyy p1/main> find yyy -p0/main> fork p1/main:. p0/main:.p1 +p0/main> fork p1/main: p0/main:p1 p0/main> ls p1 p0/main> ls p1.zzz p0/main> ls p1.yyy diff --git a/unison-src/transcripts/branch-relative-path.output.md b/unison-src/transcripts/branch-relative-path.output.md index 35592794af..e9e33b5ad9 100644 --- a/unison-src/transcripts/branch-relative-path.output.md +++ b/unison-src/transcripts/branch-relative-path.output.md @@ -55,7 +55,7 @@ p1/main> add bonk : ##Nat donk.bonk : ##Nat -p1/main> fork p0/main:. zzz +p1/main> fork p0/main: zzz Done. @@ -65,7 +65,7 @@ p1/main> find zzz 2. zzz.foo.bar : ##Nat -p1/main> fork p0/main:.foo yyy +p1/main> fork p0/main:foo yyy Done. @@ -74,7 +74,7 @@ p1/main> find yyy 1. yyy.bar : ##Nat -p0/main> fork p1/main:. p0/main:.p1 +p0/main> fork p1/main: p0/main:p1 Done. diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index d0c001dcfd..9fbff90318 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -84,7 +84,7 @@ scratch/main> reflog Branch Hash Description 1. scratch/main #6mdl5gruh5 add 2. scratch/main #3rqf1hbev7 add - 3. scratch/main #ms9lggs2rg builtins.merge scratch/main:.lib.builtins + 3. scratch/main #ms9lggs2rg builtins.merge scratch/main:lib.builtins 4. scratch/main #sg60bvjo91 Project Created ``` @@ -101,11 +101,11 @@ scratch/main> project.reflog history. Branch Hash Description - 1. scratch/other #148flqs4b1 alias.term scratch/other:..y scratch/other:.z + 1. scratch/other #148flqs4b1 alias.term scratch/other:.y scratch/other:z 2. scratch/other #6mdl5gruh5 Branch created from scratch/main 3. scratch/main #6mdl5gruh5 add 4. scratch/main #3rqf1hbev7 add - 5. scratch/main #ms9lggs2rg builtins.merge scratch/main:.lib.builtins + 5. scratch/main #ms9lggs2rg builtins.merge scratch/main:lib.builtins 6. scratch/main #sg60bvjo91 Project Created ``` @@ -122,14 +122,14 @@ scratch/main> reflog.global history. Branch Hash Description - 1. newproject/main #2rjhs2vq43 alias.term newproject/main:.lib.builtins.Nat newproject/main... - 2. newproject/main #ms9lggs2rg builtins.merge newproject/main:.lib.builtins + 1. newproject/main #2rjhs2vq43 alias.term newproject/main:lib.builtins.Nat newproject/main:... + 2. newproject/main #ms9lggs2rg builtins.merge newproject/main:lib.builtins 3. newproject/main #sg60bvjo91 Branch Created - 4. scratch/other #148flqs4b1 alias.term scratch/other:..y scratch/other:.z + 4. scratch/other #148flqs4b1 alias.term scratch/other:.y scratch/other:z 5. scratch/other #6mdl5gruh5 Branch created from scratch/main 6. scratch/main #6mdl5gruh5 add 7. scratch/main #3rqf1hbev7 add - 8. scratch/main #ms9lggs2rg builtins.merge scratch/main:.lib.builtins + 8. scratch/main #ms9lggs2rg builtins.merge scratch/main:lib.builtins 9. scratch/main #sg60bvjo91 Project Created ``` diff --git a/unison-src/transcripts/reset.md b/unison-src/transcripts/reset.md index 2cd19597de..e430ef2906 100644 --- a/unison-src/transcripts/reset.md +++ b/unison-src/transcripts/reset.md @@ -46,7 +46,7 @@ a = 5 ```ucm foo/main> update -foo/empty> reset /main:. +foo/empty> reset /main: foo/empty> view a foo/empty> history ``` diff --git a/unison-src/transcripts/reset.output.md b/unison-src/transcripts/reset.output.md index 26c2ad4e27..7bcdacc4a1 100644 --- a/unison-src/transcripts/reset.output.md +++ b/unison-src/transcripts/reset.output.md @@ -145,7 +145,7 @@ foo/main> update Done. -foo/empty> reset /main:. +foo/empty> reset /main: Done. diff --git a/unison-src/transcripts/view.md b/unison-src/transcripts/view.md index f281cf3eca..5c2b0e8c58 100644 --- a/unison-src/transcripts/view.md +++ b/unison-src/transcripts/view.md @@ -27,5 +27,5 @@ TODO: swap this back to a 'ucm' block when view.global is re-implemented -- view.global should search globally and be absolutely qualified scratch/other> view.global thing -- Should support branch relative paths -scratch/other> view /main:.a.thing +scratch/other> view /main:a.thing ``` diff --git a/unison-src/transcripts/view.output.md b/unison-src/transcripts/view.output.md index 6a8613378e..a4698d9d07 100644 --- a/unison-src/transcripts/view.output.md +++ b/unison-src/transcripts/view.output.md @@ -27,5 +27,5 @@ TODO: swap this back to a 'ucm' block when view.global is re-implemented -- view.global should search globally and be absolutely qualified scratch/other> view.global thing -- Should support branch relative paths - scratch/other> view /main:.a.thing + scratch/other> view /main:a.thing From 474fddbd1366ad8b863cc7648e165a42b3633c5c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 10 Jul 2024 22:57:09 -0700 Subject: [PATCH 445/631] Use a branch root semispace cache --- parser-typechecker/src/Unison/Codebase.hs | 2 +- .../src/Unison/Codebase/SqliteCodebase.hs | 31 +++++++++++++------ .../SqliteCodebase/ProjectRootCache.hs | 28 ----------------- .../src/Unison/Codebase/Type.hs | 2 +- .../unison-parser-typechecker.cabal | 1 - 5 files changed, 23 insertions(+), 41 deletions(-) delete mode 100644 parser-typechecker/src/Unison/Codebase/SqliteCodebase/ProjectRootCache.hs diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 6187f05648..79b00026a4 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -587,4 +587,4 @@ preloadProjectBranch codebase (ProjectAndBranch projectId branchId) = do ch <- runTransaction codebase $ do causalHashId <- Q.expectProjectBranchHead projectId branchId Q.expectCausalHash causalHashId - preloadProjectRoot codebase ch + preloadBranch codebase ch diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs index 045a310199..c104e79c87 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs @@ -39,7 +39,6 @@ import Unison.Codebase.SqliteCodebase.Branch.Dependencies qualified as BD import Unison.Codebase.SqliteCodebase.Migrations qualified as Migrations import Unison.Codebase.SqliteCodebase.Operations qualified as CodebaseOps import Unison.Codebase.SqliteCodebase.Paths -import Unison.Codebase.SqliteCodebase.ProjectRootCache qualified as ProjectRootCache import Unison.Codebase.SqliteCodebase.SyncEphemeral qualified as SyncEphemeral import Unison.Codebase.Type (LocalOrRemote (..)) import Unison.Codebase.Type qualified as C @@ -55,6 +54,7 @@ import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Term (Term) import Unison.Type (Type) +import Unison.Util.Cache qualified as Cache import Unison.Util.Timing (time) import Unison.WatchKind qualified as UF import UnliftIO (UnliftIO (..), finally) @@ -164,8 +164,17 @@ sqliteCodebase :: (Codebase m Symbol Ann -> m r) -> m (Either Codebase1.OpenCodebaseError r) sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action = handleLockOption do - branchCache <- newBranchCache - projectRootCache <- ProjectRootCache.newProjectRootCache 5 {- Cache the last n project roots for quick switching. -} + -- The branchLoadCache ephemerally caches branches in memory, but doesn't prevent them from being GC'd. + -- This is very useful when loading root branches because the cache shouldn't be limited in size. + -- But this cache will automatically clean itself up and remove entries that are no longer reachable. + -- If you load another branch, which shares namespaces with another branch that's in memory (and therefor in the cache) + -- then those shared namespaces will be loaded from the cache and will be shared in memory. + branchLoadCache <- newBranchCache + -- The rootBranchCache is a semispace cache which keeps the most recent branch roots (e.g. project roots) alive in memory. + -- Unlike the branchLoadCache, this cache is bounded in size and will evict older branches when it reaches its limit. + -- The two work in tandem, so the rootBranchCache keeps relevant branches alive, and the branchLoadCache + -- stores ALL the subnamespaces of those branches, deduping them when loading from the DB. + rootBranchCache <- Cache.semispaceCache 10 getDeclType <- CodebaseOps.makeCachedTransaction 2048 CodebaseOps.getDeclType -- The v1 codebase interface has operations to read and write individual definitions -- whereas the v2 codebase writes them as complete components. These two fields buffer @@ -238,21 +247,23 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action -- if this blows up on cromulent hashes, then switch from `hashToHashId` -- to one that returns Maybe. getBranchForHash :: CausalHash -> m (Maybe (Branch m)) - getBranchForHash h = - fmap (Branch.transform runTransaction) <$> runTransaction (CodebaseOps.getBranchForHash branchCache getDeclType h) + getBranchForHash = + Cache.applyDefined rootBranchCache \h -> do + fmap (Branch.transform runTransaction) <$> runTransaction (CodebaseOps.getBranchForHash branchLoadCache getDeclType h) putBranch :: Branch m -> m () putBranch branch = withRunInIO \runInIO -> - runInIO (runTransaction (CodebaseOps.putBranch (Branch.transform (Sqlite.unsafeIO . runInIO) branch))) + runInIO $ do + Cache.insert rootBranchCache (Branch.headHash branch) branch + runTransaction (CodebaseOps.putBranch (Branch.transform (Sqlite.unsafeIO . runInIO) branch)) - preloadProjectRoot :: CausalHash -> m () - preloadProjectRoot h = do + preloadBranch :: CausalHash -> m () + preloadBranch h = do void . UnliftIO.forkIO $ void $ do getBranchForHash h >>= \case Nothing -> pure () Just b -> do - ProjectRootCache.stashBranch projectRootCache b UnliftIO.evaluate b pure () @@ -322,7 +333,7 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action termReferentsByPrefix = referentsByPrefix, withConnection = withConn, withConnectionIO = withConnection debugName root, - preloadProjectRoot + preloadBranch } Right <$> action codebase where diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/ProjectRootCache.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/ProjectRootCache.hs deleted file mode 100644 index 9dd6f604aa..0000000000 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/ProjectRootCache.hs +++ /dev/null @@ -1,28 +0,0 @@ --- | Simple cache which just keeps the last n relevant project branches in memory. --- The Branch Cache handles all the lookups of the actual branch data by hash, this cache serves only to keep the last --- n accessed branches in memory so they don't get garbage collected. See the Branch Cache for more context. --- --- This speeds up switching back and forth between project branches, and also serves to keep the current project branch --- in memory so it won't be cleaned up by the Branch Cache, since the Branch Cache only keeps --- a weak reference to the current branch and we no longer keep the actual branch in LoopState. -module Unison.Codebase.SqliteCodebase.ProjectRootCache - ( newProjectRootCache, - stashBranch, - ) -where - -import Control.Concurrent.STM -import Unison.Codebase.Branch -import Unison.Prelude - -data ProjectRootCache m = ProjectRootCache {capacity :: Int, cached :: TVar [Branch m]} - -newProjectRootCache :: (MonadIO m) => Int -> m (ProjectRootCache n) -newProjectRootCache capacity = do - var <- liftIO $ newTVarIO [] - pure (ProjectRootCache capacity var) - -stashBranch :: (MonadIO n) => ProjectRootCache m -> Branch m -> n () -stashBranch ProjectRootCache {capacity, cached} branch = do - liftIO . atomically $ do - modifyTVar cached $ \branches -> take capacity (branch : filter (/= branch) branches) diff --git a/parser-typechecker/src/Unison/Codebase/Type.hs b/parser-typechecker/src/Unison/Codebase/Type.hs index f89fe8381c..af69f555cd 100644 --- a/parser-typechecker/src/Unison/Codebase/Type.hs +++ b/parser-typechecker/src/Unison/Codebase/Type.hs @@ -85,7 +85,7 @@ data Codebase m v a = Codebase -- soon, but not immediately. E.g. the user has switched a branch, but hasn't run any commands on it yet. -- -- This combinator returns immediately, but warms the cache in the background with the desired branch. - preloadProjectRoot :: CausalHash -> m () + preloadBranch :: CausalHash -> m () } -- | Whether a codebase is local or remote. diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 43f2b17634..7139bd1d02 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -81,7 +81,6 @@ library Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema7To8 Unison.Codebase.SqliteCodebase.Operations Unison.Codebase.SqliteCodebase.Paths - Unison.Codebase.SqliteCodebase.ProjectRootCache Unison.Codebase.SqliteCodebase.SyncEphemeral Unison.Codebase.TermEdit Unison.Codebase.TermEdit.Typing From 1e4f1abe7308a7d65f45ee154114d1762d70001c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 11 Jul 2024 12:03:09 -0700 Subject: [PATCH 446/631] Fix diff-helper to use the names from both branches --- .../Editor/HandleInput/NamespaceDiffUtils.hs | 2 +- unison-src/transcripts/delete.output.md | 4 +- unison-src/transcripts/diff-namespace.md | 11 +- .../transcripts/diff-namespace.output.md | 147 +++++++++--------- 4 files changed, 85 insertions(+), 79 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs index 0416672e3e..4dce00e742 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs @@ -36,7 +36,7 @@ diffHelper before after = Cli.Env {codebase} <- ask hqLength <- Cli.runTransaction Codebase.hashLength diff <- liftIO (BranchDiff.diff0 before after) - names <- Cli.currentNames + names <- Cli.currentNames <&> \currentNames -> currentNames <> Branch.toNames before <> Branch.toNames after pped <- Cli.prettyPrintEnvDeclFromNames names let suffixifiedPPE = PPED.suffixifiedPPE pped fmap (suffixifiedPPE,) do diff --git a/unison-src/transcripts/delete.output.md b/unison-src/transcripts/delete.output.md index 0fceae62a6..c87f5140bd 100644 --- a/unison-src/transcripts/delete.output.md +++ b/unison-src/transcripts/delete.output.md @@ -362,8 +362,8 @@ scratch/main> delete.verbose Foo Foo.Foo incrementFoo Removed definitions: 1. structural type Foo - 2. Foo.Foo : Nat -> #68k40ra7l7 - 3. incrementFoo : #68k40ra7l7 -> Nat + 2. Foo.Foo : Nat -> Foo + 3. incrementFoo : Foo -> Nat Tip: You can use `undo` or use a hash from `branch.reflog` to undo this change. diff --git a/unison-src/transcripts/diff-namespace.md b/unison-src/transcripts/diff-namespace.md index ecb0b129d0..f2312268a8 100644 --- a/unison-src/transcripts/diff-namespace.md +++ b/unison-src/transcripts/diff-namespace.md @@ -3,6 +3,7 @@ scratch/b1> builtins.merge lib.builtins scratch/b2> builtins.merge lib.builtins scratch/nsx> builtins.merge lib.builtins scratch/main> builtins.merge lib.builtins +scratch/ns1> builtins.merge lib.builtins ``` ```unison:hide @@ -79,7 +80,7 @@ scratch/ns1> delete.term junk ```unison:hide fromJust = 99 -b = "oog" +b = 999999999 d = 4 e = 5 f = 6 @@ -87,7 +88,7 @@ unique type Y a b = Y a b ``` ```ucm -scratch/ns2> update.old +scratch/ns2> update scratch/main> diff.namespace /ns1: /ns2: scratch/ns2> alias.term d d' scratch/ns2> alias.type A A' @@ -104,7 +105,7 @@ scratch/main> diff.namespace /ns3: /ns2: bdependent = "banana" ``` ```ucm -scratch/ns3> update.old +scratch/ns3> update scratch/main> diff.namespace /ns2: /ns3: ``` @@ -132,7 +133,7 @@ a = 444 ``` ```ucm -scratch/nsy> update.old +scratch/nsy> update ``` ```unison:hide @@ -140,7 +141,7 @@ a = 555 ``` ```ucm -scratch/nsz> update.old +scratch/nsz> update scratch/nsy> branch /nsw scratch/nsw> debug.alias.term.force .forconflicts .a scratch/nsw> debug.alias.term.force .forconflicts .b diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md index 5121aa9082..d54ff32e00 100644 --- a/unison-src/transcripts/diff-namespace.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -79,11 +79,11 @@ scratch/ns1> add structural type A a structural ability X a1 a2 - b : ##Nat - bdependent : ##Nat - c : ##Nat - fromJust : ##Nat - helloWorld : ##Text + b : Nat + bdependent : Nat + c : Nat + fromJust : Nat + helloWorld : Text scratch/ns1> alias.term fromJust fromJust' @@ -126,7 +126,7 @@ scratch/ns1> add ⍟ I've added these definitions: - junk : ##Text + junk : Text scratch/ns1> debug.alias.term.force junk fromJust @@ -139,7 +139,7 @@ scratch/ns1> delete.term junk ``` ``` unison fromJust = 99 -b = "oog" +b = 999999999 d = 4 e = 5 f = 6 @@ -147,20 +147,16 @@ unique type Y a b = Y a b ``` ``` ucm -scratch/ns2> update.old +scratch/ns2> update - ⍟ I've added these definitions: - - type Y a b - d : ##Nat - e : ##Nat - f : ##Nat - - ⍟ I've updated these names to your new definition: - - b : ##Text - fromJust : ##Nat - (The old definition was also named fromJust'.) + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. scratch/main> diff.namespace /ns1: /ns2: @@ -175,21 +171,25 @@ scratch/main> diff.namespace /ns1: /ns2: 4. b : Nat ↓ - 5. b : Text + 5. b : Nat - 6. fromJust' : Nat + 6. bdependent : Nat ↓ - 7. fromJust' : Nat + 7. bdependent : Nat Added definitions: 8. type Y a b - 9. Y.Y : a -> b -> #md85ksgqel a b + 9. Y.Y : a -> b -> Y a b 10. d : Nat 11. e : Nat 12. f : Nat - 13. patch patch (added 2 updates) + Name changes: + + Original Changes + 13. fromJust' ┐ 14. fromJust#gjmq673r1v (removed) + 15. fromJust#gjmq673r1v ┘ scratch/ns2> alias.term d d' @@ -216,29 +216,30 @@ scratch/main> diff.namespace /ns1: /ns2: 4. b : Nat ↓ - 5. b : Text + 5. b : Nat - 6. fromJust' : Nat + 6. bdependent : Nat ↓ - 7. fromJust' : Nat + 7. bdependent : Nat Added definitions: 8. type Y a b - 9. Y.Y : a -> b -> #md85ksgqel a b + 9. Y.Y : a -> b -> Y a b 10. ┌ d : Nat 11. └ d' : Nat 12. e : Nat 13. f : Nat - 14. patch patch (added 2 updates) - Name changes: - Original Changes - 15. A 16. A' (added) + Original Changes + 14. A 15. A' (added) - 17. X 18. X' (added) + 16. X 17. X' (added) + + 18. fromJust' ┐ 19. fromJust#gjmq673r1v (removed) + 20. fromJust#gjmq673r1v ┘ scratch/ns1> alias.type X X2 @@ -264,9 +265,8 @@ scratch/ns2> delete.term.verbose fromJust' Name changes: Original Changes - 1. fromJust ┐ 2. fromJust' (removed) - 3. fromJust' │ - 4. yoohoo ┘ + 1. fromJust' ┐ 2. fromJust' (removed) + 3. yoohoo ┘ Tip: You can use `undo` or use a hash from `branch.reflog` to undo this change. @@ -276,8 +276,8 @@ scratch/main> diff.namespace /ns3: /ns2: Name changes: Original Changes - 1. fromJust ┐ 2. yoohoo (added) - 3. fromJust' ┘ 4. fromJust' (removed) + 1. fromJust' 2. yoohoo (added) + 3. fromJust' (removed) ``` ``` unison @@ -285,11 +285,12 @@ bdependent = "banana" ``` ``` ucm -scratch/ns3> update.old +scratch/ns3> update - ⍟ I've updated these names to your new definition: - - bdependent : ##Text + Okay, I'm searching the branch for code that needs to be + updated... + + Done. scratch/main> diff.namespace /ns2: /ns3: @@ -299,13 +300,11 @@ scratch/main> diff.namespace /ns2: /ns3: ↓ 2. bdependent : Text - 3. patch patch (added 1 updates) - Name changes: - Original Changes - 4. fromJust ┐ 5. fromJust' (added) - 6. yoohoo ┘ 7. yoohoo (removed) + Original Changes + 3. yoohoo 4. fromJust' (added) + 5. yoohoo (removed) ``` ## Two different auto-propagated changes creating a name conflict @@ -349,11 +348,16 @@ a = 444 ``` ``` ucm -scratch/nsy> update.old +scratch/nsy> update - ⍟ I've updated these names to your new definition: - - a : Nat + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. ``` ``` unison @@ -361,11 +365,16 @@ a = 555 ``` ``` ucm -scratch/nsz> update.old +scratch/nsz> update - ⍟ I've updated these names to your new definition: - - a : Nat + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. scratch/nsy> branch /nsw @@ -388,25 +397,21 @@ scratch/main> diff.namespace /nsx: /nsw: New name conflicts: - 1. a#uiiiv8a86s : Nat - ↓ - 2. ┌ a#mdl4vqtu00 : Nat - 3. └ a#r3msrbpp1v : Nat + 1. a#uiiiv8a86s : Nat + ↓ + 2. ┌ a#mdl4vqtu00 : Nat + 3. └ a#r3msrbpp1v : Nat - 4. b#lhigeb1let : Nat - ↓ - 5. ┌ b#r3msrbpp1v : Nat - 6. └ b#unkqhuu66p : Nat - - Added definitions: - - 7. patch patch (added 1 updates) + 4. b#lhigeb1let : Nat + ↓ + 5. ┌ b#r3msrbpp1v : Nat + 6. └ b#unkqhuu66p : Nat Name changes: - Original Changes - 8. forconflicts 9. a#r3msrbpp1v (added) - 10. b#r3msrbpp1v (added) + Original Changes + 7. forconflicts 8. a#r3msrbpp1v (added) + 9. b#r3msrbpp1v (added) scratch/nsw> view a From 670b0868b9dbbc12706d105c29db272f67d5b42e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 11 Jul 2024 12:45:18 -0700 Subject: [PATCH 447/631] Port fix2254 to new update --- unison-src/transcripts/fix2254.md | 6 +-- unison-src/transcripts/fix2254.output.md | 65 +++++++++++------------- 2 files changed, 33 insertions(+), 38 deletions(-) diff --git a/unison-src/transcripts/fix2254.md b/unison-src/transcripts/fix2254.md index 7af9ffd9ff..36ed00e6b0 100644 --- a/unison-src/transcripts/fix2254.md +++ b/unison-src/transcripts/fix2254.md @@ -39,7 +39,7 @@ We'll make our edits in a new branch. ```ucm scratch/a> add -scratch/a> branch a2 +scratch/a> branch /a2 scratch/a2> ``` @@ -57,7 +57,7 @@ unique type A a b c d Let's do the update now, and verify that the definitions all look good and there's nothing `todo`: ```ucm -scratch/a2> update.old +scratch/a2> update scratch/a2> view A NeedsA f f2 f3 g scratch/a2> todo ``` @@ -89,6 +89,6 @@ structural type Rec = { uno : Nat, dos : Nat, tres : Text } And checking that after updating this record, there's nothing `todo`: ```ucm -scratch/r2> update.old +scratch/r2> update scratch/r2> todo ``` diff --git a/unison-src/transcripts/fix2254.output.md b/unison-src/transcripts/fix2254.output.md index 17ea6012c7..05a1009e49 100644 --- a/unison-src/transcripts/fix2254.output.md +++ b/unison-src/transcripts/fix2254.output.md @@ -44,7 +44,7 @@ scratch/a> add f3 : NeedsA Nat Nat -> Nat g : A Nat Nat Nat Nat -> Nat -scratch/a> branch a2 +scratch/a> branch /a2 Done. I've created the a2 branch based off of a. @@ -66,11 +66,16 @@ unique type A a b c d Let's do the update now, and verify that the definitions all look good and there's nothing `todo`: ``` ucm -scratch/a2> update.old +scratch/a2> update - ⍟ I've updated these names to your new definition: - - type A a b c d + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. scratch/a2> view A NeedsA f f2 f3 g @@ -85,33 +90,30 @@ scratch/a2> view A NeedsA f f2 f3 g = NeedsA (A a b Nat Nat) | Zoink Text - f : #re3rf9cedk Nat Nat Nat Nat -> Nat + f : A Nat Nat Nat Nat -> Nat f = cases - #re3rf9cedk#1 n -> n - _ -> 42 + A n -> n + _ -> 42 - f2 : #re3rf9cedk Nat Nat Nat Nat -> Nat + f2 : A Nat Nat Nat Nat -> Nat f2 a = use Nat + n = f a n + 1 - f3 : #oftm6ao9vp Nat Nat -> Nat + f3 : NeedsA Nat Nat -> Nat f3 = cases - #oftm6ao9vp#0 a -> f a Nat.+ 20 - _ -> 0 + NeedsA a -> f a Nat.+ 20 + _ -> 0 - g : #re3rf9cedk Nat Nat Nat Nat -> Nat + g : A Nat Nat Nat Nat -> Nat g = cases - #re3rf9cedk#0 n -> n - _ -> 43 + D n -> n + _ -> 43 scratch/a2> todo - These types do not have any names in the current namespace: - - 1. #oftm6ao9vp - 2. #re3rf9cedk + You have no pending todo items. Good work! ✅ ``` ## Record updates @@ -199,23 +201,16 @@ structural type Rec = { uno : Nat, dos : Nat, tres : Text } And checking that after updating this record, there's nothing `todo`: ``` ucm -scratch/r2> update.old +scratch/r2> update - ⍟ I've added these definitions: - - Rec.tres : Rec -> Text - Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec - Rec.tres.set : Text -> Rec -> Rec - - ⍟ I've updated these names to your new definition: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. scratch/r2> todo From a010a8a2d7f2ada9100b828c1227a219ad3f3af9 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Fri, 12 Jul 2024 13:23:52 -0400 Subject: [PATCH 448/631] Use builtin reference names in foreign decompiling E.G. print instead of --- parser-typechecker/src/Unison/Runtime/Decompile.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Runtime/Decompile.hs b/parser-typechecker/src/Unison/Runtime/Decompile.hs index a1b1646ce8..00e8c4445a 100644 --- a/parser-typechecker/src/Unison/Runtime/Decompile.hs +++ b/parser-typechecker/src/Unison/Runtime/Decompile.hs @@ -230,7 +230,11 @@ decompileForeign backref topTerms f | Just s <- unwrapSeq f = list' () <$> traverse (decompile backref topTerms) s decompileForeign _ _ (Wrap r _) = - err (BadForeign r) $ bug "" + err (BadForeign r) $ bug text + where + text + | Builtin name <- r = "<" <> name <> ">" + | otherwise = "" decompileBytes :: (Var v) => By.Bytes -> Term v () decompileBytes = From 7c52443a0145006e3733f4d94df348bcfdf6a835 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 12 Jul 2024 11:20:31 -0700 Subject: [PATCH 449/631] Merge trunk From 11208f52843d6fa92a1b3771d75492fa1dabfb4d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 12 Jul 2024 11:20:31 -0700 Subject: [PATCH 450/631] Add unused binding test --- parser-typechecker/tests/Unison/Test/Term.hs | 2 +- unison-cli/src/Unison/LSP/Diagnostics.hs | 7 +- unison-cli/src/Unison/LSP/FileAnalysis.hs | 8 +- .../Unison/LSP/FileAnalysis/UnusedBindings.hs | 7 +- unison-cli/tests/Unison/Test/LSP.hs | 100 +++++++++++++++--- 5 files changed, 100 insertions(+), 24 deletions(-) diff --git a/parser-typechecker/tests/Unison/Test/Term.hs b/parser-typechecker/tests/Unison/Test/Term.hs index 31122f5aac..4791382bd9 100644 --- a/parser-typechecker/tests/Unison/Test/Term.hs +++ b/parser-typechecker/tests/Unison/Test/Term.hs @@ -57,7 +57,7 @@ test = ref = R.Id h 0 v1 = Var.unnamedRef @Symbol ref -- input component: `ref = \v1 -> ref` - component = Map.singleton ref (Term.lam () v1 (Term.refId () ref)) + component = Map.singleton ref (Term.lam () ((), v1) (Term.refId () ref)) component' = Term.unhashComponent component -- expected unhashed component: `v2 = \v1 -> v2`, where `v2 /= v1`, -- i.e. `v2` cannot be just `ref` converted to a ref-named variable, diff --git a/unison-cli/src/Unison/LSP/Diagnostics.hs b/unison-cli/src/Unison/LSP/Diagnostics.hs index bf9d154980..9416fec9bb 100644 --- a/unison-cli/src/Unison/LSP/Diagnostics.hs +++ b/unison-cli/src/Unison/LSP/Diagnostics.hs @@ -9,6 +9,7 @@ import Language.LSP.Protocol.Message qualified as Msg import Language.LSP.Protocol.Types import Unison.LSP.Types import Unison.Prelude +import Unison.Util.Monoid qualified as Monoid reportDiagnostics :: (Foldable f) => @@ -23,15 +24,15 @@ reportDiagnostics docUri fileVersion diags = do let params = PublishDiagnosticsParams {_uri = docUri, _version = fromIntegral <$> fileVersion, _diagnostics = toList $ diags} sendNotification (Msg.TNotificationMessage jsonRPC Msg.SMethod_TextDocumentPublishDiagnostics params) -mkDiagnostic :: Uri -> Range -> DiagnosticSeverity -> Text -> [(Text, Range)] -> Diagnostic -mkDiagnostic uri r severity msg references = +mkDiagnostic :: Uri -> Range -> DiagnosticSeverity -> [DiagnosticTag] -> Text -> [(Text, Range)] -> Diagnostic +mkDiagnostic uri r severity tags msg references = Diagnostic { _range = r, _severity = Just severity, _code = Nothing, -- We could eventually pass error codes here _source = Just "unison", _message = msg, - _tags = Nothing, + _tags = Monoid.whenM (not $ null tags) (Just tags), _relatedInformation = case references of [] -> Nothing diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index 76a6e8531b..221e8957f1 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -29,7 +29,6 @@ import Unison.Cli.UniqueTypeGuidLookup qualified as Cli import Unison.Codebase qualified as Codebase import Unison.DataDeclaration qualified as DD import Unison.Debug qualified as Debug -import Debug.Trace import Unison.FileParsers (ShouldUseTndr (..)) import Unison.FileParsers qualified as FileParsers import Unison.KindInference.Error qualified as KindInference @@ -112,8 +111,6 @@ checkFile doc = runMaybeT do & foldMap (\(RangedCodeAction {_codeActionRanges, _codeAction}) -> (,_codeAction) <$> _codeActionRanges) & toRangeMap let typeSignatureHints = fromMaybe mempty (mkTypeSignatureHints <$> parsedFile <*> typecheckedFile) - for_ (parsedFile & foldMap (Map.toList . UF.terms )) \(v, (_, trm)) -> do - traceM (show $ (v, trm)) let fileSummary = FileSummary.mkFileSummary parsedFile typecheckedFile let unusedBindingDiagnostics = fileSummary ^.. _Just . to termsBySymbol . folded . folding (\(_topLevelAnn, _refId, trm, _type) -> UnusedBindings.analyseTerm fileUri trm) let tokenMap = getTokenMap tokens @@ -197,6 +194,7 @@ computeConflictWarningDiagnostics fileUri fileSummary@FileSummary {fileNames} = fileUri newRange DiagnosticSeverity_Information + [] msg mempty pure $ toDiagnostics conflictedTermLocations <> toDiagnostics conflictedTypeLocations @@ -283,7 +281,7 @@ analyseNotes fileUri ppe src notes = do (errMsg, ranges) <- PrintError.renderParseErrors src err let txtMsg = Text.pack $ Pretty.toPlain 80 errMsg range <- ranges - pure $ mkDiagnostic fileUri (uToLspRange range) DiagnosticSeverity_Error txtMsg [] + pure $ mkDiagnostic fileUri (uToLspRange range) DiagnosticSeverity_Error [] txtMsg [] -- TODO: Some parsing errors likely have reasonable code actions pure (diags, []) Result.UnknownSymbol _ loc -> @@ -339,7 +337,7 @@ analyseNotes fileUri ppe src notes = do let msg = Text.pack $ Pretty.toPlain 80 $ PrintError.printNoteWithSource ppe src note in do (range, references) <- ranges - pure $ mkDiagnostic fileUri range DiagnosticSeverity_Error msg references + pure $ mkDiagnostic fileUri range DiagnosticSeverity_Error [] msg references -- Suggest name replacements or qualifications when there's ambiguity nameResolutionCodeActions :: [Diagnostic] -> [Context.Suggestion Symbol Ann] -> [RangedCodeAction] nameResolutionCodeActions diags suggestions = do diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs index 05074f78dc..46d87c6ec1 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -14,6 +14,7 @@ import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Symbol (Symbol (..)) import Unison.Term (Term) +import Unison.Util.Range qualified as Range import Unison.Var qualified as Var analyseTerm :: Lsp.Uri -> Term Symbol Ann -> [Diagnostic] @@ -24,8 +25,10 @@ analyseTerm fileUri tm = (,ann) <$> getRelevantVarName v diagnostics = vars & mapMaybe \(varName, ann) -> do - lspRange <- Cv.annToRange ann - pure $ Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning ("Unused binding " <> varName <> ". Use the binding, or prefix it with an _ to dismiss this warning.") [] + -- Limit the range to the first line of the binding to not be too annoying. + -- Maybe in the future we can get the actual annotation of the variable name. + lspRange <- Cv.uToLspRange . Range.startingLine <$> Cv.annToURange ann + pure $ Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning [Lsp.DiagnosticTag_Unnecessary] ("Unused binding " <> tShow varName <> ". Use the binding, or prefix it with an _ to dismiss this warning.") [] in diagnostics where getRelevantVarName :: Symbol -> Maybe Text diff --git a/unison-cli/tests/Unison/Test/LSP.hs b/unison-cli/tests/Unison/Test/LSP.hs index 5b42467905..880fd6214b 100644 --- a/unison-cli/tests/Unison/Test/LSP.hs +++ b/unison-cli/tests/Unison/Test/LSP.hs @@ -10,6 +10,8 @@ import Data.String.Here.Uninterpolated (here) import Data.Text import Data.Text qualified as Text import EasyTest +import Language.LSP.Protocol.Lens qualified as LSP +import Language.LSP.Protocol.Types qualified as LSP import System.IO.Temp qualified as Temp import Unison.ABT qualified as ABT import Unison.Builtin.Decls (unitRef) @@ -20,6 +22,8 @@ import Unison.Codebase.Init qualified as Codebase.Init import Unison.Codebase.SqliteCodebase qualified as SC import Unison.ConstructorReference (GConstructorReference (..)) import Unison.FileParsers qualified as FileParsers +import Unison.LSP.Conversions qualified as Cv +import Unison.LSP.FileAnalysis.UnusedBindings qualified as UnusedBindings import Unison.LSP.Queries qualified as LSPQ import Unison.Lexer.Pos qualified as Lexer import Unison.Parser.Ann (Ann (..)) @@ -43,6 +47,10 @@ test = do [ refFinding, annotationNesting ] + scope "diagnostics" $ + tests + [ unusedBindingLocations + ] trm :: Term.F Symbol () () (ABT.Term (Term.F Symbol () ()) Symbol ()) -> LSPQ.SourceNode () trm = LSPQ.TermNode . ABT.tm @@ -239,15 +247,39 @@ term = let ) ] --- | Test helper which lets you specify a cursor position inline with source text as a '|'. +-- | Test helper which lets you specify a cursor position inline with source text as a '^'. extractCursor :: Text -> Test (Lexer.Pos, Text) extractCursor txt = - case Text.splitOn "^" txt of + case splitOnDelimiter '^' txt of + Nothing -> crash "expected exactly one cursor" + Just (before, pos, after) -> pure (pos, before <> after) + +-- | Splits a text on a delimiter, returning the text before and after the delimiter, along with the position of the delimiter. +-- +-- >>> splitOnDelimiter '^' "foo b^ar baz" +-- Just ("foo b",Pos {line = 0, column = 5},"ar baz") +splitOnDelimiter :: Char -> Text -> Maybe (Text, Lexer.Pos, Text) +splitOnDelimiter sym txt = + case Text.splitOn (Text.singleton sym) txt of [before, after] -> - let col = Text.length $ Text.takeWhileEnd (/= '\n') before - line = Prelude.length $ Text.lines before - in pure $ (Lexer.Pos line col, before <> after) - _ -> crash "expected exactly one cursor" + let col = (Text.length $ Text.takeWhileEnd (/= '\n') before) + 1 + line = Text.count "\n" before + 1 + in Just $ (before, Lexer.Pos line col, after) + _ -> Nothing + +-- | Test helper which lets you specify a cursor position inline with source text as a '^'. +-- +-- >>> extractDelimitedBlock ('{', '}') "foo {bar} baz" +-- Just (Ann {start = Pos {line = 1, column = 4}, end = Pos {line = 1, column = 7}},"bar","foo bar baz") +-- +-- >>> extractDelimitedBlock ('{', '}') "term =\n {foo} = 12345" +-- Just (Ann {start = Pos {line = 2, column = 2}, end = Pos {line = 2, column = 5}},"foo","term =\n foo = 12345") +extractDelimitedBlock :: (Char, Char) -> Text -> Maybe (Ann {- ann spanning the inside of the delimiters -}, Text {- Text within the delimiters -}, Text {- entire source text with the delimiters stripped -}) +extractDelimitedBlock (startDelim, endDelim) txt = do + (beforeStart, startPos, afterStart) <- splitOnDelimiter startDelim txt + (beforeEnd, endPos, afterEnd) <- splitOnDelimiter endDelim (beforeStart <> afterStart) + let ann = Ann startPos endPos + pure (ann, Text.takeWhile (/= endDelim) afterStart, beforeEnd <> afterEnd) makeNodeSelectionTest :: (String, Text, Bool, LSPQ.SourceNode ()) -> Test () makeNodeSelectionTest (name, testSrc, testTypechecked, expected) = scope name $ do @@ -308,7 +340,7 @@ annotationNestingTest (name, src) = scope name do & traverse_ \(_fileAnn, _refId, _wk, trm, _typ) -> assertAnnotationsAreNested trm --- | Asserts that for all nodes in the provided ABT, the annotations of all child nodes are +-- | Asserts that for all nodes in the provided ABT EXCEPT Abs nodes, the annotations of all child nodes are -- within the span of the parent node. assertAnnotationsAreNested :: forall f. (Foldable f, Functor f, Show (f (Either String Ann))) => ABT.Term f Symbol Ann -> Test () assertAnnotationsAreNested term = do @@ -319,12 +351,19 @@ assertAnnotationsAreNested term = do alg :: Ann -> ABT.ABT f Symbol (Either String Ann) -> Either String Ann alg ann abt = do childSpan <- abt & foldMapM id - case ann `Ann.encompasses` childSpan of - -- one of the annotations isn't in the file, don't bother checking. - Nothing -> pure (ann <> childSpan) - Just isInFile - | isInFile -> pure ann - | otherwise -> Left $ "Containment breach: children aren't contained with the parent:" <> show (ann, abt) + case abt of + -- Abs nodes are the only nodes whose annotations are allowed to not contain their children, + -- they represet the location of the variable being bound instead. Ideally we'd have a separate child + -- node for that, but we can't add it without editing the ABT or Term types. + ABT.Abs _ _ -> + pure (ann <> childSpan) + _ -> do + case ann `Ann.encompasses` childSpan of + -- one of the annotations isn't in the file, don't bother checking. + Nothing -> pure (ann <> childSpan) + Just isInFile + | isInFile -> pure ann + | otherwise -> Left $ "Containment breach: children aren't contained with the parent:" <> show (ann, abt) typecheckSrc :: String -> @@ -374,3 +413,38 @@ withTestCodebase action = do tmpDir <- Temp.createTempDirectory tmp "lsp-test" Codebase.Init.withCreatedCodebase SC.init "lsp-test" tmpDir SC.DontLock action either (crash . show) pure r + +makeDiagnosticRangeTest :: (String, Text) -> Test () +makeDiagnosticRangeTest (testName, testSrc) = scope testName $ do + (ann, _block, cleanSrc) <- case extractDelimitedBlock ('«', '»') testSrc of + Nothing -> crash "expected exactly one delimited block" + Just r -> pure r + (pf, _mayTypecheckedFile) <- typecheckSrc testName cleanSrc + UF.terms pf + & Map.elems + & \case + [(_a, trm)] -> do + case UnusedBindings.analyseTerm (LSP.Uri "test") trm of + [diag] -> do + let expectedRange = Cv.annToRange ann + let actualRange = Just (diag ^. LSP.range) + when (expectedRange /= actualRange) do + crash $ "Expected diagnostic at range: " <> show expectedRange <> ", got: " <> show actualRange + _ -> crash "Expected exactly one diagnostic" + _ -> crash "Expected exactly one term" + +unusedBindingLocations :: Test () +unusedBindingLocations = + scope "unused bindings" . tests . fmap makeDiagnosticRangeTest $ + [ ( "Unused binding in let block", + [here|term = + usedOne = true + «unused = "unused"» + usedTwo = false + usedOne && usedTwo + |] + ), + ( "Unused argument", + [here|term «unused» = 1|] + ) + ] From df0261c8d87d9d206ecdfa953d5aff739f5fc363 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 12 Jul 2024 16:54:12 -0700 Subject: [PATCH 451/631] Keep most recent path and branches through migration to version 17 --- .../U/Codebase/Sqlite/Queries.hs | 1 + .../Migrations/MigrateSchema16To17.hs | 48 ++++++++++++++++++- 2 files changed, 47 insertions(+), 2 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 927021ecec..241d351574 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -289,6 +289,7 @@ module U.Codebase.Sqlite.Queries -- * Types NamespaceText, TextPathSegments, + JsonParseFailure(..), ) where diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs index ce34d51434..0bfb2553a4 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs @@ -4,8 +4,10 @@ module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 (migrateSchema16To17) where import Control.Lens +import Data.Aeson qualified as Aeson import Data.Map qualified as Map import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text import Data.UUID (UUID) import Data.UUID qualified as UUID import U.Codebase.Branch.Type qualified as V2Branch @@ -59,10 +61,23 @@ migrateSchema16To17 conn = withDisabledForeignKeys $ do (_, emptyCausalHashId) <- Codebase.emptyCausalHash (_proj, pb) <- Ops.insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId pure pb + + -- Try to set the recent project branch to what it was, default back to scratch if it doesn't exist or the user is in + -- loose code. + mayRecentProjectBranch <- runMaybeT $ do + (projectId, branchId) <- MaybeT getMostRecentProjectBranchIds + -- Make sure the project-branch still exists. + _projBranch <- MaybeT $ Q.loadProjectBranch projectId branchId + pure (projectId, branchId) + Debug.debugLogM Debug.Migration "Adding current project path table" Q.addCurrentProjectPathTable Debug.debugLogM Debug.Migration "Setting current project path to scratch project" - Q.setCurrentProjectPath scratchMain.projectId scratchMain.branchId [] + + case mayRecentProjectBranch of + Just (projectId, branchId) -> + Q.setCurrentProjectPath projectId branchId [] + Nothing -> Q.setCurrentProjectPath scratchMain.projectId scratchMain.branchId [] Debug.debugLogM Debug.Migration "Done migrating to version 17" Q.setSchemaVersion 17 where @@ -154,7 +169,12 @@ without rowid; [Sqlite.sql| DELETE FROM project_branch_remote_mapping AS pbrp WHERE NOT EXISTS(SELECT 1 FROM new_project_branch npb WHERE npb.project_id = pbrp.local_project_id AND npb.branch_id = pbrp.local_branch_id) |] - Sqlite.execute [Sqlite.sql| DELETE FROM most_recent_branch |] + -- Delete any project branch rows that don't have a matching branch in the current root. + Sqlite.execute + [Sqlite.sql| + DELETE FROM most_recent_branch AS mrb + WHERE NOT EXISTS(SELECT 1 FROM new_project_branch npb WHERE npb.project_id = mrb.project_id AND npb.branch_id = mrb.branch_id) + |] Debug.debugLogM Debug.Migration "Swapping old and new project branch tables" -- Drop the old project_branch table and rename the new one to take its place. @@ -223,3 +243,27 @@ projectsNameSegment = NameSegment.unsafeParseText "__projects" branchesNameSegment :: NameSegment branchesNameSegment = NameSegment.unsafeParseText "branches" + +expectMostRecentNamespace :: Sqlite.Transaction [NameSegment] +expectMostRecentNamespace = + Sqlite.queryOneColCheck + [Sqlite.sql| + SELECT namespace + FROM most_recent_namespace + |] + check + where + check :: Text -> Either Q.JsonParseFailure [NameSegment] + check bytes = + case Aeson.eitherDecodeStrict (Text.encodeUtf8 bytes) of + Left failure -> Left (Q.JsonParseFailure {bytes, failure = Text.pack failure}) + Right namespace -> Right (map NameSegment namespace) + +getMostRecentProjectBranchIds :: Sqlite.Transaction (Maybe (ProjectId, ProjectBranchId)) +getMostRecentProjectBranchIds = do + nameSegments <- expectMostRecentNamespace + case nameSegments of + [proj, UUIDNameSegment projectId, branches, UUIDNameSegment branchId] + | proj == projectsNameSegment && branches == branchesNameSegment -> + pure . Just $ (ProjectId projectId, ProjectBranchId branchId) + _ -> pure Nothing From 0dc7b6d3ab9de8a695074ccf7bb4d2f1440ee029 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 12 Jul 2024 17:00:31 -0700 Subject: [PATCH 452/631] Reset user to project root if they were on a sub-namespace. --- .../Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs index 0bfb2553a4..7771c08291 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema16To17.hs @@ -263,7 +263,7 @@ getMostRecentProjectBranchIds :: Sqlite.Transaction (Maybe (ProjectId, ProjectBr getMostRecentProjectBranchIds = do nameSegments <- expectMostRecentNamespace case nameSegments of - [proj, UUIDNameSegment projectId, branches, UUIDNameSegment branchId] + (proj : UUIDNameSegment projectId : branches : UUIDNameSegment branchId : _) | proj == projectsNameSegment && branches == branchesNameSegment -> pure . Just $ (ProjectId projectId, ProjectBranchId branchId) _ -> pure Nothing From 0c7851d2891d6e7f26846d201ac0519a1983238a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 15 Jul 2024 09:49:57 -0700 Subject: [PATCH 453/631] Don't evaluate the unison file if there are no watch expressions. --- .../Codebase/Editor/HandleInput/Load.hs | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs index f050df2086..ce5e1aa993 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs @@ -40,7 +40,9 @@ import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Term qualified as Term import Unison.UnisonFile (TypecheckedUnisonFile) +import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF +import Unison.Util.Timing qualified as Timing import Unison.WatchKind qualified as WK handleLoad :: Maybe FilePath -> Cli () @@ -65,11 +67,14 @@ loadUnisonFile sourceName text = do pped <- Cli.prettyPrintEnvDeclFromNames names let ppe = PPE.suffixifiedPPE pped Cli.respond $ Output.Typechecked sourceName ppe sr unisonFile - (bindings, e) <- evalUnisonFile Permissive ppe unisonFile [] - let e' = Map.map go e - go (ann, kind, _hash, _uneval, eval, isHit) = (ann, kind, eval, isHit) - when (not (null e')) do - Cli.respond $ Output.Evaluated text ppe bindings e' + + when (not . null $ UF.watchComponents unisonFile) do + Timing.time "evaluating watches" do + (bindings, e) <- evalUnisonFile Permissive ppe unisonFile [] + let e' = Map.map go e + go (ann, kind, _hash, _uneval, eval, isHit) = (ann, kind, eval, isHit) + when (not (null e')) do + Cli.respond $ Output.Evaluated text ppe bindings e' #latestTypecheckedFile .= Just (Right unisonFile) where withFile :: @@ -81,8 +86,8 @@ loadUnisonFile sourceName text = do pp <- Cli.getCurrentProjectPath State.modify' \loopState -> loopState - & #latestFile .~ Just (Text.unpack sourceName, False) - & #latestTypecheckedFile .~ Nothing + & (#latestFile .~ Just (Text.unpack sourceName, False)) + & (#latestTypecheckedFile .~ Nothing) Cli.Env {codebase, generateUniqueName} <- ask uniqueName <- liftIO generateUniqueName let parsingEnv = From 456b8e635a135ac698e90f60c829be31696183c5 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Mon, 15 Jul 2024 18:13:48 +0100 Subject: [PATCH 454/631] fix warning: add missing Functor --- parser-typechecker/src/Unison/Codebase/ProjectPath.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs index 2714c44e4a..651f7f2ca5 100644 --- a/parser-typechecker/src/Unison/Codebase/ProjectPath.hs +++ b/parser-typechecker/src/Unison/Codebase/ProjectPath.hs @@ -44,7 +44,7 @@ data ProjectPathG proj branch = ProjectPath branch :: branch, absPath :: Path.Absolute } - deriving stock (Eq, Ord, Show, Generic) + deriving stock (Eq, Functor, Ord, Show, Generic) type ProjectPathIds = ProjectPathG ProjectId ProjectBranchId From 4e44b94ad63496657300d05a37a784445adb1094 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Mon, 15 Jul 2024 19:10:27 +0100 Subject: [PATCH 455/631] update transcripts --- .../transcripts-using-base/net.output.md | 42 ++++++++++--------- unison-src/transcripts/alias-many.output.md | 14 ++++--- unison-src/transcripts/anf-tests.output.md | 4 +- unison-src/transcripts/fix2350.output.md | 8 +++- unison-src/transcripts/fix2474.output.md | 4 +- unison-src/transcripts/fix2663.output.md | 4 +- unison-src/transcripts/fix2840.output.md | 6 ++- unison-src/transcripts/hello.output.md | 4 +- .../transcripts/input-parse-errors.output.md | 4 +- unison-src/transcripts/names.output.md | 14 ++++--- unison-src/transcripts/view.output.md | 10 +++-- 11 files changed, 69 insertions(+), 45 deletions(-) diff --git a/unison-src/transcripts-using-base/net.output.md b/unison-src/transcripts-using-base/net.output.md index 4d95488cbf..4ffc0528bc 100644 --- a/unison-src/transcripts-using-base/net.output.md +++ b/unison-src/transcripts-using-base/net.output.md @@ -30,26 +30,28 @@ This mapping of names to port numbers is maintained by the [nsswitch service](https://en.wikipedia.org/wiki/Name_Service_Switch), typically stored in `/etc/services` and queried with the `getent` tool: - # map number to name - $ getent services 22 - ssh 22/tcp - - # map name to number - $ getent services finger - finger 79/tcp - - # get a list of all known names - $ getent services | head - tcpmux 1/tcp - echo 7/tcp - echo 7/udp - discard 9/tcp sink null - discard 9/udp sink null - systat 11/tcp users - daytime 13/tcp - daytime 13/udp - netstat 15/tcp - qotd 17/tcp quote +``` +# map number to name +$ getent services 22 +ssh 22/tcp + +# map name to number +$ getent services finger +finger 79/tcp + +# get a list of all known names +$ getent services | head +tcpmux 1/tcp +echo 7/tcp +echo 7/udp +discard 9/tcp sink null +discard 9/udp sink null +systat 11/tcp users +daytime 13/tcp +daytime 13/udp +netstat 15/tcp +qotd 17/tcp quote +``` Below shows different examples of how we might specify the server coordinates. diff --git a/unison-src/transcripts/alias-many.output.md b/unison-src/transcripts/alias-many.output.md index 96b43c63a4..0e2114f88e 100644 --- a/unison-src/transcripts/alias-many.output.md +++ b/unison-src/transcripts/alias-many.output.md @@ -1,12 +1,14 @@ The `alias.many` command can be used to copy definitions from the current namespace into your curated one. The names that will be used in the target namespace are the names you specify, relative to the current namespace: - scratch/main> help alias.many - - alias.many (or copy) - `alias.many [relative2...] ` creates aliases `relative1`, `relative2`, ... - in the namespace `namespace`. - `alias.many foo.foo bar.bar .quux` creates aliases `.quux.foo.foo` and `.quux.bar.bar`. +``` +scratch/main> help alias.many + + alias.many (or copy) + `alias.many [relative2...] ` creates aliases `relative1`, `relative2`, ... + in the namespace `namespace`. + `alias.many foo.foo bar.bar .quux` creates aliases `.quux.foo.foo` and `.quux.bar.bar`. +``` Let's try it\! diff --git a/unison-src/transcripts/anf-tests.output.md b/unison-src/transcripts/anf-tests.output.md index 0a1242dda9..f58ad3bc0d 100644 --- a/unison-src/transcripts/anf-tests.output.md +++ b/unison-src/transcripts/anf-tests.output.md @@ -2,7 +2,9 @@ This tests a variable related bug in the ANF compiler. The nested let would get flattened out, resulting in: - bar = result +``` +bar = result +``` which would be handled by renaming. However, the *context* portion of the rest of the code was not being renamed correctly, so `bar` would diff --git a/unison-src/transcripts/fix2350.output.md b/unison-src/transcripts/fix2350.output.md index 5f6f273c32..cb0cf5de75 100644 --- a/unison-src/transcripts/fix2350.output.md +++ b/unison-src/transcripts/fix2350.output.md @@ -2,7 +2,9 @@ This tests an issue where ability variables were being defaulted over eagerly. In general, we want to avoid collecting up variables from the use of definitions with types like: - T ->{e} U +``` +T ->{e} U +``` Since this type works for every `e`, it is, 'pure;' and we might as well have `e = {}`, since `{}` is a subrow of every other row. @@ -11,7 +13,9 @@ ongoing inference, it's undesirable to default it. Previously there was a check to see if `e` occurred in the context. However, the wanted abilities being collected aren't in the context, so types like: - T ->{S e} U ->{e} V +``` +T ->{S e} U ->{e} V +``` were a corner case. We would add `S e` to the wanted abilities, then not realize that `e` shouldn't be defaulted. diff --git a/unison-src/transcripts/fix2474.output.md b/unison-src/transcripts/fix2474.output.md index d5863ee876..519f0d2b30 100644 --- a/unison-src/transcripts/fix2474.output.md +++ b/unison-src/transcripts/fix2474.output.md @@ -2,7 +2,9 @@ Tests an issue with a lack of generality of handlers. In general, a set of cases: - { e ... -> k } +``` +{ e ... -> k } +``` should be typed in the following way: diff --git a/unison-src/transcripts/fix2663.output.md b/unison-src/transcripts/fix2663.output.md index d1b0575e12..2e12426d9b 100644 --- a/unison-src/transcripts/fix2663.output.md +++ b/unison-src/transcripts/fix2663.output.md @@ -2,7 +2,9 @@ Tests a variable capture problem. After pattern compilation, the match would end up: - T p1 p3 p3 +``` +T p1 p3 p3 +``` and z would end up referring to the first p3 rather than the second. diff --git a/unison-src/transcripts/fix2840.output.md b/unison-src/transcripts/fix2840.output.md index d6e9c3eef0..020c4b1a4d 100644 --- a/unison-src/transcripts/fix2840.output.md +++ b/unison-src/transcripts/fix2840.output.md @@ -33,8 +33,10 @@ scratch/main> display README ``` Previously, the error was: - ⚙️ Processing stanza 5 of 7.ucm: PE [("die",SrcLoc {srcLocPackage = "unison-parser-typechecker-0.0.0-He2Hp1llokT2nN4MnUfUXz", srcLocModule = "Unison.Runtime.Interface", srcLocFile = "src/Unison/Runtime/Interface.hs", srcLocStartLine = 118, srcLocStartCol = 18, srcLocEndLine = 118, srcLocEndCol = 60})] Lit - AnnotatedText (fromList [Segment {segment = "Unknown term reference: #4522d", annotation = Nothing}]) +``` +⚙️ Processing stanza 5 of 7.ucm: PE [("die",SrcLoc {srcLocPackage = "unison-parser-typechecker-0.0.0-He2Hp1llokT2nN4MnUfUXz", srcLocModule = "Unison.Runtime.Interface", srcLocFile = "src/Unison/Runtime/Interface.hs", srcLocStartLine = 118, srcLocStartCol = 18, srcLocEndLine = 118, srcLocEndCol = 60})] Lit + AnnotatedText (fromList [Segment {segment = "Unknown term reference: #4522d", annotation = Nothing}]) +``` but as of this PR, it's okay. diff --git a/unison-src/transcripts/hello.output.md b/unison-src/transcripts/hello.output.md index 720cd6d3ff..b486a40213 100644 --- a/unison-src/transcripts/hello.output.md +++ b/unison-src/transcripts/hello.output.md @@ -4,7 +4,9 @@ This markdown file is also a Unison transcript file. Transcript files are an eas The format is just a regular markdown file with some fenced code blocks that are typechecked and elaborated by `ucm`. For example, you can call this transcript via: - $ ucm transcript hello.md +``` +$ ucm transcript hello.md +``` This runs it on a freshly generated empty codebase. Alternately `ucm transcript.fork --codebase /path/to/code hello.md` runs the transcript on a freshly generated copy of the provided codebase. Do `ucm help` to learn more about usage. diff --git a/unison-src/transcripts/input-parse-errors.output.md b/unison-src/transcripts/input-parse-errors.output.md index f349b8a889..4dc0dc8133 100644 --- a/unison-src/transcripts/input-parse-errors.output.md +++ b/unison-src/transcripts/input-parse-errors.output.md @@ -76,7 +76,9 @@ You can run `help update` for more information on using ``` aliasTerm - scratch/main> alias.term ##Nat.+ Nat.+ +``` +scratch/main> alias.term ##Nat.+ Nat.+ +``` aliasTermForce, aliasType, diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index c9b3389ecd..27b986afb0 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -85,10 +85,12 @@ scratch/main> names .some.place.x TODO: swap this back to a 'ucm' block when names.global is re-implemented - -- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. - scratch/other> names.global x - -- We can search by hash, and see all aliases of that hash in the codebase - scratch/other> names.global #gjmq673r1v - -- We can search using an absolute name - scratch/other> names.global .some.place.x +``` +-- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. +scratch/other> names.global x +-- We can search by hash, and see all aliases of that hash in the codebase +scratch/other> names.global #gjmq673r1v +-- We can search using an absolute name +scratch/other> names.global .some.place.x +``` diff --git a/unison-src/transcripts/view.output.md b/unison-src/transcripts/view.output.md index a4698d9d07..336a8c932e 100644 --- a/unison-src/transcripts/view.output.md +++ b/unison-src/transcripts/view.output.md @@ -24,8 +24,10 @@ scratch/main> view .b.thing ``` TODO: swap this back to a 'ucm' block when view.global is re-implemented - -- view.global should search globally and be absolutely qualified - scratch/other> view.global thing - -- Should support branch relative paths - scratch/other> view /main:a.thing +``` +-- view.global should search globally and be absolutely qualified +scratch/other> view.global thing +-- Should support branch relative paths +scratch/other> view /main:a.thing +``` From ba78b69ed8435ee59ecf1988c6b59deeac86cfa5 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 15 Jul 2024 11:15:54 -0700 Subject: [PATCH 456/631] Better recursive ref search --- .../src/Unison/Runtime/Interface.hs | 76 ++++++++++--------- 1 file changed, 42 insertions(+), 34 deletions(-) diff --git a/parser-typechecker/src/Unison/Runtime/Interface.hs b/parser-typechecker/src/Unison/Runtime/Interface.hs index 3b74b59e88..3ef03e6b5e 100644 --- a/parser-typechecker/src/Unison/Runtime/Interface.hs +++ b/parser-typechecker/src/Unison/Runtime/Interface.hs @@ -23,8 +23,10 @@ where import Control.Concurrent.STM as STM import Control.Exception (throwIO) import Control.Monad -import Data.Binary.Get (runGetOrFail) -- import Data.Bits (shiftL) + +import Control.Monad.State +import Data.Binary.Get (runGetOrFail) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BL import Data.Bytes.Get (MonadGet, getWord8, runGetS) @@ -133,6 +135,7 @@ import Unison.Syntax.NamePrinter (prettyHashQualified) import Unison.Syntax.TermPrinter import Unison.Term qualified as Tm import Unison.Util.EnumContainers as EC +import Unison.Util.Monoid (foldMapM) import Unison.Util.Pretty as P import UnliftIO qualified import UnliftIO.Concurrent qualified as UnliftIO @@ -195,23 +198,26 @@ allocType ctx r cons = pure $ ctx {dspec = Map.insert r cons $ dspec ctx} recursiveDeclDeps :: - Set RF.LabeledDependency -> CodeLookup Symbol IO () -> Decl Symbol () -> -- (type deps, term deps) - IO (Set Reference, Set Reference) -recursiveDeclDeps seen0 cl d = do - rec <- for (toList newDeps) $ \case - RF.DerivedId i -> - getTypeDeclaration cl i >>= \case - Just d -> recursiveDeclDeps seen cl d - Nothing -> pure mempty - _ -> pure mempty - pure $ (deps, mempty) <> fold rec + StateT (Set RF.LabeledDependency) IO (Set Reference, Set Reference) +recursiveDeclDeps cl d = do + seen0 <- get + let seen = seen0 <> Set.map RF.typeRef deps + put seen + let newDeps = Set.filter (\r -> notMember (RF.typeRef r) seen0) deps + rec <- + (toList newDeps) & foldMapM \r -> do + case r of + RF.DerivedId i -> + lift (getTypeDeclaration cl i) >>= \case + Just d -> recursiveDeclDeps cl d + Nothing -> pure mempty + _ -> pure mempty + pure $ (deps, mempty) <> rec where deps = declTypeDependencies d - newDeps = Set.filter (\r -> notMember (RF.typeRef r) seen0) deps - seen = seen0 <> Set.map RF.typeRef deps categorize :: RF.LabeledDependency -> (Set Reference, Set Reference) categorize = @@ -221,37 +227,39 @@ categorize = RF.TermReference ref -> (mempty, Set.singleton ref) recursiveTermDeps :: - Set RF.LabeledDependency -> CodeLookup Symbol IO () -> Term Symbol -> -- (type deps, term deps) - IO (Set Reference, Set Reference) -recursiveTermDeps seen0 cl tm = do - rec <- for (toList (deps \\ seen0)) $ \case - RF.ConReference (RF.ConstructorReference (RF.DerivedId refId) _conId) _conType -> handleTypeReferenceId refId - RF.TypeReference (RF.DerivedId refId) -> handleTypeReferenceId refId - RF.TermReference r -> recursiveRefDeps seen cl r - _ -> pure mempty - pure $ foldMap categorize deps <> fold rec + StateT (Set RF.LabeledDependency) IO (Set Reference, Set Reference) +recursiveTermDeps cl tm = do + seen0 <- get + let seen = seen0 <> deps + put seen + rec <- + (toList (deps \\ seen0)) & foldMapM \r -> + case r of + RF.ConReference (RF.ConstructorReference (RF.DerivedId refId) _conId) _conType -> handleTypeReferenceId refId + RF.TypeReference (RF.DerivedId refId) -> handleTypeReferenceId refId + RF.TermReference r -> recursiveRefDeps cl r + _ -> pure mempty + pure $ foldMap categorize deps <> rec where - handleTypeReferenceId :: RF.Id -> IO (Set Reference, Set Reference) + handleTypeReferenceId :: RF.Id -> StateT (Set RF.LabeledDependency) IO (Set Reference, Set Reference) handleTypeReferenceId refId = - getTypeDeclaration cl refId >>= \case - Just d -> recursiveDeclDeps seen cl d + lift (getTypeDeclaration cl refId) >>= \case + Just d -> recursiveDeclDeps cl d Nothing -> pure mempty deps = Tm.labeledDependencies tm - seen = seen0 <> deps recursiveRefDeps :: - Set RF.LabeledDependency -> CodeLookup Symbol IO () -> Reference -> - IO (Set Reference, Set Reference) -recursiveRefDeps seen cl (RF.DerivedId i) = - getTerm cl i >>= \case - Just tm -> recursiveTermDeps seen cl tm + StateT (Set RF.LabeledDependency) IO (Set Reference, Set Reference) +recursiveRefDeps cl (RF.DerivedId i) = + lift (getTerm cl i) >>= \case + Just tm -> recursiveTermDeps cl tm Nothing -> pure mempty -recursiveRefDeps _ _ _ = pure mempty +recursiveRefDeps _ _ = pure mempty recursiveIRefDeps :: Map.Map Reference (SuperGroup Symbol) -> @@ -289,8 +297,8 @@ collectDeps :: Term Symbol -> IO ([(Reference, Either [Int] [Int])], [Reference]) collectDeps cl tm = do - (tys, tms) <- recursiveTermDeps mempty cl tm - (,toList tms) <$> traverse getDecl (toList tys) + (tys, tms) <- evalStateT (recursiveTermDeps cl tm) mempty + (,toList tms) <$> (traverse getDecl (toList tys)) where getDecl ty@(RF.DerivedId i) = (ty,) . maybe (Right []) declFields From 960f7d10350e9249c03190690b9d25627fcf9342 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 15 Jul 2024 15:34:24 -0600 Subject: [PATCH 457/631] Avoid duplicating YAML info in Markdown MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reviewing the last merge into #5142, I noticed some duplicated and out- of-date information. This brings things up-to-date and slightly reduces the duplication. - bumped Ormolu used by ci.yaml from 0.5.2.0 to 0.7.2.0, to match flake.nix - removed Markdown that claimed ci.yaml was using Ormolu 0.5.0.1 - moved description from `base-codebase` in Markdown to comment on `runtime_tests_codebase` in ci.yaml (and updated it to refer to builtin-tests/interpreter-tests.md instead of builtin-tests/base.md) - removed `unison_src_test_results` as it’s no longer managed as a single variable - moved other comments from Markdown to ci.yaml - added Markdown recommending to look in ci.yaml for specifics - rearranges the order of vars in ci.yaml to match the order they were presented in Markdown One thing I wasn’t sure how to map over: Markdown claims Racket 8.7 is used in CI, but ci.yaml doesn’t mention any Racket version. --- .github/workflows/ci.md | 17 +---------------- .github/workflows/ci.yaml | 17 ++++++++++++----- 2 files changed, 13 insertions(+), 21 deletions(-) diff --git a/.github/workflows/ci.md b/.github/workflows/ci.md index e23874d7ac..f29ae442d4 100644 --- a/.github/workflows/ci.md +++ b/.github/workflows/ci.md @@ -6,23 +6,8 @@ At a high level, the CI process is: 3. On all platforms, build the `unison-runtime` Racket program save the resulting binaries as build artifacts. ### `env` vars at the top of `CI.yaml`: -Some version numbers that are used during CI: -- `ormolu_version: "0.5.0.1"` -- `racket_version: "8.7"` -- `jit_version: "@unison/internal/releases/0.0.18"` - -Some cached directories: - - `ucm_local_bin` a temp path for caching a built `ucm` - - `jit_src_scheme` a temp path for caching generated jit sources - - `unison-jit-dist` - - `base-codebase` a codebase path for caching a codebase generated by `unison-src/builtin-tests/base.md` - - `unison_src_test_results` a temp path for caching the result of passing tests that depend on `unison-src/`, which includes: - - `round-trip-tests` - - `transcripts` - - `unison-src/builtin-tests/interpreter-tests.md` -`jit_generator_os: ubuntu-20.04` - - afaik, the jit sources are generated in a platform-independent way, so we just choose one platform to generate them on. +These variables pin some dependency versions, set up some directories to cache, etc. Please see the `env` section in [ci.yaml](./ci.yaml) for specifics. ### Cached directories: diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 55e88ddbaf..a9bf5c83e6 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -12,19 +12,26 @@ on: workflow_dispatch: env: - ormolu_version: 0.5.2.0 - ucm_local_bin: ucm-local-bin + ## Some version numbers that are used during CI + ormolu_version: 0.7.2.0 jit_version: "@unison/internal/releases/0.0.18" + runtime_tests_version: "@unison/runtime-tests/main" + + ## Some cached directories + # a temp path for caching a built `ucm` + ucm_local_bin: ucm-local-bin + # a temp path for caching generated jit sources jit_src_scheme: unison-jit-src/scheme-libs/racket jit_dist: unison-jit-dist - jit_generator_os: ubuntu-20.04 - runtime_tests_version: "@unison/runtime-tests/main" + # a codebase path for caching a codebase generated by `unison-src/builtin-tests/interpreter-tests.md` runtime_tests_codebase: "~/.cache/unisonlanguage/runtime-tests.unison" - # locations of some files that will indicate whether we need to re-run certain steps transcript_test_results: transcript-test-results interpreter_test_results: interpreter-test-results + ## afaik, the jit sources are generated in a platform-independent way, so we choose one platform to generate them on. + jit_generator_os: ubuntu-20.04 + jobs: ormolu: runs-on: ubuntu-20.04 From f919c9b8c5c8c67ea7515222b0c8c076b5d3a85f Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 15 Jul 2024 16:45:28 -0600 Subject: [PATCH 458/631] =?UTF-8?q?Don=E2=80=99t=20let=20Stack=20tell=20co?= =?UTF-8?q?ntributors=20to=20upgrade?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit We use a specific version of Stack, we don’t want Stack complaining to contributors that it doesn’t happen to be the latest. --- stack.yaml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/stack.yaml b/stack.yaml index 19668b74ca..739ced9306 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,6 @@ +## We pin a specific Stack version when possible. We shouldn’t then tell contributors to upgrade from there. +recommend-stack-upgrade: false + flags: haskeline: terminfo: false From 605e062bcfc3118ee83ca35c7d86a4036adea22f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 15 Jul 2024 15:55:59 -0700 Subject: [PATCH 459/631] Remove now-unused sync types --- unison-share-api/src/Unison/Sync/Types.hs | 89 ----------------------- 1 file changed, 89 deletions(-) diff --git a/unison-share-api/src/Unison/Sync/Types.hs b/unison-share-api/src/Unison/Sync/Types.hs index 9b84c00601..35d7030cc8 100644 --- a/unison-share-api/src/Unison/Sync/Types.hs +++ b/unison-share-api/src/Unison/Sync/Types.hs @@ -48,12 +48,6 @@ module Unison.Sync.Types UploadEntitiesResponse (..), UploadEntitiesError (..), - -- ** Update path - UpdatePathRequest (..), - UpdatePathResponse (..), - UpdatePathError (..), - HashMismatch (..), - -- * Common/shared error types HashMismatchForEntity (..), InvalidParentage (..), @@ -756,89 +750,6 @@ instance FromJSON InvalidParentage where parseJSON = Aeson.withObject "InvalidParentage" \o -> InvalidParentage <$> o .: "parent" <*> o .: "child" ------------------------------------------------------------------------------------------------------------------------- --- Update path - -data UpdatePathRequest = UpdatePathRequest - { path :: Path, - expectedHash :: Maybe Hash32, -- Nothing requires empty history at destination - newHash :: Hash32 - } - deriving stock (Show, Eq, Ord) - -instance ToJSON UpdatePathRequest where - toJSON (UpdatePathRequest path expectedHash newHash) = - object - [ "path" .= path, - "expected_hash" .= expectedHash, - "new_hash" .= newHash - ] - -instance FromJSON UpdatePathRequest where - parseJSON = Aeson.withObject "UpdatePathRequest" \obj -> do - path <- obj .: "path" - expectedHash <- obj .: "expected_hash" - newHash <- obj .: "new_hash" - pure UpdatePathRequest {..} - -data UpdatePathResponse - = UpdatePathSuccess - | UpdatePathFailure UpdatePathError - deriving stock (Show, Eq, Ord) - -data UpdatePathError - = UpdatePathError'HashMismatch HashMismatch - | UpdatePathError'InvalidRepoInfo Text RepoInfo -- err msg, repo info - | UpdatePathError'MissingDependencies (NeedDependencies Hash32) - | UpdatePathError'NoWritePermission Path - | UpdatePathError'UserNotFound - deriving stock (Show, Eq, Ord) - -instance ToJSON UpdatePathResponse where - toJSON = \case - UpdatePathSuccess -> jsonUnion "success" (Object mempty) - UpdatePathFailure (UpdatePathError'HashMismatch hm) -> jsonUnion "hash_mismatch" hm - UpdatePathFailure (UpdatePathError'MissingDependencies md) -> jsonUnion "missing_dependencies" md - UpdatePathFailure (UpdatePathError'NoWritePermission path) -> jsonUnion "no_write_permission" path - UpdatePathFailure (UpdatePathError'InvalidRepoInfo errMsg repoInfo) -> jsonUnion "invalid_repo_info" (errMsg, repoInfo) - UpdatePathFailure UpdatePathError'UserNotFound -> jsonUnion "user_not_found" (Object mempty) - -instance FromJSON UpdatePathResponse where - parseJSON v = - v & Aeson.withObject "UpdatePathResponse" \obj -> - obj .: "type" >>= Aeson.withText "type" \case - "success" -> pure UpdatePathSuccess - "hash_mismatch" -> UpdatePathFailure . UpdatePathError'HashMismatch <$> obj .: "payload" - "missing_dependencies" -> UpdatePathFailure . UpdatePathError'MissingDependencies <$> obj .: "payload" - "no_write_permission" -> UpdatePathFailure . UpdatePathError'NoWritePermission <$> obj .: "payload" - "invalid_repo_info" -> do - (errMsg, repoInfo) <- obj .: "payload" - pure (UpdatePathFailure (UpdatePathError'InvalidRepoInfo errMsg repoInfo)) - "user_not_found" -> pure (UpdatePathFailure UpdatePathError'UserNotFound) - t -> failText $ "Unexpected UpdatePathResponse type: " <> t - -data HashMismatch = HashMismatch - { path :: Path, - expectedHash :: Maybe Hash32, - actualHash :: Maybe Hash32 - } - deriving stock (Show, Eq, Ord) - -instance ToJSON HashMismatch where - toJSON (HashMismatch path expectedHash actualHash) = - object - [ "path" .= path, - "expected_hash" .= expectedHash, - "actual_hash" .= actualHash - ] - -instance FromJSON HashMismatch where - parseJSON = Aeson.withObject "HashMismatch" \obj -> do - path <- obj .: "path" - expectedHash <- obj .: "expected_hash" - actualHash <- obj .: "actual_hash" - pure HashMismatch {..} - ------------------------------------------------------------------------------------------------------------------------ -- Common/shared error types From e10801453e3127121c9efb7a8fdd12b2bd0f24dd Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 15 Jul 2024 16:56:17 -0600 Subject: [PATCH 460/631] =?UTF-8?q?Don=E2=80=99t=20let=20Stack=20complain?= =?UTF-8?q?=20about=20Nix?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit We intentionally disable Stack’s Nix integration when it’s run from a Nix shell. We don’t want Stack complaining that we should enable it since it found `nix` on the path. --- stack.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/stack.yaml b/stack.yaml index 739ced9306..19bccd7774 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,5 @@ +## We intentionally disable Nix integration when running in a Nix shell. +notify-if-nix-on-path: false ## We pin a specific Stack version when possible. We shouldn’t then tell contributors to upgrade from there. recommend-stack-upgrade: false From a4064319b0ced90c5dc31be5e54c9b83d9db83b1 Mon Sep 17 00:00:00 2001 From: mitchellwrosen Date: Tue, 16 Jul 2024 16:08:59 +0000 Subject: [PATCH 461/631] automatically run ormolu --- unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs b/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs index 6326006c7a..406a8eae2f 100644 --- a/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs +++ b/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs @@ -48,7 +48,7 @@ toText = -- | A hash-qualified parser. hashQualifiedP :: - Monad m => + (Monad m) => ParsecT (Token Text) [Char] m name -> ParsecT (Token Text) [Char] m (HQ'.HashQualified name) hashQualifiedP nameP = From f17af1f5ca9b6129f97ded80224714b241ad78e1 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 16 Jul 2024 11:24:24 -0600 Subject: [PATCH 462/631] Document Nix cache configuration --- development.markdown | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/development.markdown b/development.markdown index 962a507c63..f16c52344e 100644 --- a/development.markdown +++ b/development.markdown @@ -113,6 +113,28 @@ Stack doesn't work deterministically in Windows due to mismatched expectations a ## Building with Nix +__NB__: It is important that the Unison Nix cache is trusted when building, otherwise you will likely end up building hundreds of packages, including GHC itself. + +The recommended way to do this is to add the public key and URL for the cache to your system’s Nix configuration. /etc/nix/nix.conf should have lines similar to +```conf +trusted-public-keys = unison.cachix.org-1:i1DUFkisRPVOyLp/vblDsbsObmyCviq/zs6eRuzth3k= +trusted-substituters = https://unison.cachix.org +``` +these lines could be prefixed with `extra-` and they may have additional entries besides the ones for our cache. + +This command should work if you don’t want to edit the file manually: +```shell +sudo sh -c 'echo "extra-trusted-public-keys = unison.cachix.org-1:i1DUFkisRPVOyLp/vblDsbsObmyCviq/zs6eRuzth3k= +extra-trusted-substituters = https://unison.cachix.org" >>/etc/nix/nix.conf' +``` +If you use NixOS, you may instead add this via your configuration.nix with +```nix +nix.settings.trusted-public-keys = ["unison.cachix.org-1:i1DUFkisRPVOyLp/vblDsbsObmyCviq/zs6eRuzth3k="]; +nix.settings.trusted-substituters = ["https://unison.cachix.org"]; +``` + +It is _not_ recommended to add your user to `trusted-users`. This _can_ make enabling flake configurations simpler (like the Unison Nix cache here), but [it is equivalent to giving that user root access (without need for sudo)](https://nix.dev/manual/nix/2.23/command-ref/conf-file.html#conf-trusted-users). + ## Building package components with nix ### Build the unison executable From ce9b1d8d4e99c6535c160981d525c9661c845fa5 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 16 Jul 2024 11:51:49 -0600 Subject: [PATCH 463/631] Add docs for updating the Nix config after editing it --- development.markdown | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/development.markdown b/development.markdown index f16c52344e..a8cfee7bdf 100644 --- a/development.markdown +++ b/development.markdown @@ -127,11 +127,20 @@ This command should work if you don’t want to edit the file manually: sudo sh -c 'echo "extra-trusted-public-keys = unison.cachix.org-1:i1DUFkisRPVOyLp/vblDsbsObmyCviq/zs6eRuzth3k= extra-trusted-substituters = https://unison.cachix.org" >>/etc/nix/nix.conf' ``` +After updating /etc/nix/nix.conf, you need to restart the Nix daemon. To do this on +- Ubuntu: `sudo systemctl restart nix-daemon` +- MacOS: + ```shell + sudo launchctl unload /Library/LaunchDaemons/org.nixos.nix-daemon.plist + sudo launchctl load /Library/LaunchDaemons/org.nixos.nix-daemon.plist + ``` + If you use NixOS, you may instead add this via your configuration.nix with ```nix nix.settings.trusted-public-keys = ["unison.cachix.org-1:i1DUFkisRPVOyLp/vblDsbsObmyCviq/zs6eRuzth3k="]; nix.settings.trusted-substituters = ["https://unison.cachix.org"]; ``` +and run `sudo nixos-rebuild switch` afterward. It is _not_ recommended to add your user to `trusted-users`. This _can_ make enabling flake configurations simpler (like the Unison Nix cache here), but [it is equivalent to giving that user root access (without need for sudo)](https://nix.dev/manual/nix/2.23/command-ref/conf-file.html#conf-trusted-users). From 734b6c44f6f93209adbdae0ec0edc948496d2198 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 16 Jul 2024 12:23:10 -0600 Subject: [PATCH 464/631] Minor formatting cleanup So my editor stops fixing things for me. --- development.markdown | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/development.markdown b/development.markdown index a8cfee7bdf..afb70842ca 100644 --- a/development.markdown +++ b/development.markdown @@ -22,7 +22,7 @@ We use 0.5.0.1 of Ormolu and CI will add an extra commit, if needed, to autoform Also note that you can always wrap a comment around some code you don't want Ormolu to touch, using: -``` +```haskell {- ORMOLU_DISABLE -} dontFormatMe = do blah blah @@ -96,11 +96,13 @@ This codebase uses symlinks as a workaround for some inconveniences in the `here First you'll need to enable "Developer Mode" in your Windows settings. - See https://consumer.huawei.com/en/support/content/en-us15594140/ +> See https://consumer.huawei.com/en/support/content/en-us15594140/ Then you'll need to enable symlink support in your `git` configuration, e.g. - `git config core.symlinks true` +```shell +git config core.symlinks true +``` And then ask `git` to fix up your symlinks with `git checkout .` @@ -147,7 +149,7 @@ It is _not_ recommended to add your user to `trusted-users`. This _can_ make ena ## Building package components with nix ### Build the unison executable -``` +```shell nix build ``` @@ -156,7 +158,7 @@ This is specified with the normal `::` triple. Some examples: -``` +```shell nix build '.#component-unison-cli:lib:unison-cli' nix build '.#component-unison-syntax:test:syntax-tests' nix build '.#component-unison-cli:exe:transcripts' @@ -174,7 +176,7 @@ include: - ormolu - haskell-language-server -``` +```shell nix develop ``` @@ -184,7 +186,7 @@ versions of the compiler and other development tools. Additionally, all non-local haskell dependencies (including profiling dependencies) are provided in the nix shell. -``` +```shell nix develop '.#cabal-local' ``` @@ -194,17 +196,17 @@ versions of the compiler and other development tools. Additionally, all haskell dependencies of this package are provided by the nix shell (including profiling dependencies). -``` +```shell nix develop '.#cabal-' ``` for example: -``` +```shell nix develop '.#cabal-unison-cli' ``` or -``` +```shell nix develop '.#cabal-unison-parser-typechecker' ``` @@ -213,7 +215,7 @@ want to profile `unison-cli-main:exe:unison` then you could get into one of thes shells, cd into its directory, then run the program with profiling. -``` +```shell nix develop '.#cabal-unison-parser-typechecker' cd unison-cli cabal run --enable-profiling unison-cli-main:exe:unison -- +RTS -p From 00f6c8c95458b459981a52c0775283fb17566b7f Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 11 Jul 2024 16:55:56 -0600 Subject: [PATCH 465/631] Refactoring TranscriptParser MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A bunch of small changes in TranscriptParser - remove dead code - don’t use `Show` for formatted output - put processed blocks in a separate sum type from unprocessed blocks - remove `Transcript` from identifiers (changed importers to use `qualified as Transcript`) - deduplicated some error reporting And one happy fix, IMO – got rid of the `Text.init` that plagued me in --- .../src/Unison/Codebase/TranscriptParser.hs | 304 +++++++----------- unison-cli/src/Unison/Main.hs | 93 +++--- unison-cli/tests/Unison/Test/Ucm.hs | 23 +- unison-cli/transcripts/Transcripts.hs | 11 +- .../transcripts/error-messages.output.md | 6 +- .../generic-parse-errors.output.md | 6 +- 6 files changed, 194 insertions(+), 249 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/TranscriptParser.hs index ab433d96fc..c413ff56e7 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/unison-cli/src/Unison/Codebase/TranscriptParser.hs @@ -3,18 +3,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} -{- Parse and execute markdown transcripts. --} +-- | Parse and execute CommonMark (like Github-flavored Markdown) transcripts. module Unison.Codebase.TranscriptParser - ( Stanza (..), - FenceType, - ExpectingError, - Hidden, - TranscriptError (..), - UcmLine (..), - withTranscriptRunner, - parse, - parseFile, + ( Error (..), + Runner, + withRunner, ) where @@ -35,7 +28,6 @@ import Data.Text qualified as Text import Data.These (These (..)) import Data.UUID.V4 qualified as UUID import Network.HTTP.Client qualified as HTTP -import System.Directory (doesFileExist) import System.Environment (lookupEnv) import System.Exit (die) import System.IO qualified as IO @@ -98,8 +90,6 @@ type ExpectingError = Bool type ScratchFileName = Text -type FenceType = Text - data Hidden = Shown | HideOutput | HideAll deriving (Eq, Show) @@ -115,78 +105,54 @@ data APIRequest = GetRequest Text | APIComment Text -instance Show APIRequest where - show (GetRequest txt) = "GET " <> Text.unpack txt - show (APIComment txt) = "-- " <> Text.unpack txt +formatAPIRequest :: APIRequest -> Text +formatAPIRequest = \case + GetRequest txt -> "GET " <> txt + APIComment txt -> "-- " <> txt pattern CMarkCodeBlock :: (Maybe CMark.PosInfo) -> Text -> Text -> CMark.Node pattern CMarkCodeBlock pos info body = CMark.Node pos (CMark.CODE_BLOCK info body) [] -data Stanza +type Stanza = Either CMark.Node ProcessedBlock + +data ProcessedBlock = Ucm Hidden ExpectingError [UcmLine] | Unison Hidden ExpectingError (Maybe ScratchFileName) Text | API [APIRequest] - | UnprocessedBlock CMark.Node - -instance Show UcmLine where - show = \case - UcmCommand context txt -> showContext context <> "> " <> Text.unpack txt - UcmComment txt -> "--" ++ Text.unpack txt - where - showContext (UcmContextProject projectAndBranch) = Text.unpack (into @Text projectAndBranch) - -instance Show Stanza where - show s = (<> "\n") . Text.unpack . CMark.nodeToCommonmark [] Nothing $ stanzaToNode s - -stanzaToNode :: Stanza -> CMark.Node -stanzaToNode = - \case - Ucm _ _ cmds -> - CMarkCodeBlock Nothing "ucm" . Text.pack $ - foldl (\x y -> x ++ show y) "" cmds - Unison _hide _ fname txt -> - CMarkCodeBlock Nothing "unison" . Text.pack $ - unlines - [ case fname of - Nothing -> Text.unpack txt - Just fname -> - unlines - [ "---", - "title: " <> Text.unpack fname, - "---", - Text.unpack txt - ] - ] - API apiRequests -> - CMarkCodeBlock Nothing "api" . Text.pack $ - ( apiRequests - & fmap show - & unlines - ) - UnprocessedBlock node -> node - -parseFile :: FilePath -> IO (Either TranscriptError [Stanza]) -parseFile filePath = do - exists <- doesFileExist filePath - if exists - then do - txt <- readUtf8 filePath - pure $ parse filePath txt - else pure . Left . TranscriptParseError . Text.pack $ filePath <> " does not exist" - -parse :: String -> Text -> Either TranscriptError [Stanza] -parse srcName txt = case stanzas srcName txt of - Right a -> Right a - Left e -> Left . TranscriptParseError . Text.pack . P.errorBundlePretty $ e - -type TranscriptRunner = - ( String -> - Text -> - (FilePath, Codebase IO Symbol Ann) -> - IO (Either TranscriptError Text) - ) -withTranscriptRunner :: +formatUcmLine :: UcmLine -> Text +formatUcmLine = \case + UcmCommand context txt -> formatContext context <> "> " <> txt + UcmComment txt -> "--" <> txt + where + formatContext (UcmContextProject projectAndBranch) = into @Text projectAndBranch + +formatStanza :: Stanza -> Text +formatStanza = either formatNode formatProcessedBlock + +formatNode :: CMark.Node -> Text +formatNode = (<> "\n") . CMark.nodeToCommonmark [] Nothing + +formatProcessedBlock :: ProcessedBlock -> Text +formatProcessedBlock = formatNode . processedBlockToNode + +processedBlockToNode :: ProcessedBlock -> CMark.Node +processedBlockToNode = \case + Ucm _ _ cmds -> CMarkCodeBlock Nothing "ucm" $ foldr ((<>) . formatUcmLine) "" cmds + Unison _hide _ fname txt -> + CMarkCodeBlock Nothing "unison" $ maybe txt (\fname -> Text.unlines ["---", "title: " <> fname, "---", txt]) fname + API apiRequests -> CMarkCodeBlock Nothing "api" $ Text.unlines $ formatAPIRequest <$> apiRequests + +parse :: FilePath -> Text -> Either Error [Stanza] +parse srcName = first ParseError . stanzas srcName + +type Runner = + String -> + Text -> + (FilePath, Codebase IO Symbol Ann) -> + IO (Either Error Text) + +withRunner :: forall m r. (UnliftIO.MonadUnliftIO m) => Bool {- Whether to treat this transcript run as a transcript test, which will try to make output deterministic -} -> @@ -194,16 +160,16 @@ withTranscriptRunner :: UCMVersion -> FilePath -> Maybe FilePath -> - (TranscriptRunner -> m r) -> + (Runner -> m r) -> m r -withTranscriptRunner isTest verbosity ucmVersion nrtp configFile action = do +withRunner isTest verbosity ucmVersion nrtp configFile action = do withRuntimes nrtp \runtime sbRuntime nRuntime -> withConfig \config -> do action \transcriptName transcriptSrc (codebaseDir, codebase) -> do Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) Server.defaultCodebaseServerOpts runtime codebase \baseUrl -> do let parsed = parse transcriptName transcriptSrc result <- for parsed \stanzas -> do liftIO $ run isTest verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime config ucmVersion (tShow baseUrl) - pure $ join @(Either TranscriptError) result + pure $ join @(Either Error) result where withRuntimes :: FilePath -> (Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> m a) -> m a @@ -238,7 +204,7 @@ run :: Maybe Config -> UCMVersion -> Text -> - IO (Either TranscriptError Text) + IO (Either Error Text) run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion baseURL = UnliftIO.try do httpManager <- HTTP.newManager HTTP.defaultManagerSettings (initialPP, emptyCausalHashId) <- Codebase.runTransaction codebase do @@ -299,7 +265,7 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV apiRequest :: APIRequest -> IO () apiRequest req = do - output (show req <> "\n") + output . Text.unpack $ formatAPIRequest req <> "\n" case req of APIComment {} -> pure () GetRequest path -> do @@ -327,13 +293,13 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV for (reverse scratchFileUpdates) \(fp, contents) -> do let fenceDescription = "unison:added-by-ucm " <> fp -- Output blocks for any scratch file updates the ucm block triggered. - Q.undequeue inputQueue (UnprocessedBlock $ CMarkCodeBlock Nothing fenceDescription contents, Nothing) + Q.undequeue inputQueue (Left $ CMarkCodeBlock Nothing fenceDescription contents, Nothing) awaitInput -- ucm command to run Just (Just ucmLine) -> do case ucmLine of p@(UcmComment {}) -> do - liftIO (output ("\n" <> show p)) + liftIO . output . Text.unpack $ "\n" <> formatUcmLine p awaitInput p@(UcmCommand context lineTxt) -> do curPath <- Cli.getCurrentProjectPath @@ -371,7 +337,7 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV case words . Text.unpack $ lineTxt of [] -> awaitInput args -> do - liftIO (output ("\n" <> show p <> "\n")) + liftIO . output . Text.unpack $ "\n" <> formatUcmLine p <> "\n" numberedArgs <- use #numberedArgs PP.ProjectAndBranch projId branchId <- PP.toProjectAndBranch . NonEmpty.head <$> use #projectPathStack let getProjectRoot = liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId @@ -407,35 +373,39 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV ++ show (length stanzas) ++ "." IO.hFlush IO.stdout - case s of - UnprocessedBlock _ -> do - liftIO (output $ show s) - awaitInput - Unison hide errOk filename txt -> do - liftIO (writeIORef hidden hide) - liftIO (outputEcho $ show s) - liftIO (writeIORef allowErrors errOk) - -- Open a ucm block which will contain the output from UCM - -- after processing the UnisonFileChanged event. - liftIO (output "``` ucm\n") - -- Close the ucm block after processing the UnisonFileChanged event. - atomically . Q.enqueue cmdQueue $ Nothing - let sourceName = fromMaybe "scratch.u" filename - liftIO $ updateVirtualFile sourceName txt - pure $ Left (UnisonFileChanged sourceName txt) - API apiRequests -> do - liftIO (output "``` api\n") - liftIO (for_ apiRequests apiRequest) - liftIO (output "```\n\n") - awaitInput - Ucm hide errOk cmds -> do - liftIO (writeIORef hidden hide) - liftIO (writeIORef allowErrors errOk) - liftIO (writeIORef hasErrors False) - liftIO (output "``` ucm") - traverse_ (atomically . Q.enqueue cmdQueue . Just) cmds - atomically . Q.enqueue cmdQueue $ Nothing - awaitInput + either + ( \node -> do + liftIO . output . Text.unpack $ formatNode node + awaitInput + ) + ( \block -> case block of + Unison hide errOk filename txt -> do + liftIO (writeIORef hidden hide) + liftIO . outputEcho . Text.unpack $ formatProcessedBlock block + liftIO (writeIORef allowErrors errOk) + -- Open a ucm block which will contain the output from UCM + -- after processing the UnisonFileChanged event. + liftIO (output "``` ucm\n") + -- Close the ucm block after processing the UnisonFileChanged event. + atomically . Q.enqueue cmdQueue $ Nothing + let sourceName = fromMaybe "scratch.u" filename + liftIO $ updateVirtualFile sourceName txt + pure $ Left (UnisonFileChanged sourceName txt) + API apiRequests -> do + liftIO (output "``` api\n") + liftIO (for_ apiRequests apiRequest) + liftIO (output "```\n\n") + awaitInput + Ucm hide errOk cmds -> do + liftIO (writeIORef hidden hide) + liftIO (writeIORef allowErrors errOk) + liftIO (writeIORef hasErrors False) + liftIO (output "``` ucm") + traverse_ (atomically . Q.enqueue cmdQueue . Just) cmds + atomically . Q.enqueue cmdQueue $ Nothing + awaitInput + ) + s loadPreviousUnisonBlock name = do ufs <- readIORef unisonFiles @@ -492,7 +462,7 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV appendFailingStanza = do stanzaOpt <- readIORef mStanza currentOut <- readIORef out - let stnz = maybe "" show (fmap fst stanzaOpt :: Maybe Stanza) + let stnz = maybe "" (Text.unpack . formatStanza . fst) stanzaOpt unless (stnz `isSubsequenceOf` concat currentOut) $ modifyIORef' out (\acc -> acc <> pure stnz) @@ -502,13 +472,7 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV output "\n```\n\n" appendFailingStanza transcriptFailure out $ - Text.unlines - [ "\128721", - "", - "The transcript failed due to an error in the stanza above. The error is:", - "", - Text.pack msg - ] + "The transcript failed due to an error in the stanza above. The error is:\n\n" <> Text.pack msg dieUnexpectedSuccess :: IO () dieUnexpectedSuccess = do @@ -517,12 +481,7 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV when (errOk && not hasErr) $ do output "\n```\n\n" appendFailingStanza - transcriptFailure out $ - Text.unlines - [ "\128721", - "", - "The transcript was expecting an error in the stanza above, but did not encounter one." - ] + transcriptFailure out "The transcript was expecting an error in the stanza above, but did not encounter one." authenticatedHTTPClient <- AuthN.newAuthenticatedHTTPClient tokenProvider ucmVersion @@ -571,20 +530,17 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV transcriptFailure :: IORef (Seq String) -> Text -> IO b transcriptFailure out msg = do texts <- readIORef out - UnliftIO.throwIO - . TranscriptRunFailure - $ Text.concat (Text.pack <$> toList texts) - <> "\n\n" - <> msg + UnliftIO.throwIO . RunFailure $ mconcat (Text.pack <$> toList texts) <> "\n\n\128721\n\n" <> msg <> "\n" type P = P.Parsec Void Text -stanzas :: String -> Text -> Either (P.ParseErrorBundle Text Void) [Stanza] -stanzas srcName = (\(CMark.Node _ _DOCUMENT blocks) -> traverse stanzaFromBlock blocks) . CMark.commonmarkToNode [] +stanzas :: FilePath -> Text -> Either (P.ParseErrorBundle Text Void) [Stanza] +stanzas srcName = (\(CMark.Node _ _DOCUMENT blocks) -> traverse stanzaFromNode blocks) . CMark.commonmarkToNode [] where - stanzaFromBlock block = case block of - CMarkCodeBlock _ info body -> fromMaybe (UnprocessedBlock block) <$> P.parse (fenced info) srcName body - _ -> pure $ UnprocessedBlock block + stanzaFromNode :: CMark.Node -> Either (P.ParseErrorBundle Text Void) Stanza + stanzaFromNode node = case node of + CMarkCodeBlock _ info body -> maybe (Left node) pure <$> P.parse (fenced info) srcName body + _ -> pure $ Left node ucmLine :: P UcmLine ucmLine = ucmCommand <|> ucmComment @@ -626,39 +582,32 @@ apiRequest = do pure (APIComment comment) -- | Produce the correct parser for the code block based on the provided info string. -fenced :: Text -> P (Maybe Stanza) +fenced :: Text -> P (Maybe ProcessedBlock) fenced info = do body <- P.getInput P.setInput info fenceType <- lineToken (word "ucm" <|> word "unison" <|> word "api" <|> language) - stanza <- - case fenceType of - "ucm" -> do - hide <- hidden - err <- expectingError + case fenceType of + "ucm" -> do + hide <- hidden + err <- expectingError + P.setInput body + pure . Ucm hide err <$> (spaces *> many ucmLine) + "unison" -> + do + -- todo: this has to be more interesting + -- ```unison:hide + -- ```unison + -- ```unison:hide:all scratch.u + hide <- lineToken hidden + err <- lineToken expectingError + fileName <- optional untilSpace1 P.setInput body - _ <- spaces - cmds <- many ucmLine - pure . pure $ Ucm hide err cmds - "unison" -> - do - -- todo: this has to be more interesting - -- ```unison:hide - -- ```unison - -- ```unison:hide:all scratch.u - hide <- lineToken hidden - err <- lineToken expectingError - fileName <- optional untilSpace1 - P.setInput body - blob <- spaces *> (Text.init <$> P.getInput) - pure . pure $ Unison hide err fileName blob - "api" -> do - P.setInput body - _ <- spaces - apiRequests <- many apiRequest - pure . pure $ API apiRequests - _ -> pure Nothing - pure stanza + pure . Unison hide err fileName <$> (spaces *> P.getInput) + "api" -> do + P.setInput body + pure . API <$> (spaces *> many apiRequest) + _ -> pure Nothing word' :: Text -> P Text word' txt = P.try $ do @@ -669,9 +618,6 @@ word' txt = P.try $ do word :: Text -> P Text word = word' --- token :: P a -> P a --- token p = p <* spaces - lineToken :: P a -> P a lineToken p = p <* nonNewlineSpaces @@ -679,11 +625,10 @@ nonNewlineSpaces :: P () nonNewlineSpaces = void $ P.takeWhileP Nothing (\ch -> ch == ' ' || ch == '\t') hidden :: P Hidden -hidden = (\case Just x -> x; Nothing -> Shown) <$> optional go - where - go = - ((\_ -> HideAll) <$> (word ":hide:all")) - <|> ((\_ -> HideOutput) <$> (word ":hide")) +hidden = + (HideAll <$ word ":hide:all") + <|> (HideOutput <$ word ":hide") + <|> pure Shown expectingError :: P ExpectingError expectingError = isJust <$> optional (word ":error") @@ -697,11 +642,8 @@ language = P.takeWhileP Nothing (\ch -> Char.isDigit ch || Char.isLower ch || ch spaces :: P () spaces = void $ P.takeWhileP (Just "spaces") Char.isSpace --- single :: Char -> P Char --- single t = P.satisfy (== t) - -data TranscriptError - = TranscriptRunFailure Text - | TranscriptParseError Text +data Error + = ParseError (P.ParseErrorBundle Text Void) + | RunFailure Text deriving stock (Show) deriving anyclass (Exception) diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index ca74688fd6..1459a516a8 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -60,6 +60,7 @@ import System.IO.CodePage (withCP65001) import System.IO.Error (catchIOError) import System.IO.Temp qualified as Temp import System.Path qualified as Path +import Text.Megaparsec qualified as MP import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase (Codebase, CodebasePath) @@ -73,7 +74,7 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Rt import Unison.Codebase.SqliteCodebase qualified as SC -import Unison.Codebase.TranscriptParser qualified as TR +import Unison.Codebase.TranscriptParser qualified as Transcript import Unison.Codebase.Verbosity qualified as Verbosity import Unison.CommandLine (watchConfig) import Unison.CommandLine.Helpers (plural') @@ -424,49 +425,55 @@ runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles currentDir <- getCurrentDirectory configFilePath <- getConfigFilePath mcodepath -- We don't need to create a codebase through `getCodebaseOrExit` as we've already done so previously. - and <$> getCodebaseOrExit (Just (DontCreateCodebaseWhenMissing transcriptDir)) (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, codebasePath, theCodebase) -> do - let isTest = False - TR.withTranscriptRunner isTest Verbosity.Verbose (Version.gitDescribeWithDate version) nativeRtp (Just configFilePath) $ \runTranscript -> do - for markdownFiles $ \(MarkdownFile fileName) -> do - transcriptSrc <- readUtf8 fileName - result <- runTranscript fileName transcriptSrc (codebasePath, theCodebase) - let outputFile = replaceExtension (currentDir fileName) ".output.md" - (output, succeeded) <- case result of - Left err -> case err of - TR.TranscriptParseError err -> do - PT.putPrettyLn $ - P.callout - "❓" - ( P.lines - [ P.indentN 2 "An error occurred while parsing the following file: " <> P.string fileName, - "", - P.indentN 2 $ P.text err - ] - ) - pure (err, False) - TR.TranscriptRunFailure err -> do - PT.putPrettyLn $ - P.callout - "❓" - ( P.lines - [ P.indentN 2 "An error occurred while running the following file: " <> P.string fileName, - "", - P.indentN 2 $ P.text err, - P.text $ - "Run `" - <> Text.pack progName - <> " --codebase " - <> Text.pack codebasePath - <> "` " - <> "to do more work with it." - ] + and + <$> getCodebaseOrExit + (Just (DontCreateCodebaseWhenMissing transcriptDir)) + (SC.MigrateAutomatically SC.Backup SC.Vacuum) + \(_, codebasePath, theCodebase) -> do + let isTest = False + Transcript.withRunner + isTest + Verbosity.Verbose + (Version.gitDescribeWithDate version) + nativeRtp + (Just configFilePath) + \runTranscript -> do + for markdownFiles $ \(MarkdownFile fileName) -> do + transcriptSrc <- readUtf8 fileName + result <- runTranscript fileName transcriptSrc (codebasePath, theCodebase) + let outputFile = replaceExtension (currentDir fileName) ".output.md" + output <- + either + ( uncurry ($>) . first (PT.putPrettyLn . P.callout "❓" . P.lines) . \case + Transcript.ParseError err -> + let msg = MP.errorBundlePretty err + in ( [ P.indentN 2 $ + "An error occurred while parsing the following file: " <> P.string fileName, + "", + P.indentN 2 $ P.string msg + ], + Text.pack msg + ) + Transcript.RunFailure msg -> + ( [ P.indentN 2 $ "An error occurred while running the following file: " <> P.string fileName, + "", + P.indentN 2 (P.text msg), + P.string $ + "Run `" + <> progName + <> " --codebase " + <> codebasePath + <> "` " + <> "to do more work with it." + ], + msg + ) ) - pure (err, False) - Right mdOut -> do - pure (mdOut, True) - writeUtf8 outputFile output - putStrLn $ "💾 Wrote " <> outputFile - pure succeeded + pure + result + writeUtf8 outputFile output + putStrLn $ "💾 Wrote " <> outputFile + pure $ isRight result runTranscripts :: Version -> diff --git a/unison-cli/tests/Unison/Test/Ucm.hs b/unison-cli/tests/Unison/Test/Ucm.hs index 7fdca8710b..c5e4f3c960 100644 --- a/unison-cli/tests/Unison/Test/Ucm.hs +++ b/unison-cli/tests/Unison/Test/Ucm.hs @@ -24,7 +24,7 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Init qualified as Codebase.Init import Unison.Codebase.Init.CreateCodebaseError (CreateCodebaseError (..)) import Unison.Codebase.SqliteCodebase qualified as SC -import Unison.Codebase.TranscriptParser qualified as TR +import Unison.Codebase.TranscriptParser qualified as Transcript import Unison.Codebase.Verbosity qualified as Verbosity import Unison.Parser.Ann (Ann) import Unison.Prelude (traceM) @@ -66,17 +66,16 @@ runTranscript :: Codebase -> Transcript -> IO TranscriptOutput runTranscript (Codebase codebasePath fmt) transcript = do let err e = fail $ "Parse error: \n" <> show e cbInit = case fmt of CodebaseFormat2 -> SC.init - let isTest = True - TR.withTranscriptRunner isTest Verbosity.Silent "Unison.Test.Ucm.runTranscript Invalid Version String" rtp configFile $ \runner -> do - result <- Codebase.Init.withOpenCodebase cbInit "transcript" codebasePath SC.DoLock SC.DontMigrate \codebase -> do - Codebase.runTransaction codebase (Codebase.installUcmDependencies codebase) - let transcriptSrc = stripMargin . Text.pack $ unTranscript transcript - output <- either err Text.unpack <$> runner "transcript" transcriptSrc (codebasePath, codebase) - when debugTranscriptOutput $ traceM output - pure output - case result of - Left e -> fail $ P.toANSI 80 (P.shown e) - Right x -> pure x + isTest = True + Transcript.withRunner isTest Verbosity.Silent "Unison.Test.Ucm.runTranscript Invalid Version String" rtp configFile $ + \runner -> do + result <- Codebase.Init.withOpenCodebase cbInit "transcript" codebasePath SC.DoLock SC.DontMigrate \codebase -> do + Codebase.runTransaction codebase (Codebase.installUcmDependencies codebase) + let transcriptSrc = stripMargin . Text.pack $ unTranscript transcript + output <- either err Text.unpack <$> runner "transcript" transcriptSrc (codebasePath, codebase) + when debugTranscriptOutput $ traceM output + pure output + either (fail . P.toANSI 80 . P.shown) pure result where configFile = Nothing -- Note: this needs to be properly configured if these tests ever diff --git a/unison-cli/transcripts/Transcripts.hs b/unison-cli/transcripts/Transcripts.hs index 5810df590f..8dcdf806dd 100644 --- a/unison-cli/transcripts/Transcripts.hs +++ b/unison-cli/transcripts/Transcripts.hs @@ -22,9 +22,10 @@ import System.FilePath ) import System.IO.CodePage (withCP65001) import System.IO.Silently (silence) +import Text.Megaparsec qualified as MP import Unison.Codebase.Init (withTemporaryUcmCodebase) import Unison.Codebase.SqliteCodebase qualified as SC -import Unison.Codebase.TranscriptParser (TranscriptError (..), withTranscriptRunner) +import Unison.Codebase.TranscriptParser as Transcript import Unison.Codebase.Verbosity qualified as Verbosity import Unison.Prelude import UnliftIO.STM qualified as STM @@ -48,7 +49,7 @@ testBuilder :: testBuilder expectFailure recordFailure runtimePath dir prelude transcript = scope transcript $ do outputs <- io . withTemporaryUcmCodebase SC.init Verbosity.Silent "transcript" SC.DoLock $ \(codebasePath, codebase) -> do let isTest = True - withTranscriptRunner isTest Verbosity.Silent "TODO: pass version here" runtimePath Nothing \runTranscript -> do + Transcript.withRunner isTest Verbosity.Silent "TODO: pass version here" runtimePath Nothing \runTranscript -> do for files \filePath -> do transcriptSrc <- readUtf8 filePath out <- silence $ runTranscript filePath transcriptSrc (codebasePath, codebase) @@ -57,12 +58,12 @@ testBuilder expectFailure recordFailure runtimePath dir prelude transcript = sco (filePath, Left err) -> do let outputFile = outputFileForTranscript filePath case err of - TranscriptParseError msg -> do + Transcript.ParseError errors -> do when (not expectFailure) $ do - let errMsg = "Error parsing " <> filePath <> ": " <> Text.unpack msg + let errMsg = "Error parsing " <> filePath <> ": " <> MP.errorBundlePretty errors io $ recordFailure (filePath, Text.pack errMsg) crash errMsg - TranscriptRunFailure errOutput -> do + Transcript.RunFailure errOutput -> do io $ writeUtf8 outputFile errOutput when (not expectFailure) $ do io $ Text.putStrLn errOutput diff --git a/unison-src/transcripts/error-messages.output.md b/unison-src/transcripts/error-messages.output.md index ed5d4c1784..0b3e334aa6 100644 --- a/unison-src/transcripts/error-messages.output.md +++ b/unison-src/transcripts/error-messages.output.md @@ -211,8 +211,7 @@ foo = match 1 with I got confused here: - 2 | 2 -- no right-hand-side - + 3 | I was surprised to find an end of section here. I was expecting one of these instead: @@ -258,8 +257,7 @@ x = match Some a with I got confused here: - 6 | 2 - + 7 | I was surprised to find an end of section here. I was expecting one of these instead: diff --git a/unison-src/transcripts/generic-parse-errors.output.md b/unison-src/transcripts/generic-parse-errors.output.md index 6c5c5048b1..081548ea11 100644 --- a/unison-src/transcripts/generic-parse-errors.output.md +++ b/unison-src/transcripts/generic-parse-errors.output.md @@ -96,8 +96,7 @@ x = "hi I got confused here: - 1 | x = "hi - + 2 | I was surprised to find an end of input here. I was expecting one of these instead: @@ -117,8 +116,7 @@ y : a I got confused here: - 1 | y : a - + 2 | I was surprised to find an end of section here. I was expecting one of these instead: From b1cf12330ad293c4e8907597edf808d3fd1bbee1 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 15 Jul 2024 19:32:45 -0600 Subject: [PATCH 466/631] Split `TranscriptParser` into three modules MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - `Transcript` – the data model - `Transcript.Parser` – the parser and printer - `Transcript.Runner` – the runner There is unfortunately still some printing tightly coupled to the runner, but this makes it more obvious. Also, the runner is the only component tied to the CLI. --- unison-cli/src/Unison/Codebase/Transcript.hs | 50 +++++ .../src/Unison/Codebase/Transcript/Parser.hs | 166 ++++++++++++++ .../Runner.hs} | 204 ++---------------- unison-cli/src/Unison/Main.hs | 2 +- unison-cli/tests/Unison/Test/Ucm.hs | 2 +- unison-cli/transcripts/Transcripts.hs | 2 +- unison-cli/unison-cli.cabal | 4 +- 7 files changed, 238 insertions(+), 192 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Transcript.hs create mode 100644 unison-cli/src/Unison/Codebase/Transcript/Parser.hs rename unison-cli/src/Unison/Codebase/{TranscriptParser.hs => Transcript/Runner.hs} (75%) diff --git a/unison-cli/src/Unison/Codebase/Transcript.hs b/unison-cli/src/Unison/Codebase/Transcript.hs new file mode 100644 index 0000000000..bd5bbd058f --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Transcript.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE PatternSynonyms #-} + +-- | The data model for Unison transcripts. +module Unison.Codebase.Transcript + ( ExpectingError, + ScratchFileName, + Hidden (..), + UcmLine (..), + UcmContext (..), + APIRequest (..), + pattern CMarkCodeBlock, + Stanza, + ProcessedBlock (..), + ) +where + +import CMark qualified +import Unison.Core.Project (ProjectBranchName, ProjectName) +import Unison.Prelude +import Unison.Project (ProjectAndBranch) + +type ExpectingError = Bool + +type ScratchFileName = Text + +data Hidden = Shown | HideOutput | HideAll + deriving (Eq, Show) + +data UcmLine + = UcmCommand UcmContext Text + | -- | Text does not include the '--' prefix. + UcmComment Text + +-- | Where a command is run: a project branch (myproject/mybranch>). +data UcmContext + = UcmContextProject (ProjectAndBranch ProjectName ProjectBranchName) + +data APIRequest + = GetRequest Text + | APIComment Text + +pattern CMarkCodeBlock :: (Maybe CMark.PosInfo) -> Text -> Text -> CMark.Node +pattern CMarkCodeBlock pos info body = CMark.Node pos (CMark.CODE_BLOCK info body) [] + +type Stanza = Either CMark.Node ProcessedBlock + +data ProcessedBlock + = Ucm Hidden ExpectingError [UcmLine] + | Unison Hidden ExpectingError (Maybe ScratchFileName) Text + | API [APIRequest] diff --git a/unison-cli/src/Unison/Codebase/Transcript/Parser.hs b/unison-cli/src/Unison/Codebase/Transcript/Parser.hs new file mode 100644 index 0000000000..8bbd8be622 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Transcript/Parser.hs @@ -0,0 +1,166 @@ +-- | Parse and print CommonMark (like Github-flavored Markdown) transcripts. +module Unison.Codebase.Transcript.Parser + ( -- * printing + formatAPIRequest, + formatUcmLine, + formatStanza, + formatNode, + formatProcessedBlock, + + -- * conversion + processedBlockToNode, + + -- * parsing + stanzas, + ucmLine, + apiRequest, + fenced, + hidden, + expectingError, + language, + ) +where + +import CMark qualified +import Data.Char qualified as Char +import Data.Text qualified as Text +import Data.These (These (..)) +import Text.Megaparsec qualified as P +import Unison.Codebase.Transcript +import Unison.Prelude +import Unison.Project (ProjectAndBranch (ProjectAndBranch)) + +formatAPIRequest :: APIRequest -> Text +formatAPIRequest = \case + GetRequest txt -> "GET " <> txt + APIComment txt -> "-- " <> txt + +formatUcmLine :: UcmLine -> Text +formatUcmLine = \case + UcmCommand context txt -> formatContext context <> "> " <> txt + UcmComment txt -> "--" <> txt + where + formatContext (UcmContextProject projectAndBranch) = into @Text projectAndBranch + +formatStanza :: Stanza -> Text +formatStanza = either formatNode formatProcessedBlock + +formatNode :: CMark.Node -> Text +formatNode = (<> "\n") . CMark.nodeToCommonmark [] Nothing + +formatProcessedBlock :: ProcessedBlock -> Text +formatProcessedBlock = formatNode . processedBlockToNode + +processedBlockToNode :: ProcessedBlock -> CMark.Node +processedBlockToNode = \case + Ucm _ _ cmds -> CMarkCodeBlock Nothing "ucm" $ foldr ((<>) . formatUcmLine) "" cmds + Unison _hide _ fname txt -> + CMarkCodeBlock Nothing "unison" $ maybe txt (\fname -> Text.unlines ["---", "title: " <> fname, "---", txt]) fname + API apiRequests -> CMarkCodeBlock Nothing "api" $ Text.unlines $ formatAPIRequest <$> apiRequests + +type P = P.Parsec Void Text + +stanzas :: FilePath -> Text -> Either (P.ParseErrorBundle Text Void) [Stanza] +stanzas srcName = (\(CMark.Node _ _DOCUMENT blocks) -> traverse stanzaFromNode blocks) . CMark.commonmarkToNode [] + where + stanzaFromNode :: CMark.Node -> Either (P.ParseErrorBundle Text Void) Stanza + stanzaFromNode node = case node of + CMarkCodeBlock _ info body -> maybe (Left node) pure <$> P.parse (fenced info) srcName body + _ -> pure $ Left node + +ucmLine :: P UcmLine +ucmLine = ucmCommand <|> ucmComment + where + ucmCommand :: P UcmLine + ucmCommand = do + context <- + P.try do + contextString <- P.takeWhile1P Nothing (/= '>') + context <- + case (tryFrom @Text contextString) of + (Right (These project branch)) -> pure (UcmContextProject (ProjectAndBranch project branch)) + _ -> fail "expected project/branch or absolute path" + void $ lineToken $ word ">" + pure context + line <- P.takeWhileP Nothing (/= '\n') <* spaces + pure $ UcmCommand context line + + ucmComment :: P UcmLine + ucmComment = do + word "--" + line <- P.takeWhileP Nothing (/= '\n') <* spaces + pure $ UcmComment line + +apiRequest :: P APIRequest +apiRequest = do + apiComment <|> getRequest + where + getRequest = do + word "GET" + spaces + path <- P.takeWhile1P Nothing (/= '\n') + spaces + pure (GetRequest path) + apiComment = do + word "--" + comment <- P.takeWhileP Nothing (/= '\n') + spaces + pure (APIComment comment) + +-- | Produce the correct parser for the code block based on the provided info string. +fenced :: Text -> P (Maybe ProcessedBlock) +fenced info = do + body <- P.getInput + P.setInput info + fenceType <- lineToken (word "ucm" <|> word "unison" <|> word "api" <|> language) + case fenceType of + "ucm" -> do + hide <- hidden + err <- expectingError + P.setInput body + pure . Ucm hide err <$> (spaces *> many ucmLine) + "unison" -> + do + -- todo: this has to be more interesting + -- ```unison:hide + -- ```unison + -- ```unison:hide:all scratch.u + hide <- lineToken hidden + err <- lineToken expectingError + fileName <- optional untilSpace1 + P.setInput body + pure . Unison hide err fileName <$> (spaces *> P.getInput) + "api" -> do + P.setInput body + pure . API <$> (spaces *> many apiRequest) + _ -> pure Nothing + +word :: Text -> P Text +word txt = P.try $ do + chs <- P.takeP (Just $ show txt) (Text.length txt) + guard (chs == txt) + pure txt + +lineToken :: P a -> P a +lineToken p = p <* nonNewlineSpaces + +nonNewlineSpaces :: P () +nonNewlineSpaces = void $ P.takeWhileP Nothing (\ch -> ch == ' ' || ch == '\t') + +hidden :: P Hidden +hidden = + (HideAll <$ word ":hide:all") + <|> (HideOutput <$ word ":hide") + <|> pure Shown + +expectingError :: P ExpectingError +expectingError = isJust <$> optional (word ":error") + +untilSpace1 :: P Text +untilSpace1 = P.takeWhile1P Nothing (not . Char.isSpace) + +language :: P Text +language = P.takeWhileP Nothing (\ch -> Char.isDigit ch || Char.isLower ch || ch == '_') + +spaces :: P () +spaces = void $ P.takeWhileP (Just "spaces") Char.isSpace diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs similarity index 75% rename from unison-cli/src/Unison/Codebase/TranscriptParser.hs rename to unison-cli/src/Unison/Codebase/Transcript/Runner.hs index c413ff56e7..6e084a2eba 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs @@ -1,23 +1,18 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} --- | Parse and execute CommonMark (like Github-flavored Markdown) transcripts. -module Unison.Codebase.TranscriptParser +-- | Execute transcripts. +module Unison.Codebase.Transcript.Runner ( Error (..), Runner, withRunner, ) where -import CMark qualified import Control.Lens (use, (?~)) import Crypto.Random qualified as Random import Data.Aeson qualified as Aeson import Data.Aeson.Encode.Pretty qualified as Aeson import Data.ByteString.Lazy.Char8 qualified as BL -import Data.Char qualified as Char import Data.Configurator qualified as Configurator import Data.Configurator.Types (Config) import Data.IORef @@ -51,6 +46,8 @@ import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Editor.UCMVersion (UCMVersion) import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Runtime +import Unison.Codebase.Transcript +import Unison.Codebase.Transcript.Parser qualified as Transcript import Unison.Codebase.Verbosity (Verbosity, isSilent) import Unison.Codebase.Verbosity qualified as Verbosity import Unison.CommandLine @@ -58,7 +55,6 @@ import Unison.CommandLine.InputPattern (InputPattern (aliases, patternName)) import Unison.CommandLine.InputPatterns (validInputs) import Unison.CommandLine.OutputMessages (notifyNumbered, notifyUser) import Unison.CommandLine.Welcome (asciiartUnison) -import Unison.Core.Project (ProjectBranchName, ProjectName (..)) import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyTerminal @@ -86,66 +82,6 @@ terminalWidth = 65 accessTokenEnvVarKey :: String accessTokenEnvVarKey = "UNISON_SHARE_ACCESS_TOKEN" -type ExpectingError = Bool - -type ScratchFileName = Text - -data Hidden = Shown | HideOutput | HideAll - deriving (Eq, Show) - -data UcmLine - = UcmCommand UcmContext Text - | UcmComment Text -- Text does not include the '--' prefix. - --- | Where a command is run: either loose code (.foo.bar.baz>) or a project branch (myproject/mybranch>). -data UcmContext - = UcmContextProject (ProjectAndBranch ProjectName ProjectBranchName) - -data APIRequest - = GetRequest Text - | APIComment Text - -formatAPIRequest :: APIRequest -> Text -formatAPIRequest = \case - GetRequest txt -> "GET " <> txt - APIComment txt -> "-- " <> txt - -pattern CMarkCodeBlock :: (Maybe CMark.PosInfo) -> Text -> Text -> CMark.Node -pattern CMarkCodeBlock pos info body = CMark.Node pos (CMark.CODE_BLOCK info body) [] - -type Stanza = Either CMark.Node ProcessedBlock - -data ProcessedBlock - = Ucm Hidden ExpectingError [UcmLine] - | Unison Hidden ExpectingError (Maybe ScratchFileName) Text - | API [APIRequest] - -formatUcmLine :: UcmLine -> Text -formatUcmLine = \case - UcmCommand context txt -> formatContext context <> "> " <> txt - UcmComment txt -> "--" <> txt - where - formatContext (UcmContextProject projectAndBranch) = into @Text projectAndBranch - -formatStanza :: Stanza -> Text -formatStanza = either formatNode formatProcessedBlock - -formatNode :: CMark.Node -> Text -formatNode = (<> "\n") . CMark.nodeToCommonmark [] Nothing - -formatProcessedBlock :: ProcessedBlock -> Text -formatProcessedBlock = formatNode . processedBlockToNode - -processedBlockToNode :: ProcessedBlock -> CMark.Node -processedBlockToNode = \case - Ucm _ _ cmds -> CMarkCodeBlock Nothing "ucm" $ foldr ((<>) . formatUcmLine) "" cmds - Unison _hide _ fname txt -> - CMarkCodeBlock Nothing "unison" $ maybe txt (\fname -> Text.unlines ["---", "title: " <> fname, "---", txt]) fname - API apiRequests -> CMarkCodeBlock Nothing "api" $ Text.unlines $ formatAPIRequest <$> apiRequests - -parse :: FilePath -> Text -> Either Error [Stanza] -parse srcName = first ParseError . stanzas srcName - type Runner = String -> Text -> @@ -155,7 +91,8 @@ type Runner = withRunner :: forall m r. (UnliftIO.MonadUnliftIO m) => - Bool {- Whether to treat this transcript run as a transcript test, which will try to make output deterministic -} -> + -- | Whether to treat this transcript run as a transcript test, which will try to make output deterministic + Bool -> Verbosity -> UCMVersion -> FilePath -> @@ -166,10 +103,10 @@ withRunner isTest verbosity ucmVersion nrtp configFile action = do withRuntimes nrtp \runtime sbRuntime nRuntime -> withConfig \config -> do action \transcriptName transcriptSrc (codebaseDir, codebase) -> do Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) Server.defaultCodebaseServerOpts runtime codebase \baseUrl -> do - let parsed = parse transcriptName transcriptSrc + let parsed = Transcript.stanzas transcriptName transcriptSrc result <- for parsed \stanzas -> do liftIO $ run isTest verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime config ucmVersion (tShow baseUrl) - pure $ join @(Either Error) result + pure . join $ first ParseError result where withRuntimes :: FilePath -> (Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> m a) -> m a @@ -193,7 +130,8 @@ withRunner isTest verbosity ucmVersion nrtp configFile action = do (\(config, _cancelConfig) -> action (Just config)) run :: - Bool {- Whether to treat this transcript run as a transcript test, which will try to make output deterministic -} -> + -- | Whether to treat this transcript run as a transcript test, which will try to make output deterministic + Bool -> Verbosity -> FilePath -> [Stanza] -> @@ -265,7 +203,7 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV apiRequest :: APIRequest -> IO () apiRequest req = do - output . Text.unpack $ formatAPIRequest req <> "\n" + output . Text.unpack $ Transcript.formatAPIRequest req <> "\n" case req of APIComment {} -> pure () GetRequest path -> do @@ -299,7 +237,7 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV Just (Just ucmLine) -> do case ucmLine of p@(UcmComment {}) -> do - liftIO . output . Text.unpack $ "\n" <> formatUcmLine p + liftIO . output . Text.unpack $ "\n" <> Transcript.formatUcmLine p awaitInput p@(UcmCommand context lineTxt) -> do curPath <- Cli.getCurrentProjectPath @@ -337,7 +275,7 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV case words . Text.unpack $ lineTxt of [] -> awaitInput args -> do - liftIO . output . Text.unpack $ "\n" <> formatUcmLine p <> "\n" + liftIO . output . Text.unpack $ "\n" <> Transcript.formatUcmLine p <> "\n" numberedArgs <- use #numberedArgs PP.ProjectAndBranch projId branchId <- PP.toProjectAndBranch . NonEmpty.head <$> use #projectPathStack let getProjectRoot = liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId @@ -375,13 +313,13 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV IO.hFlush IO.stdout either ( \node -> do - liftIO . output . Text.unpack $ formatNode node + liftIO . output . Text.unpack $ Transcript.formatNode node awaitInput ) ( \block -> case block of Unison hide errOk filename txt -> do liftIO (writeIORef hidden hide) - liftIO . outputEcho . Text.unpack $ formatProcessedBlock block + liftIO . outputEcho . Text.unpack $ Transcript.formatProcessedBlock block liftIO (writeIORef allowErrors errOk) -- Open a ucm block which will contain the output from UCM -- after processing the UnisonFileChanged event. @@ -462,7 +400,7 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV appendFailingStanza = do stanzaOpt <- readIORef mStanza currentOut <- readIORef out - let stnz = maybe "" (Text.unpack . formatStanza . fst) stanzaOpt + let stnz = maybe "" (Text.unpack . Transcript.formatStanza . fst) stanzaOpt unless (stnz `isSubsequenceOf` concat currentOut) $ modifyIORef' out (\acc -> acc <> pure stnz) @@ -532,116 +470,6 @@ transcriptFailure out msg = do texts <- readIORef out UnliftIO.throwIO . RunFailure $ mconcat (Text.pack <$> toList texts) <> "\n\n\128721\n\n" <> msg <> "\n" -type P = P.Parsec Void Text - -stanzas :: FilePath -> Text -> Either (P.ParseErrorBundle Text Void) [Stanza] -stanzas srcName = (\(CMark.Node _ _DOCUMENT blocks) -> traverse stanzaFromNode blocks) . CMark.commonmarkToNode [] - where - stanzaFromNode :: CMark.Node -> Either (P.ParseErrorBundle Text Void) Stanza - stanzaFromNode node = case node of - CMarkCodeBlock _ info body -> maybe (Left node) pure <$> P.parse (fenced info) srcName body - _ -> pure $ Left node - -ucmLine :: P UcmLine -ucmLine = ucmCommand <|> ucmComment - where - ucmCommand :: P UcmLine - ucmCommand = do - context <- - P.try do - contextString <- P.takeWhile1P Nothing (/= '>') - context <- - case (tryFrom @Text contextString) of - (Right (These project branch)) -> pure (UcmContextProject (ProjectAndBranch project branch)) - _ -> fail "expected project/branch or absolute path" - void $ lineToken $ word ">" - pure context - line <- P.takeWhileP Nothing (/= '\n') <* spaces - pure $ UcmCommand context line - - ucmComment :: P UcmLine - ucmComment = do - word "--" - line <- P.takeWhileP Nothing (/= '\n') <* spaces - pure $ UcmComment line - -apiRequest :: P APIRequest -apiRequest = do - apiComment <|> getRequest - where - getRequest = do - word "GET" - spaces - path <- P.takeWhile1P Nothing (/= '\n') - spaces - pure (GetRequest path) - apiComment = do - word "--" - comment <- P.takeWhileP Nothing (/= '\n') - spaces - pure (APIComment comment) - --- | Produce the correct parser for the code block based on the provided info string. -fenced :: Text -> P (Maybe ProcessedBlock) -fenced info = do - body <- P.getInput - P.setInput info - fenceType <- lineToken (word "ucm" <|> word "unison" <|> word "api" <|> language) - case fenceType of - "ucm" -> do - hide <- hidden - err <- expectingError - P.setInput body - pure . Ucm hide err <$> (spaces *> many ucmLine) - "unison" -> - do - -- todo: this has to be more interesting - -- ```unison:hide - -- ```unison - -- ```unison:hide:all scratch.u - hide <- lineToken hidden - err <- lineToken expectingError - fileName <- optional untilSpace1 - P.setInput body - pure . Unison hide err fileName <$> (spaces *> P.getInput) - "api" -> do - P.setInput body - pure . API <$> (spaces *> many apiRequest) - _ -> pure Nothing - -word' :: Text -> P Text -word' txt = P.try $ do - chs <- P.takeP (Just $ show txt) (Text.length txt) - guard (chs == txt) - pure txt - -word :: Text -> P Text -word = word' - -lineToken :: P a -> P a -lineToken p = p <* nonNewlineSpaces - -nonNewlineSpaces :: P () -nonNewlineSpaces = void $ P.takeWhileP Nothing (\ch -> ch == ' ' || ch == '\t') - -hidden :: P Hidden -hidden = - (HideAll <$ word ":hide:all") - <|> (HideOutput <$ word ":hide") - <|> pure Shown - -expectingError :: P ExpectingError -expectingError = isJust <$> optional (word ":error") - -untilSpace1 :: P Text -untilSpace1 = P.takeWhile1P Nothing (not . Char.isSpace) - -language :: P Text -language = P.takeWhileP Nothing (\ch -> Char.isDigit ch || Char.isLower ch || ch == '_') - -spaces :: P () -spaces = void $ P.takeWhileP (Just "spaces") Char.isSpace - data Error = ParseError (P.ParseErrorBundle Text Void) | RunFailure Text diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index 1459a516a8..990f11354f 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -74,7 +74,7 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Rt import Unison.Codebase.SqliteCodebase qualified as SC -import Unison.Codebase.TranscriptParser qualified as Transcript +import Unison.Codebase.Transcript.Runner qualified as Transcript import Unison.Codebase.Verbosity qualified as Verbosity import Unison.CommandLine (watchConfig) import Unison.CommandLine.Helpers (plural') diff --git a/unison-cli/tests/Unison/Test/Ucm.hs b/unison-cli/tests/Unison/Test/Ucm.hs index c5e4f3c960..1a8033c52b 100644 --- a/unison-cli/tests/Unison/Test/Ucm.hs +++ b/unison-cli/tests/Unison/Test/Ucm.hs @@ -24,7 +24,7 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Init qualified as Codebase.Init import Unison.Codebase.Init.CreateCodebaseError (CreateCodebaseError (..)) import Unison.Codebase.SqliteCodebase qualified as SC -import Unison.Codebase.TranscriptParser qualified as Transcript +import Unison.Codebase.Transcript.Runner qualified as Transcript import Unison.Codebase.Verbosity qualified as Verbosity import Unison.Parser.Ann (Ann) import Unison.Prelude (traceM) diff --git a/unison-cli/transcripts/Transcripts.hs b/unison-cli/transcripts/Transcripts.hs index 8dcdf806dd..77220a3061 100644 --- a/unison-cli/transcripts/Transcripts.hs +++ b/unison-cli/transcripts/Transcripts.hs @@ -25,7 +25,7 @@ import System.IO.Silently (silence) import Text.Megaparsec qualified as MP import Unison.Codebase.Init (withTemporaryUcmCodebase) import Unison.Codebase.SqliteCodebase qualified as SC -import Unison.Codebase.TranscriptParser as Transcript +import Unison.Codebase.Transcript.Runner as Transcript import Unison.Codebase.Verbosity qualified as Verbosity import Unison.Prelude import UnliftIO.STM qualified as STM diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index b5a29cc483..77030bfdf6 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -106,7 +106,9 @@ library Unison.Codebase.Editor.StructuredArgument Unison.Codebase.Editor.UCMVersion Unison.Codebase.Editor.UriParser - Unison.Codebase.TranscriptParser + Unison.Codebase.Transcript + Unison.Codebase.Transcript.Parser + Unison.Codebase.Transcript.Runner Unison.Codebase.Watch Unison.CommandLine Unison.CommandLine.BranchRelativePath From bf080a5c5b63aad0877f1dd79456bb95a099126e Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 16 Jul 2024 18:25:33 -0600 Subject: [PATCH 467/631] Clean up devShell definition MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Mostly formatting, but also - removes Apple’s Cocoa from the dependencies, - moves some dependencies from `buildInputs` to `nativeBuildInputs`. --- nix/haskell-nix-flake.nix | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/nix/haskell-nix-flake.nix b/nix/haskell-nix-flake.nix index 97c8f1ebc0..fa2b246a90 100644 --- a/nix/haskell-nix-flake.nix +++ b/nix/haskell-nix-flake.nix @@ -12,15 +12,29 @@ # https://github.com/input-output-hk/haskell.nix/issues/1793 # https://github.com/input-output-hk/haskell.nix/issues/1885 allToolDeps = false; - additional = hpkgs: with hpkgs; [Cabal stm exceptions ghc ghc-heap]; - buildInputs = let - native-packages = - lib.optionals pkgs.stdenv.isDarwin - (with pkgs.darwin.apple_sdk.frameworks; [Cocoa]); - in + + additional = hpkgs: + (args.additional or (_: [])) hpkgs + ++ [ + hpkgs.Cabal + hpkgs.exceptions + hpkgs.ghc + hpkgs.ghc-heap + hpkgs.stm + ]; + buildInputs = (args.buildInputs or []) - ++ [pkgs.stack-wrapped pkgs.hpack pkgs.pkg-config pkgs.zlib pkgs.glibcLocales] - ++ native-packages; + ++ [ + pkgs.glibcLocales + pkgs.zlib + ]; + nativeBuildInputs = + (args.nativeBuildInputs or []) + ++ [ + pkgs.hpack + pkgs.pkg-config + pkgs.stack-wrapped + ]; # workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/11042 shellHook = '' export LD_LIBRARY_PATH=${pkgs.zlib}/lib:$LD_LIBRARY_PATH From f18943284ec4f03136c7b653619fee5bcfb83908 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 16 Jul 2024 18:28:27 -0600 Subject: [PATCH 468/631] Add `cachix` to the devShell MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This tool manages the Unison cache, so it’s useful to provide in dev environments. Actually pushing to the cache requires a secret key. --- nix/haskell-nix-flake.nix | 1 + 1 file changed, 1 insertion(+) diff --git a/nix/haskell-nix-flake.nix b/nix/haskell-nix-flake.nix index fa2b246a90..ac4764c781 100644 --- a/nix/haskell-nix-flake.nix +++ b/nix/haskell-nix-flake.nix @@ -31,6 +31,7 @@ nativeBuildInputs = (args.nativeBuildInputs or []) ++ [ + pkgs.cachix pkgs.hpack pkgs.pkg-config pkgs.stack-wrapped From cdab05d25992537ea1ce699a1dbe2d4413810b41 Mon Sep 17 00:00:00 2001 From: ChrisPenner Date: Wed, 17 Jul 2024 18:29:29 +0000 Subject: [PATCH 469/631] automatically run ormolu --- unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs b/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs index 6326006c7a..406a8eae2f 100644 --- a/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs +++ b/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs @@ -48,7 +48,7 @@ toText = -- | A hash-qualified parser. hashQualifiedP :: - Monad m => + (Monad m) => ParsecT (Token Text) [Char] m name -> ParsecT (Token Text) [Char] m (HQ'.HashQualified name) hashQualifiedP nameP = From e3b2e4bff64fbda7a527c69d12e19042f98a1899 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Sat, 13 Jul 2024 21:48:25 +0100 Subject: [PATCH 470/631] use libb2 for all blake functions required if compiling on systems that use eg libressl --- scheme-libs/racket/unison/crypto.rkt | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/scheme-libs/racket/unison/crypto.rkt b/scheme-libs/racket/unison/crypto.rkt index 4d25dc3d9b..971056e36c 100644 --- a/scheme-libs/racket/unison/crypto.rkt +++ b/scheme-libs/racket/unison/crypto.rkt @@ -96,6 +96,7 @@ (error 'blake2 "~a failed with return value ~a" fn r)))))) (define blake2b-raw (libb2-raw "blake2b")) +(define blake2s-raw (libb2-raw "blake2s")) (define HashAlgorithm.Md5 (lc-algo "EVP_md5" 128)) (define HashAlgorithm.Sha1 (lc-algo "EVP_sha1" 160)) @@ -103,8 +104,6 @@ (define HashAlgorithm.Sha2_512 (lc-algo "EVP_sha512" 512)) (define HashAlgorithm.Sha3_256 (lc-algo "EVP_sha3_256" 256)) (define HashAlgorithm.Sha3_512 (lc-algo "EVP_sha3_512" 512)) -(define HashAlgorithm.Blake2s_256 (lc-algo "EVP_blake2s256" 256)) -(define HashAlgorithm.Blake2b_512 (lc-algo "EVP_blake2b512" 512)) (define _EVP_PKEY-pointer (_cpointer 'EVP_PKEY)) (define _EVP_MD_CTX-pointer (_cpointer 'EVP_MD_CTX)) @@ -234,6 +233,8 @@ (chunked-bytes->bytes input) (chunked-bytes->bytes signature))) +(define (HashAlgorithm.Blake2s_256) (cons 'blake2s 256)) +(define (HashAlgorithm.Blake2b_512) (cons 'blake2b 512)) ; This one isn't provided by libcrypto, for some reason (define (HashAlgorithm.Blake2b_256) (cons 'blake2b 256)) @@ -252,6 +253,7 @@ [algo (car kind)]) (case algo ['blake2b (blake2b-raw output input #f bytes (bytes-length input) 0)] + ['blake2s (blake2s-raw output input #f bytes (bytes-length input) 0)] [else (EVP_Digest input (bytes-length input) output #f algo #f)]) output)) @@ -294,6 +296,7 @@ (define (hmacBytes-raw kind key input) (case (car kind) ['blake2b (hmacBlake kind key input)] + ['blake2s (hmacBlake kind key input)] [else (let* ([bytes (/ (cdr kind) 8)] [output (make-bytes bytes)] From f18cb2fc9d150a4f7220f2cc836e711f75b3520d Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Sun, 14 Jul 2024 01:42:23 +0100 Subject: [PATCH 471/631] use /usr/bin/env sh for jit-tests.sh this is more portable and ensures we can compile on systems without bash (eg *BSD) --- unison-src/builtin-tests/jit-tests.sh | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/unison-src/builtin-tests/jit-tests.sh b/unison-src/builtin-tests/jit-tests.sh index d4d9356ab1..8e29209dc1 100755 --- a/unison-src/builtin-tests/jit-tests.sh +++ b/unison-src/builtin-tests/jit-tests.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env sh set -ex # the first arg is the path to the unison executable @@ -8,9 +8,6 @@ if [ -z "$1" ]; then exit 1 fi -# call unison with all its args quoted -ucm=("$@") - runtime_tests_version="@unison/runtime-tests/main" echo $runtime_tests_version @@ -27,4 +24,5 @@ runtime_tests_version="$runtime_tests_version" \ < unison-src/builtin-tests/jit-tests.tpl.md \ > unison-src/builtin-tests/jit-tests.md -time "${ucm[@]}" transcript.fork -C $codebase -S $codebase unison-src/builtin-tests/jit-tests.md +# call unison with all its args quoted +time "$@" transcript.fork -C $codebase -S $codebase unison-src/builtin-tests/jit-tests.md From d66c5c79f8e95b1c0ec968a7aaf804122edcd250 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Wed, 17 Jul 2024 22:24:54 +0100 Subject: [PATCH 472/631] just whitespace changes --- unison-src/builtin-tests/jit-tests.output.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/unison-src/builtin-tests/jit-tests.output.md b/unison-src/builtin-tests/jit-tests.output.md index 4bdb6cc29f..616d2d5d9c 100644 --- a/unison-src/builtin-tests/jit-tests.output.md +++ b/unison-src/builtin-tests/jit-tests.output.md @@ -34,9 +34,9 @@ foo = do I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: - + foo : '{Exception} () ``` @@ -58,10 +58,10 @@ an exception. runtime-tests/selected> run.native testBug 💔💥 - + I've encountered a call to builtin.bug with the following value: - + "testing" ``` From b6b31370021099724c7230ac89a84e46155d1f07 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Sat, 13 Jul 2024 20:15:41 +0100 Subject: [PATCH 473/631] create gitignore in scheme-libs/racket/unison/ --- scheme-libs/racket/unison/.gitignore | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 scheme-libs/racket/unison/.gitignore diff --git a/scheme-libs/racket/unison/.gitignore b/scheme-libs/racket/unison/.gitignore new file mode 100644 index 0000000000..64e9064d19 --- /dev/null +++ b/scheme-libs/racket/unison/.gitignore @@ -0,0 +1,6 @@ +compiled/ +boot-generated.ss +builtin-generated.ss +compound-wrappers.ss +data-info.ss +simple-wrappers.ss From 3cd2a76d5e6744599232bc972128f9376ac0817d Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Sat, 13 Jul 2024 20:54:55 +0100 Subject: [PATCH 474/631] update scheme-libs/racket/unison/Readme.md --- development.markdown | 4 ++ scheme-libs/racket/unison/Readme.md | 64 +++++++++++++++++-- .../transcripts-manual/gen-racket-libs.md | 7 +- 3 files changed, 65 insertions(+), 10 deletions(-) diff --git a/development.markdown b/development.markdown index 962a507c63..fa5d613b84 100644 --- a/development.markdown +++ b/development.markdown @@ -187,3 +187,7 @@ nix develop '.#cabal-unison-parser-typechecker' cd unison-cli cabal run --enable-profiling unison-cli-main:exe:unison -- +RTS -p ``` + +## Native compilation + +See the [readme](scheme-libs/racket/unison/Readme.md). diff --git a/scheme-libs/racket/unison/Readme.md b/scheme-libs/racket/unison/Readme.md index dafd7e3fa8..3984146df9 100644 --- a/scheme-libs/racket/unison/Readme.md +++ b/scheme-libs/racket/unison/Readme.md @@ -1,5 +1,18 @@ This directory contains libraries necessary for building and running -unison programs via Racket Scheme. +unison programs via Racket Scheme. The rough steps are as follows: + +* Build Racket libraries from the current Unison version. +* Build the `unison-runtime` binary. +* Pass the path to `unison-runtime` to `ucm`. + +Native compilation is done via the `compile.native` `ucm` command. +Under-the-hood, Unison does the following: + +* Convert the function to bytecode (similar to how `compile` command works). +* Call `unison-runtime` which will convert the bytecode to a temporary Racket + file. The Racket file is usually placed in your `.cache/unisonlanguage`. +* folder. Call `raco exe file.rkt -o executable` which will create a native + executable from the Racket source code. ## Prerequisites @@ -10,19 +23,56 @@ You'll need to have a couple things installed on your system: * [BLAKE2](https://github.com/BLAKE2/libb2) (you may need to install this manually) -In particular, our crypto functions require on both `libcrypto` (from openssl) and `libb2`. You may have to tell racket where to find `libb2`, by adding an entry to the hash table in your [`config.rktd` file](https://docs.racket-lang.org/raco/config-file.html). This is what I had, for an M1 mac w/ libb2 installed via Homebrew: +In particular, our crypto functions require on both `libcrypto` (from +openssl) and `libb2`. You may have to tell racket where to find `libb2`, +by adding an entry to the hash table in your +[`config.rktd` file](https://docs.racket-lang.org/raco/config-file.html). +This is what I had, for an M1 mac w/ `libb2` installed via Homebrew: ``` -(lib-search-dirs . (#f "/opt/homebrew/Cellar/libb2/0.98.1/lib/")) +$ cat scheme-libs/racket/config/config.rktd +#hash( + (lib-search-dirs . (#f "/opt/homebrew/Cellar/libb2/0.98.1/lib/")) +) ``` You'll also need to install `x509-lib` with `raco pkg install x509-lib` +Finally, some distributions only package `racket-minimal`. You'll need to +install the full compiler suite using `raco pkg install compiler-lib` +([source](https://www.dbrunner.de/blog/2016/01/12/using-racket-minimal-and-raco/)) + +## Building + +First, make sure unison is built (see [development](../../../development.markdown)) + +Next, use unison to generate the racket libraries. These are dependencies for +building `unison-runtime`. +* Read [gen-racket-libs.md](../../../../unison-src-transcripts-manual/gen-racket-libs.md). + It will contain two things: + * `ucm` and `unison` transcripts that generate the libraries + * Instructions on how to build `unison-runtime` using `raco` + +If everything went well you should now have a new executable in `scheme-libs/racket/unison-runtime`. +For example: +``` +$ file scheme-libs/racket/unison-runtime +scheme-libs/racket/unison-runtime: Mach-O 64-bit executable arm64 +``` ## Running the unison test suite -To run the test suite, first `stack build` (or `stack build --fast`), then: +Note that if you set up `config.rktd` above, you'll need to pass the path to its +folder in `PLTCONFIGDIR` before invoking unison or the test scripts: + +``` +export PLTCONFIGDIR=$(pwd)/scheme-libs/racket/config +``` + +If you don't, some of the tests will fail with eg `ffi-lib: could not load foreign library`. + +To run the test suite you can do: ``` -./unison-src/builtin-tests/jit-tests.sh $(stack exec which unison) --runtime-path +./unison-src/builtin-tests/jit-tests.sh $(stack exec which unison) --runtime-path scheme-libs/racket/unison-runtime ``` OR if you want to run the same tests in interpreted mode: @@ -31,7 +81,9 @@ OR if you want to run the same tests in interpreted mode: ./unison-src/builtin-tests/interpreter-tests.sh ``` -The above scripts fetch and cache a copy of base and the scheme-generating libraries, and copy this directory to `$XDG_DATA_DIRECTORY/unisonlanguage/scheme-libs`. +The above scripts fetch and cache a copy of base and the scheme-generating +libraries, and copy this directory to `$XDG_DATA_DIRECTORY/unisonlanguage/scheme-libs`. +Both scripts _should_ pass. ## Iterating more quickly diff --git a/unison-src/transcripts-manual/gen-racket-libs.md b/unison-src/transcripts-manual/gen-racket-libs.md index 178503c969..311d056641 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.md +++ b/unison-src/transcripts-manual/gen-racket-libs.md @@ -20,12 +20,11 @@ complement of unison libraries for a given combination of ucm version and @unison/internal version. To set up racket to use these files, we need to create a package with -them. This is accomplished by running. +them. This is accomplished by running: - raco pkg install -t dir unison + raco pkg install -t dir scheme-libs/racket/unison -in the directory where the `unison` directory is located. Then the -runtime executable can be built with +After, the runtime executable can be built with raco exe scheme-libs/racket/unison-runtime.rkt From 05362b87d065015080c8096508bc7182d02a07c1 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Sat, 13 Jul 2024 10:11:24 +0100 Subject: [PATCH 475/631] update command for integration tests in docs --- development.markdown | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/development.markdown b/development.markdown index fa5d613b84..d6d3eb1df0 100644 --- a/development.markdown +++ b/development.markdown @@ -42,7 +42,7 @@ Some tests are executables instead: * `stack exec transcripts` runs the transcripts-related integration tests, found in `unison-src/transcripts`. You can add more tests to this directory. * `stack exec transcripts -- prefix-of-filename` runs only transcript tests with a matching filename prefix. -* `stack exec integration-tests` runs the additional integration tests for cli. These tests are not triggered by `tests` or `transcripts`. +* `stack exec cli-integration-tests` runs the additional integration tests for cli. These tests are not triggered by `tests` or `transcripts`. * `stack exec unison -- transcript unison-src/transcripts-round-trip/main.md` runs the pretty-printing round trip tests * `stack exec unison -- transcript unison-src/transcripts-manual/benchmarks.md` runs the benchmark suite. Output goes in unison-src/transcripts-manual/benchmarks/output.txt. From 55560e58ca4c5f3ed881633e7b20dd2d5d16327b Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Thu, 18 Jul 2024 00:29:03 +0100 Subject: [PATCH 476/631] update transcripts-manual/gen-racket-libs.output.md --- .../gen-racket-libs.output.md | 26 ++++++++++++------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/unison-src/transcripts-manual/gen-racket-libs.output.md b/unison-src/transcripts-manual/gen-racket-libs.output.md index 1e003ab489..178d4b6f4e 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.output.md +++ b/unison-src/transcripts-manual/gen-racket-libs.output.md @@ -1,22 +1,21 @@ - When we start out, `./scheme-libs/racket` contains a bunch of library files that we'll need. They define the Unison builtins for Racket. Next, we'll download the jit project and generate a few Racket files from it. -```ucm +``` ucm jit-setup/main> lib.install @unison/internal/releases/0.0.18 - Downloaded 14917 entities. + Downloaded 14949 entities. I installed @unison/internal/releases/0.0.18 as unison_internal_0_0_18. ``` -```unison +``` unison go = generateSchemeBoot "scheme-libs/racket" ``` -```ucm +``` ucm Loading changes detected in scratch.u. @@ -29,7 +28,7 @@ go = generateSchemeBoot "scheme-libs/racket" go : '{IO, Exception} () ``` -```ucm +``` ucm jit-setup/main> run go () @@ -42,16 +41,23 @@ and @unison/internal version. To set up racket to use these files, we need to create a package with them. This is accomplished by running. - raco pkg install -t dir unison +``` +raco pkg install -t dir unison +``` -in the directory where the `unison directory is located. Then the +in the directory where the `unison` directory is located. Then the runtime executable can be built with - raco exe scheme-libs/racket/unison-runtime.rkt +``` +raco exe scheme-libs/racket/unison-runtime.rkt +``` and a distributable directory can be produced with: - raco distribute scheme-libs/racket/unison-runtime +``` +raco distribute scheme-libs/racket/unison-runtime +``` At that point, should contain the executable and all dependencies necessary to run it. + From 7ed45f6cd77b3d724503e30ff1050052b5ed6269 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Thu, 18 Jul 2024 00:44:22 +0100 Subject: [PATCH 477/631] minor fixups --- scheme-libs/racket/unison/Readme.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/scheme-libs/racket/unison/Readme.md b/scheme-libs/racket/unison/Readme.md index 3984146df9..f84d73e57f 100644 --- a/scheme-libs/racket/unison/Readme.md +++ b/scheme-libs/racket/unison/Readme.md @@ -25,8 +25,8 @@ You'll need to have a couple things installed on your system: In particular, our crypto functions require on both `libcrypto` (from openssl) and `libb2`. You may have to tell racket where to find `libb2`, -by adding an entry to the hash table in your -[`config.rktd` file](https://docs.racket-lang.org/raco/config-file.html). +by adding an entry to the hash table in your `config.rktd` +[file](https://docs.racket-lang.org/raco/config-file.html). This is what I had, for an M1 mac w/ `libb2` installed via Homebrew: ``` $ cat scheme-libs/racket/config/config.rktd @@ -46,7 +46,7 @@ First, make sure unison is built (see [development](../../../development.markdow Next, use unison to generate the racket libraries. These are dependencies for building `unison-runtime`. -* Read [gen-racket-libs.md](../../../../unison-src-transcripts-manual/gen-racket-libs.md). +* Read [gen-racket-libs.md](../../../unison-src/transcripts-manual/gen-racket-libs.md). It will contain two things: * `ucm` and `unison` transcripts that generate the libraries * Instructions on how to build `unison-runtime` using `raco` From c657e589240c511394b77caf6df8a36c6dd8c6bb Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Thu, 18 Jul 2024 00:50:16 +0100 Subject: [PATCH 478/631] remove extra word and mention libressl --- scheme-libs/racket/unison/Readme.md | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/scheme-libs/racket/unison/Readme.md b/scheme-libs/racket/unison/Readme.md index f84d73e57f..c8f7e76eb4 100644 --- a/scheme-libs/racket/unison/Readme.md +++ b/scheme-libs/racket/unison/Readme.md @@ -22,12 +22,11 @@ You'll need to have a couple things installed on your system: * [Racket](https://racket-lang.org/), with the executable `racket` on your path somewhere * [BLAKE2](https://github.com/BLAKE2/libb2) (you may need to install this manually) - -In particular, our crypto functions require on both `libcrypto` (from -openssl) and `libb2`. You may have to tell racket where to find `libb2`, -by adding an entry to the hash table in your `config.rktd` -[file](https://docs.racket-lang.org/raco/config-file.html). -This is what I had, for an M1 mac w/ `libb2` installed via Homebrew: +In particular, our crypto functions require both `libcrypto` (from openssl or +eg. libressl) and `libb2`. You may have to tell racket where to find `libb2`, by +adding an entry to the hash table in your +[`config.rktd` file](https://docs.racket-lang.org/raco/config-file.html). +This is what I had, for an M1 mac with `libb2` installed via Homebrew: ``` $ cat scheme-libs/racket/config/config.rktd #hash( From b8f1ed988ac81a2560a902d6c63c7eec817fb040 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 18 Jul 2024 17:48:40 -0600 Subject: [PATCH 479/631] Run Ormolu over the entire codebase With #5142, Ormolu was upgraded from 0.5.2.0 to 0.7.2.0. This formats the codebase to avoid spurious formatting comingled in other commits. Almost all of the changes are simply wrapping single constraints in parens, like ```diff -hashBranch :: forall m. Monad m => Branch m -> m BranchHash +hashBranch :: forall m. (Monad m) => Branch m -> m BranchHash ``` There is also some reordering of language pragmas and imports, indentation correction (some of which gets precedence wrong), and switching some Haddock from `-- ^` to `-- |` . --- .../src/U/Codebase/Branch/Hashing.hs | 2 +- .../src/Unison/Hashing/V2/Convert2.hs | 4 +- .../U/Codebase/Sqlite/Decode.hs | 2 +- .../U/Codebase/Sqlite/HashHandle.hs | 2 +- .../U/Codebase/Sqlite/LocalizeObject.hs | 24 +++++----- .../U/Codebase/Sqlite/NamedRef.hs | 2 +- .../U/Codebase/Sqlite/Patch/Full.hs | 2 +- .../U/Codebase/Sqlite/Queries.hs | 2 +- .../U/Codebase/Sqlite/Serialization.hs | 6 +-- codebase2/codebase/U/Codebase/Causal.hs | 4 +- codebase2/codebase/U/Codebase/Decl.hs | 6 +-- codebase2/codebase/U/Codebase/Term.hs | 4 +- codebase2/core/Unison/NameSegment/Internal.hs | 13 ++--- codebase2/core/Unison/Util/Alphabetical.hs | 4 +- .../U/Util/Serialization.hs | 2 +- lib/unison-prelude/src/Unison/Prelude.hs | 2 +- lib/unison-prelude/src/Unison/Util/Map.hs | 16 +++---- lib/unison-prelude/src/Unison/Util/Tuple.hs | 2 +- .../src/Unison/Sqlite/Connection.hs | 4 +- .../src/Unison/Sqlite/Exception.hs | 2 +- lib/unison-sqlite/src/Unison/Sqlite/Sql.hs | 2 +- .../src/Unison/Sqlite/Transaction.hs | 18 +++---- lib/unison-util-bytes/test/Main.hs | 2 +- .../src/Unison/Util/BiMultimap.hs | 18 +++---- .../src/U/Codebase/Branch/Diff.hs | 2 +- .../src/Unison/Builtin/Decls.hs | 4 +- .../src/Unison/Codebase/Branch.hs | 2 +- .../src/Unison/Codebase/BranchUtil.hs | 2 +- .../Codebase/SqliteCodebase/Migrations.hs | 6 +-- .../Codebase/SqliteCodebase/Operations.hs | 2 +- .../Unison/DataDeclaration/Dependencies.hs | 2 +- .../src/Unison/KindInference.hs | 2 +- .../Unison/KindInference/Constraint/Pretty.hs | 16 +++---- .../src/Unison/KindInference/Error.hs | 34 ++++++------- .../src/Unison/KindInference/Error/Pretty.hs | 2 +- .../src/Unison/KindInference/Generate.hs | 4 +- .../Unison/KindInference/Generate/Monad.hs | 10 ++-- .../src/Unison/KindInference/Solve.hs | 26 +++++----- .../src/Unison/KindInference/Solve/Monad.hs | 6 +-- parser-typechecker/src/Unison/Parsers.hs | 2 +- .../Unison/PatternMatchCoverage/Constraint.hs | 12 ++--- .../Unison/PatternMatchCoverage/Literal.hs | 12 ++--- .../NormalizedConstraints.hs | 8 ++-- .../src/Unison/PatternMatchCoverage/PmGrd.hs | 28 +++++------ parser-typechecker/src/Unison/Result.hs | 2 +- parser-typechecker/src/Unison/Runtime/ANF.hs | 48 ++++++++++--------- .../src/Unison/Runtime/ANF/Rehash.hs | 8 ++-- .../src/Unison/Runtime/ANF/Serialize.hs | 6 +-- .../src/Unison/Runtime/Array.hs | 2 +- .../src/Unison/Runtime/Exception.hs | 2 +- .../src/Unison/Runtime/Interface.hs | 6 +-- .../src/Unison/Runtime/Serialize.hs | 16 +++---- .../src/Unison/Syntax/FileParser.hs | 4 +- .../src/Unison/Syntax/TermPrinter.hs | 12 +++-- .../src/Unison/Syntax/TypeParser.hs | 2 +- parser-typechecker/src/Unison/Typechecker.hs | 2 +- .../src/Unison/Typechecker/Context.hs | 6 +-- parser-typechecker/src/Unison/UnisonFile.hs | 28 +++++++---- .../src/Unison/UnisonFile/Names.hs | 4 +- parser-typechecker/src/Unison/Util/Text.hs | 21 ++++---- .../tests/Unison/Test/Util/Text.hs | 2 +- unison-cli/src/Unison/Cli/DownloadUtils.hs | 2 +- .../src/Unison/Cli/ServantClientUtils.hs | 12 ++--- .../Editor/HandleInput/DebugSynhashTerm.hs | 6 +-- .../Codebase/Editor/HandleInput/FormatFile.hs | 4 +- .../Codebase/Editor/HandleInput/Merge2.hs | 2 +- .../Codebase/Editor/HandleInput/Tests.hs | 18 +++---- .../Codebase/Editor/HandleInput/Update2.hs | 4 +- .../src/Unison/Codebase/Editor/Input.hs | 4 +- .../src/Unison/Codebase/Editor/Output.hs | 16 +++---- .../src/Unison/Codebase/Editor/UriParser.hs | 6 ++- .../src/Unison/CommandLine/InputPatterns.hs | 4 +- unison-cli/src/Unison/LSP/Configuration.hs | 2 +- unison-cli/src/Unison/LSP/Queries.hs | 1 - unison-core/src/Unison/ABT.hs | 3 +- unison-core/src/Unison/Name/Internal.hs | 13 ++--- unison-core/src/Unison/Names.hs | 2 +- unison-core/src/Unison/Util/Defns.hs | 2 +- unison-core/src/Unison/Util/Nametree.hs | 6 +-- unison-core/src/Unison/Var.hs | 2 +- unison-merge/src/Unison/Merge/CombineDiffs.hs | 2 +- unison-merge/src/Unison/Merge/Database.hs | 2 +- .../src/Unison/Merge/DeclCoherencyCheck.hs | 14 +++--- .../src/Unison/Merge/DeclNameLookup.hs | 4 +- unison-merge/src/Unison/Merge/Diff.hs | 6 +-- unison-merge/src/Unison/Merge/Libdeps.hs | 4 +- .../Unison/Merge/PartitionCombinedDiffs.hs | 5 +- unison-merge/src/Unison/Merge/Synhash.hs | 22 ++++----- unison-merge/src/Unison/Merge/TwoWay.hs | 2 +- unison-share-api/src/Unison/Server/Backend.hs | 14 +++--- .../Unison/Server/Backend/DefinitionDiff.hs | 2 +- .../src/Unison/Server/Local/Endpoints/UCM.hs | 2 +- unison-syntax/src/Unison/Lexer/Pos.hs | 2 +- .../src/Unison/Syntax/HashQualified.hs | 2 +- .../src/Unison/Syntax/HashQualifiedPrime.hs | 2 +- unison-syntax/src/Unison/Syntax/Name.hs | 8 ++-- unison-syntax/src/Unison/Syntax/Parser.hs | 16 +++---- 97 files changed, 370 insertions(+), 346 deletions(-) diff --git a/codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs b/codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs index f8f7dc29e0..4085b8d784 100644 --- a/codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs +++ b/codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs @@ -10,7 +10,7 @@ import U.Codebase.HashTags import Unison.Hashing.V2 qualified as Hashing import Unison.Hashing.V2.Convert2 (convertBranchV3, v2ToH2Branch) -hashBranch :: forall m. Monad m => Branch m -> m BranchHash +hashBranch :: forall m. (Monad m) => Branch m -> m BranchHash hashBranch branch = BranchHash . Hashing.contentHash <$> v2ToH2Branch branch diff --git a/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs b/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs index 53b4b72473..3ab63459b7 100644 --- a/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs +++ b/codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs @@ -100,7 +100,7 @@ v2ToH2Referent = \case V2Referent.Ref r -> H2.ReferentRef (v2ToH2Reference r) V2Referent.Con r cid -> H2.ReferentCon (v2ToH2Reference r) cid -v2ToH2Branch :: Monad m => V2.Branch m -> m H2.Branch +v2ToH2Branch :: (Monad m) => V2.Branch m -> m H2.Branch v2ToH2Branch V2.Branch {terms, types, patches, children} = do hterms <- traverse sequenceA terms @@ -166,7 +166,7 @@ hashPatchFormatToH2Patch Memory.PatchFull.Patch {termEdits, typeEdits} = V2Referent.Con typeRef conId -> do (H2.ReferentCon (v2ToH2Reference $ second unComponentHash typeRef) conId) -v2ToH2Term :: forall v. Ord v => V2.Term.HashableTerm v -> H2.Term v () +v2ToH2Term :: forall v. (Ord v) => V2.Term.HashableTerm v -> H2.Term v () v2ToH2Term = ABT.transform convertF where convertF :: V2.Term.F' Text V2.Term.HashableTermRef V2.Term.TypeRef V2.Term.HashableTermLink V2.Term.TypeLink v a1 -> H2.TermF v () () a1 diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs index afb2a54c26..c2df6ef2f6 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Decode.hs @@ -173,7 +173,7 @@ decodeWatchResultFormat = ------------------------------------------------------------------------------------------------------------------------ -- unsyncs -unsyncTermComponent :: HasCallStack => TermFormat.SyncLocallyIndexedComponent' t d -> Either DecodeError (TermFormat.LocallyIndexedComponent' t d) +unsyncTermComponent :: (HasCallStack) => TermFormat.SyncLocallyIndexedComponent' t d -> Either DecodeError (TermFormat.LocallyIndexedComponent' t d) unsyncTermComponent (TermFormat.SyncLocallyIndexedComponent terms) = do let phi (localIds, bs) = do (a, b) <- decodeSyncTermAndType bs diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/HashHandle.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/HashHandle.hs index 028c4d827f..6c0c264265 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/HashHandle.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/HashHandle.hs @@ -39,7 +39,7 @@ data HashHandle = HashHandle toReferenceDecl :: Hash -> C.Type.TypeD Symbol -> C.Reference, -- | Hash decl's mentions toReferenceDeclMentions :: Hash -> C.Type.TypeD Symbol -> Set C.Reference, - hashBranch :: forall m. Monad m => Branch m -> m BranchHash, + hashBranch :: forall m. (Monad m) => Branch m -> m BranchHash, hashBranchV3 :: forall m. BranchV3 m -> BranchHash, hashCausal :: -- The causal's namespace hash diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalizeObject.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalizeObject.hs index 74228c5d9b..4319249f4b 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalizeObject.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalizeObject.hs @@ -109,23 +109,23 @@ localizePatchG (Patch termEdits typeEdits) = -- General-purpose localization -- Contains references to branch objects. -class Ord c => ContainsBranches c s where +class (Ord c) => ContainsBranches c s where branches_ :: Lens' s (Map c LocalBranchChildId) -- Contains references to definition objects i.e. term/decl component objects. -class Ord d => ContainsDefns d s where +class (Ord d) => ContainsDefns d s where defns_ :: Lens' s (Map d LocalDefnId) -- Contains references to objects by their hash. -class Ord h => ContainsHashes h s where +class (Ord h) => ContainsHashes h s where hashes_ :: Lens' s (Map h LocalHashId) -- Contains references to patch objects. -class Ord p => ContainsPatches p s where +class (Ord p) => ContainsPatches p s where patches_ :: Lens' s (Map p LocalPatchObjectId) -- Contains text. -class Ord t => ContainsText t s where +class (Ord t) => ContainsText t s where texts_ :: Lens' s (Map t LocalTextId) -- The inner state of the localization of a branch object. @@ -137,16 +137,16 @@ data LocalizeBranchState t d p c = LocalizeBranchState } deriving (Show, Generic) -instance Ord t => ContainsText t (LocalizeBranchState t d p c) where +instance (Ord t) => ContainsText t (LocalizeBranchState t d p c) where texts_ = field @"texts" -instance Ord d => ContainsDefns d (LocalizeBranchState t d p c) where +instance (Ord d) => ContainsDefns d (LocalizeBranchState t d p c) where defns_ = field @"defns" -instance Ord p => ContainsPatches p (LocalizeBranchState t d p c) where +instance (Ord p) => ContainsPatches p (LocalizeBranchState t d p c) where patches_ = field @"patches" -instance Ord c => ContainsBranches c (LocalizeBranchState t d p c) where +instance (Ord c) => ContainsBranches c (LocalizeBranchState t d p c) where branches_ = field @"branches" -- | Run a computation that localizes a branch object, returning the local ids recorded within. @@ -171,13 +171,13 @@ data LocalizePatchState t h d = LocalizePatchState } deriving (Show, Generic) -instance Ord t => ContainsText t (LocalizePatchState t h d) where +instance (Ord t) => ContainsText t (LocalizePatchState t h d) where texts_ = field @"texts" -instance Ord h => ContainsHashes h (LocalizePatchState t h d) where +instance (Ord h) => ContainsHashes h (LocalizePatchState t h d) where hashes_ = field @"hashes" -instance Ord d => ContainsDefns d (LocalizePatchState t h d) where +instance (Ord d) => ContainsDefns d (LocalizePatchState t h d) where defns_ = field @"defns" -- Run a computation that localizes a patch object, returning the local ids recorded within. diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/NamedRef.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/NamedRef.hs index 2528aa177c..1f91746219 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/NamedRef.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/NamedRef.hs @@ -58,7 +58,7 @@ instance (FromRow ref) => FromRow (NamedRef ref) where newtype ScopedRow ref = ScopedRow (NamedRef ref) -instance ToRow ref => ToRow (ScopedRow ref) where +instance (ToRow ref) => ToRow (ScopedRow ref) where toRow (ScopedRow (NamedRef {reversedSegments = revSegments, ref})) = SQLText reversedName : SQLText namespace : SQLText lastNameSegment : toRow ref where diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs index b2f1366932..749a87290c 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs @@ -55,7 +55,7 @@ patchT_ f Patch {termEdits, typeEdits} = do newTypeEdits <- traverseOf (Map.bitraversed (Reference.t_) (Set.traverse . traverseFirst)) f typeEdits pure Patch {termEdits = newTermEdits, typeEdits = newTypeEdits} where - traverseFirst :: Bitraversable b => Traversal (b a c) (b a' c) a a' + traverseFirst :: (Bitraversable b) => Traversal (b a c) (b a' c) a a' traverseFirst f = bitraverse f pure patchH_ :: (Ord t, Ord h') => Traversal (Patch' t h o) (Patch' t h' o) h h' diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 241d351574..822cdd125e 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -289,7 +289,7 @@ module U.Codebase.Sqlite.Queries -- * Types NamespaceText, TextPathSegments, - JsonParseFailure(..), + JsonParseFailure (..), ) where diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs index 98554c38d1..55c3213f4a 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs @@ -462,7 +462,7 @@ putDeclFormat = \case putDeclComponent (DeclFormat.LocallyIndexedComponent v) = putFramedArray (putPair putLocalIds putDeclElement) v -putDeclElement :: MonadPut m => Decl.DeclR DeclFormat.TypeRef Symbol -> m () +putDeclElement :: (MonadPut m) => Decl.DeclR DeclFormat.TypeRef Symbol -> m () putDeclElement Decl.DataDeclaration {..} = do putDeclType declType putModifier modifier @@ -499,7 +499,7 @@ getDeclElement = 1 -> pure Decl.Effect other -> unknownTag "DeclType" other -getModifier :: MonadGet m => m Modifier +getModifier :: (MonadGet m) => m Modifier getModifier = getWord8 >>= \case 0 -> pure Decl.Structural @@ -720,7 +720,7 @@ getLocalBranch = x -> unknownTag "getMetadataSetFormat" x getBranchDiff' :: - MonadGet m => + (MonadGet m) => m branchRef -> m (BranchFormat.BranchLocalIds' text defRef patchRef childRef) -> m (BranchFormat.BranchFormat' text defRef patchRef childRef branchRef) diff --git a/codebase2/codebase/U/Codebase/Causal.hs b/codebase2/codebase/U/Codebase/Causal.hs index aad0d36fa0..74e4c1fcf0 100644 --- a/codebase2/codebase/U/Codebase/Causal.hs +++ b/codebase2/codebase/U/Codebase/Causal.hs @@ -19,11 +19,11 @@ data Causal m hc he pe e = Causal } deriving stock (Functor, Generic) -instance Eq hc => Eq (Causal m hc he pe e) where +instance (Eq hc) => Eq (Causal m hc he pe e) where (==) = (==) `on` causalHash -- | @emap f g@ maps over the values and parents' values with @f@ and @g@. -emap :: Functor m => (e -> e') -> (pe -> pe') -> Causal m hc he pe e -> Causal m hc he pe' e' +emap :: (Functor m) => (e -> e') -> (pe -> pe') -> Causal m hc he pe e -> Causal m hc he pe' e' emap f g causal@Causal {parents, value} = causal { parents = Map.map (fmap (emap g g)) parents, diff --git a/codebase2/codebase/U/Codebase/Decl.hs b/codebase2/codebase/U/Codebase/Decl.hs index 26172ed1db..7a46ea9fc0 100644 --- a/codebase2/codebase/U/Codebase/Decl.hs +++ b/codebase2/codebase/U/Codebase/Decl.hs @@ -41,11 +41,11 @@ data DeclR r v = DataDeclaration } deriving (Show) -allVars :: Ord v => DeclR r v -> Set v +allVars :: (Ord v) => DeclR r v -> Set v allVars (DataDeclaration _ _ bound constructorTypes) = (Set.fromList $ foldMap ABT.allVars constructorTypes) <> Set.fromList bound -vmap :: Ord v' => (v -> v') -> DeclR r v -> DeclR r v' +vmap :: (Ord v') => (v -> v') -> DeclR r v -> DeclR r v' vmap f (DataDeclaration {declType, modifier, bound, constructorTypes}) = DataDeclaration { declType, @@ -82,7 +82,7 @@ data F a -- to the relevant piece of the component in the component map. unhashComponent :: forall v extra. - ABT.Var v => + (ABT.Var v) => Hash -> -- | A function to convert a reference to a variable. The actual var names aren't important. (Reference.Id -> v) -> diff --git a/codebase2/codebase/U/Codebase/Term.hs b/codebase2/codebase/U/Codebase/Term.hs index 3af9a5faff..57691ba6ec 100644 --- a/codebase2/codebase/U/Codebase/Term.hs +++ b/codebase2/codebase/U/Codebase/Term.hs @@ -207,7 +207,7 @@ extraMapM ftext ftermRef ftypeRef ftermLink ftypeLink fvt = go' rmapPattern :: (t -> t') -> (r -> r') -> Pattern t r -> Pattern t' r' rmapPattern ft fr p = runIdentity . rmapPatternM (pure . ft) (pure . fr) $ p -rmapPatternM :: Applicative m => (t -> m t') -> (r -> m r') -> Pattern t r -> m (Pattern t' r') +rmapPatternM :: (Applicative m) => (t -> m t') -> (r -> m r') -> Pattern t r -> m (Pattern t' r') rmapPatternM ft fr = go where go = \case @@ -260,7 +260,7 @@ dependencies = -- to the relevant piece of the component in the component map. unhashComponent :: forall v extra. - ABT.Var v => + (ABT.Var v) => -- | The hash of the component, this is used to fill in self-references. Hash -> -- | A function to convert a reference to a variable. The actual var names aren't important. diff --git a/codebase2/core/Unison/NameSegment/Internal.hs b/codebase2/core/Unison/NameSegment/Internal.hs index 9ecc1ff43b..a7c108c4a5 100644 --- a/codebase2/core/Unison/NameSegment/Internal.hs +++ b/codebase2/core/Unison/NameSegment/Internal.hs @@ -27,12 +27,13 @@ newtype NameSegment = NameSegment deriving newtype (Alphabetical) instance - TypeError - ( 'TypeError.Text "You cannot implicitly convert a ‘String’ to a ‘NameSegment’. If you need a" - ':$$: 'TypeError.Text "special-cased segment it should exist as a constant in" - ':$$: 'TypeError.Text "“Unison.NameSegment”, otherwise it should be parsed via" - ':$$: 'TypeError.Text "“Unison.Syntax.NameSegment”." - ) => + ( TypeError + ( 'TypeError.Text "You cannot implicitly convert a ‘String’ to a ‘NameSegment’. If you need a" + ':$$: 'TypeError.Text "special-cased segment it should exist as a constant in" + ':$$: 'TypeError.Text "“Unison.NameSegment”, otherwise it should be parsed via" + ':$$: 'TypeError.Text "“Unison.Syntax.NameSegment”." + ) + ) => IsString NameSegment where fromString = undefined diff --git a/codebase2/core/Unison/Util/Alphabetical.hs b/codebase2/core/Unison/Util/Alphabetical.hs index b87bfea3f7..1c84ead241 100644 --- a/codebase2/core/Unison/Util/Alphabetical.hs +++ b/codebase2/core/Unison/Util/Alphabetical.hs @@ -18,10 +18,10 @@ import Data.Text (Text) class (Eq n) => Alphabetical n where compareAlphabetical :: n -> n -> Ordering -sortAlphabetically :: Alphabetical a => [a] -> [a] +sortAlphabetically :: (Alphabetical a) => [a] -> [a] sortAlphabetically as = (\(OrderAlphabetically a) -> a) <$> List.sort (map OrderAlphabetically as) -sortAlphabeticallyOn :: Alphabetical a => (b -> a) -> [b] -> [b] +sortAlphabeticallyOn :: (Alphabetical a) => (b -> a) -> [b] -> [b] sortAlphabeticallyOn f = List.sortOn (OrderAlphabetically . f) instance Alphabetical Text where diff --git a/codebase2/util-serialization/U/Util/Serialization.hs b/codebase2/util-serialization/U/Util/Serialization.hs index 82d49e1408..2d4f1bd7ae 100644 --- a/codebase2/util-serialization/U/Util/Serialization.hs +++ b/codebase2/util-serialization/U/Util/Serialization.hs @@ -154,7 +154,7 @@ getVector getA = do length <- getVarInt Vector.replicateM length getA -skipVector :: MonadGet m => m a -> m () +skipVector :: (MonadGet m) => m a -> m () skipVector getA = do length <- getVarInt replicateM_ length getA diff --git a/lib/unison-prelude/src/Unison/Prelude.hs b/lib/unison-prelude/src/Unison/Prelude.hs index 0ddd4aee64..374f4a1812 100644 --- a/lib/unison-prelude/src/Unison/Prelude.hs +++ b/lib/unison-prelude/src/Unison/Prelude.hs @@ -102,7 +102,7 @@ import Witch as X (From (from), TryFrom (tryFrom), TryFromException (TryFromExce import Witherable as X (filterA, forMaybe, mapMaybe, wither, witherMap) -- | Can be removed when we upgrade transformers to a more recent version. -hoistMaybe :: Applicative m => Maybe a -> MaybeT m a +hoistMaybe :: (Applicative m) => Maybe a -> MaybeT m a hoistMaybe = MaybeT . pure -- | Like 'fold' but for Alternative. diff --git a/lib/unison-prelude/src/Unison/Util/Map.hs b/lib/unison-prelude/src/Unison/Util/Map.hs index be67d730b3..49cf1e7c36 100644 --- a/lib/unison-prelude/src/Unison/Util/Map.hs +++ b/lib/unison-prelude/src/Unison/Util/Map.hs @@ -41,7 +41,7 @@ import Data.Vector qualified as Vector import Unison.Prelude hiding (bimap, foldM, for_) -- | A common case of @Map.merge@. Like @alignWith@, but includes the key. -alignWithKey :: Ord k => (k -> These a b -> c) -> Map k a -> Map k b -> Map k c +alignWithKey :: (Ord k) => (k -> These a b -> c) -> Map k a -> Map k b -> Map k c alignWithKey f = Map.merge (Map.mapMissing \k x -> f k (This x)) @@ -60,7 +60,7 @@ bitraversed keyT valT f m = -- | Traverse a map as a list of key-value pairs. -- Note: This can have unexpected results if the result contains duplicate keys. -asList_ :: Ord k' => Traversal (Map k v) (Map k' v') [(k, v)] [(k', v')] +asList_ :: (Ord k') => Traversal (Map k v) (Map k' v') [(k, v)] [(k', v')] asList_ f s = s & Map.toList @@ -73,13 +73,13 @@ swap = Map.foldlWithKey' (\z a b -> Map.insert b a z) mempty -- | Like 'Map.insert', but returns the old value as well. -insertLookup :: Ord k => k -> v -> Map k v -> (Maybe v, Map k v) +insertLookup :: (Ord k) => k -> v -> Map k v -> (Maybe v, Map k v) insertLookup k v = upsertLookup (const v) k -- | Invert a map's keys and values. This probably only makes sense with injective maps, but otherwise, later key/value -- pairs (ordered by the original map's keys) overwrite earlier ones. -invert :: Ord v => Map k v -> Map v k +invert :: (Ord v) => Map k v -> Map v k invert = Map.foldlWithKey' (\m k v -> Map.insert v k m) Map.empty @@ -94,7 +94,7 @@ upsertF f = Map.alterF (fmap Just . f) -- | Like 'upsert', but returns the old value as well. -upsertLookup :: Ord k => (Maybe v -> v) -> k -> Map k v -> (Maybe v, Map k v) +upsertLookup :: (Ord k) => (Maybe v -> v) -> k -> Map k v -> (Maybe v, Map k v) upsertLookup f = upsertF (\v -> (v, f v)) @@ -113,12 +113,12 @@ deleteLookupJust = Map.alterF (maybe (error (reportBug "E525283" "deleteLookupJust: element not found")) (,Nothing)) -- | Like 'Map.elems', but return the values as a set. -elemsSet :: Ord v => Map k v -> Set v +elemsSet :: (Ord v) => Map k v -> Set v elemsSet = Set.fromList . Map.elems -- | Like 'Map.foldlWithKey'', but with a monadic accumulator. -foldM :: Monad m => (acc -> k -> v -> m acc) -> acc -> Map k v -> m acc +foldM :: (Monad m) => (acc -> k -> v -> m acc) -> acc -> Map k v -> m acc foldM f acc0 = go acc0 where @@ -141,7 +141,7 @@ foldMapM f = pure $! Map.insert k v acc -- | Run a monadic action for each key/value pair in a map. -for_ :: Monad m => Map k v -> (k -> v -> m ()) -> m () +for_ :: (Monad m) => Map k v -> (k -> v -> m ()) -> m () for_ m f = go m where diff --git a/lib/unison-prelude/src/Unison/Util/Tuple.hs b/lib/unison-prelude/src/Unison/Util/Tuple.hs index 2a9fbfb52d..c317e41ffc 100644 --- a/lib/unison-prelude/src/Unison/Util/Tuple.hs +++ b/lib/unison-prelude/src/Unison/Util/Tuple.hs @@ -1,6 +1,6 @@ {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} -- | Tuple utils. module Unison.Util.Tuple diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs b/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs index 7b8a077b20..48167980db 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs @@ -151,7 +151,7 @@ logQuery (Sql sql params) result = -- Without results -execute :: HasCallStack => Connection -> Sql -> IO () +execute :: (HasCallStack) => Connection -> Sql -> IO () execute conn@(Connection _ _ conn0) sql@(Sql s params) = do logQuery sql Nothing doExecute `catch` \(exception :: Sqlite.SQLError) -> @@ -171,7 +171,7 @@ execute conn@(Connection _ _ conn0) sql@(Sql s params) = do -- | Execute one or more semicolon-delimited statements. -- -- This function does not support parameters, and is mostly useful for executing DDL and migrations. -executeStatements :: HasCallStack => Connection -> Text -> IO () +executeStatements :: (HasCallStack) => Connection -> Text -> IO () executeStatements conn@(Connection _ _ (Sqlite.Connection database _tempNameCounter)) sql = do logQuery (Sql sql []) Nothing Direct.Sqlite.exec database sql `catch` \(exception :: Sqlite.SQLError) -> diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs b/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs index a573727461..e1473edfc2 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Exception.hs @@ -138,7 +138,7 @@ data SqliteQueryExceptionInfo = SqliteQueryExceptionInfo exception :: SomeSqliteExceptionReason } -throwSqliteQueryException :: HasCallStack => SqliteQueryExceptionInfo -> IO a +throwSqliteQueryException :: (HasCallStack) => SqliteQueryExceptionInfo -> IO a throwSqliteQueryException SqliteQueryExceptionInfo {connection, exception, sql = Sql sql params} = do threadId <- myThreadId throwIO diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Sql.hs b/lib/unison-sqlite/src/Unison/Sqlite/Sql.hs index 97ee636022..475cb0318a 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Sql.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Sql.hs @@ -193,7 +193,7 @@ sqlQQ input = Nothing -> fail ("Not in scope: " ++ Text.unpack var) Just name -> (,) <$> [|valuesSql $(TH.varE name)|] <*> [|foldMap Sqlite.Simple.toRow $(TH.varE name)|] -inSql :: Sqlite.Simple.ToField a => [a] -> Text +inSql :: (Sqlite.Simple.ToField a) => [a] -> Text inSql scalars = Text.Builder.run ("IN (" <> b_commaSep (map (\_ -> b_qmark) scalars) <> b_rparen) diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs b/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs index e40f4a7639..b44a04b0fa 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs @@ -66,11 +66,11 @@ newtype Transaction a -- Omit MonadThrow instance so we always throw SqliteException (via *Check) with lots of context deriving (Applicative, Functor, Monad) via (ReaderT Connection IO) -instance Monoid a => Monoid (Transaction a) where - mempty :: Monoid a => Transaction a +instance (Monoid a) => Monoid (Transaction a) where + mempty :: (Monoid a) => Transaction a mempty = pure mempty -instance Semigroup a => Semigroup (Transaction a) where +instance (Semigroup a) => Semigroup (Transaction a) where (<>) :: Transaction a -> Transaction a -> Transaction a (<>) = liftA2 (<>) @@ -143,7 +143,7 @@ runReadOnlyTransaction conn f = runReadOnlyTransaction_ conn (runInIO (f (\transaction -> liftIO (unsafeUnTransaction transaction conn)))) {-# SPECIALIZE runReadOnlyTransaction :: Connection -> ((forall x. Transaction x -> IO x) -> IO a) -> IO a #-} -runReadOnlyTransaction_ :: HasCallStack => Connection -> IO a -> IO a +runReadOnlyTransaction_ :: (HasCallStack) => Connection -> IO a -> IO a runReadOnlyTransaction_ conn action = do bracketOnError_ (Connection.begin conn) @@ -170,7 +170,7 @@ runWriteTransaction conn f = (runInIO (f (\transaction -> liftIO (unsafeUnTransaction transaction conn)))) {-# SPECIALIZE runWriteTransaction :: Connection -> ((forall x. Transaction x -> IO x) -> IO a) -> IO a #-} -runWriteTransaction_ :: HasCallStack => (forall x. IO x -> IO x) -> Connection -> IO a -> IO a +runWriteTransaction_ :: (HasCallStack) => (forall x. IO x -> IO x) -> Connection -> IO a -> IO a runWriteTransaction_ restore conn transaction = do keepTryingToBeginImmediate restore conn result <- restore transaction `onException` ignoringExceptions (Connection.rollback conn) @@ -178,7 +178,7 @@ runWriteTransaction_ restore conn transaction = do pure result -- @BEGIN IMMEDIATE@ until success. -keepTryingToBeginImmediate :: HasCallStack => (forall x. IO x -> IO x) -> Connection -> IO () +keepTryingToBeginImmediate :: (HasCallStack) => (forall x. IO x -> IO x) -> Connection -> IO () keepTryingToBeginImmediate restore conn = let loop = try @_ @SqliteQueryException (Connection.beginImmediate conn) >>= \case @@ -217,7 +217,7 @@ savepoint (Transaction action) = do -- transaction needs to retry. -- -- /Warning/: attempting to run a transaction inside a transaction will cause an exception! -unsafeIO :: HasCallStack => IO a -> Transaction a +unsafeIO :: (HasCallStack) => IO a -> Transaction a unsafeIO action = Transaction \_ -> action @@ -232,11 +232,11 @@ unsafeUnTransaction (Transaction action) = -- Without results -execute :: HasCallStack => Sql -> Transaction () +execute :: (HasCallStack) => Sql -> Transaction () execute s = Transaction \conn -> Connection.execute conn s -executeStatements :: HasCallStack => Text -> Transaction () +executeStatements :: (HasCallStack) => Text -> Transaction () executeStatements s = Transaction \conn -> Connection.executeStatements conn s diff --git a/lib/unison-util-bytes/test/Main.hs b/lib/unison-util-bytes/test/Main.hs index 6118703e43..0302e6efa5 100644 --- a/lib/unison-util-bytes/test/Main.hs +++ b/lib/unison-util-bytes/test/Main.hs @@ -45,7 +45,7 @@ test = (b1 <> b2 <> b3) `compare` b3 == (b1s <> b2s <> b3s) - `compare` b3s + `compare` b3s scope "take" . expect' $ Bytes.toArray (Bytes.take k (b1s <> b2s)) == BS.take k (b1 <> b2) scope "drop" . expect' $ diff --git a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs index e970281f07..5700d3f11c 100644 --- a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs +++ b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs @@ -62,32 +62,32 @@ data BiMultimap a b = BiMultimap empty :: (Ord a, Ord b) => BiMultimap a b empty = BiMultimap mempty mempty -memberDom :: Ord a => a -> BiMultimap a b -> Bool +memberDom :: (Ord a) => a -> BiMultimap a b -> Bool memberDom x = Map.member x . domain -- | Look up the set of @b@ related to an @a@. -- -- /O(log a)/. -lookupDom :: Ord a => a -> BiMultimap a b -> Set b +lookupDom :: (Ord a) => a -> BiMultimap a b -> Set b lookupDom a = lookupDom_ a . domain -lookupDom_ :: Ord a => a -> Map a (NESet b) -> Set b +lookupDom_ :: (Ord a) => a -> Map a (NESet b) -> Set b lookupDom_ x xs = maybe Set.empty Set.NonEmpty.toSet (Map.lookup x xs) -- | Look up the @a@ related to a @b@. -- -- /O(log b)/. -lookupRan :: Ord b => b -> BiMultimap a b -> Maybe a +lookupRan :: (Ord b) => b -> BiMultimap a b -> Maybe a lookupRan b (BiMultimap _ r) = Map.lookup b r -- | Look up the @a@ related to a @b@. -- -- /O(log b)/. -unsafeLookupRan :: Ord b => b -> BiMultimap a b -> a +unsafeLookupRan :: (Ord b) => b -> BiMultimap a b -> a unsafeLookupRan b (BiMultimap _ r) = r Map.! b @@ -162,11 +162,11 @@ range = toMapR -- | Construct a left-unique relation from a mapping from its left-elements to set-of-right-elements. The caller is -- responsible for ensuring that no right-element is mapped to by two different left-elements. -unsafeFromDomain :: Ord b => Map a (NESet b) -> BiMultimap a b +unsafeFromDomain :: (Ord b) => Map a (NESet b) -> BiMultimap a b unsafeFromDomain domain = BiMultimap domain (invertDomain domain) -invertDomain :: forall a b. Ord b => Map a (NESet b) -> Map b a +invertDomain :: forall a b. (Ord b) => Map a (NESet b) -> Map b a invertDomain = Map.foldlWithKey' f Map.empty where @@ -216,7 +216,7 @@ insert a b m@(BiMultimap l r) = l' = Map.upsert (maybe (Set.NonEmpty.singleton b) (Set.NonEmpty.insert b)) a l -- @upsertFunc x@ returns a function that upserts @x@, suitable for passing to @Map.alterF@. -upsertFunc :: Eq a => a -> Maybe a -> (UpsertResult a, Maybe a) +upsertFunc :: (Eq a) => a -> Maybe a -> (UpsertResult a, Maybe a) upsertFunc new existing = case existing of Nothing -> (Inserted, Just new) @@ -248,7 +248,7 @@ unsafeUnion xs ys = ------------------------------------------------------------------------------------------------------------------------ -- @deriveRangeFromDomain x ys range@ is a helper that inserts @(x, y1)@, @(x, y2)@, ... into range @r@. -deriveRangeFromDomain :: Ord b => a -> NESet b -> Map b a -> Map b a +deriveRangeFromDomain :: (Ord b) => a -> NESet b -> Map b a -> Map b a deriveRangeFromDomain x ys acc = foldr (flip Map.insert x) acc ys {-# INLINE deriveRangeFromDomain #-} diff --git a/parser-typechecker/src/U/Codebase/Branch/Diff.hs b/parser-typechecker/src/U/Codebase/Branch/Diff.hs index c4a7291547..430155a4cc 100644 --- a/parser-typechecker/src/U/Codebase/Branch/Diff.hs +++ b/parser-typechecker/src/U/Codebase/Branch/Diff.hs @@ -78,7 +78,7 @@ instance (Applicative m) => Semigroup (TreeDiff m) where instance (Applicative m) => Monoid (TreeDiff m) where mempty = TreeDiff (mempty :< Compose mempty) -hoistTreeDiff :: Functor m => (forall x. m x -> n x) -> TreeDiff m -> TreeDiff n +hoistTreeDiff :: (Functor m) => (forall x. m x -> n x) -> TreeDiff m -> TreeDiff n hoistTreeDiff f (TreeDiff cfr) = TreeDiff $ Cofree.hoistCofree (\(Compose m) -> Compose (fmap f m)) cfr diff --git a/parser-typechecker/src/Unison/Builtin/Decls.hs b/parser-typechecker/src/Unison/Builtin/Decls.hs index 35d70245d7..a918671d8d 100644 --- a/parser-typechecker/src/Unison/Builtin/Decls.hs +++ b/parser-typechecker/src/Unison/Builtin/Decls.hs @@ -174,13 +174,13 @@ rewriteCaseRef = lookupDeclRef "RewriteCase" pattern RewriteCase' :: Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a pattern RewriteCase' lhs rhs <- (unRewriteCase -> Just (lhs, rhs)) -rewriteCase :: Ord v => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a +rewriteCase :: (Ord v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a rewriteCase a tm1 tm2 = Term.app a (Term.app a1 (Term.constructor a1 r) tm1) tm2 where a1 = ABT.annotation tm1 r = ConstructorReference rewriteCaseRef 0 -rewriteTerm :: Ord v => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a +rewriteTerm :: (Ord v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a rewriteTerm a tm1 tm2 = Term.app a (Term.app a1 (Term.constructor a1 r) tm1) tm2 where a1 = ABT.annotation tm1 diff --git a/parser-typechecker/src/Unison/Codebase/Branch.hs b/parser-typechecker/src/Unison/Codebase/Branch.hs index 00e2f76901..5213694e4a 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch.hs @@ -318,7 +318,7 @@ cons = step . const -- | Construct a two-parent merge node. mergeNode :: forall m. - Applicative m => + (Applicative m) => Branch0 m -> (CausalHash, m (Branch m)) -> (CausalHash, m (Branch m)) -> diff --git a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs index 192bf8147c..e639fd41b0 100644 --- a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs +++ b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs @@ -25,8 +25,8 @@ import Unison.Codebase.Branch (Branch, Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path -import Unison.NameSegment (NameSegment) import Unison.HashQualifiedPrime (HashQualified (HashQualified, NameOnly)) +import Unison.NameSegment (NameSegment) import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Prelude diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 5244facbf8..9052e5511a 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -115,9 +115,9 @@ checkCodebaseIsUpToDate = do -- The highest schema that this ucm knows how to migrate to. pure $ if - | schemaVersion == Q.currentSchemaVersion -> CodebaseUpToDate - | schemaVersion < Q.currentSchemaVersion -> CodebaseRequiresMigration schemaVersion Q.currentSchemaVersion - | otherwise -> CodebaseUnknownSchemaVersion schemaVersion + | schemaVersion == Q.currentSchemaVersion -> CodebaseUpToDate + | schemaVersion < Q.currentSchemaVersion -> CodebaseRequiresMigration schemaVersion Q.currentSchemaVersion + | otherwise -> CodebaseUnknownSchemaVersion schemaVersion -- | Migrates a codebase up to the most recent version known to ucm. -- This is a No-op if it's up to date diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index 050d7f5fda..74c56278ac 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -543,7 +543,7 @@ filterReferentsHavingTypeImpl :: filterReferentsHavingTypeImpl doGetDeclType typRef termRefs = Ops.filterTermsByReferentHavingType (Cv.reference1to2 typRef) (Cv.referentid1to2 <$> toList termRefs) >>= traverse (Cv.referentid2to1 doGetDeclType) - <&> Set.fromList + <&> Set.fromList -- | The number of base32 characters needed to distinguish any two references in the codebase. hashLength :: Transaction Int diff --git a/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs b/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs index 0a218b0c34..59d168b2e1 100644 --- a/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs +++ b/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs @@ -40,7 +40,7 @@ import Unison.Var qualified as Var -- -- Note that we can't actually tell whether the Decl was originally a record or not, so we -- include all possible accessors, but they may or may not exist in the codebase. -labeledDeclDependenciesIncludingSelfAndFieldAccessors :: Var v => TypeReference -> (DD.Decl v a) -> Set LD.LabeledDependency +labeledDeclDependenciesIncludingSelfAndFieldAccessors :: (Var v) => TypeReference -> (DD.Decl v a) -> Set LD.LabeledDependency labeledDeclDependenciesIncludingSelfAndFieldAccessors selfRef decl = DD.labeledDeclDependenciesIncludingSelf selfRef decl <> case decl of diff --git a/parser-typechecker/src/Unison/KindInference.hs b/parser-typechecker/src/Unison/KindInference.hs index 8265f042b0..081b758690 100644 --- a/parser-typechecker/src/Unison/KindInference.hs +++ b/parser-typechecker/src/Unison/KindInference.hs @@ -79,7 +79,7 @@ inferDecls ppe declMap = -- | Break the decls into strongly connected components in reverse -- topological order -intoComponents :: forall v a. Ord v => Map Reference (Decl v a) -> [[(Reference, Decl v a)]] +intoComponents :: forall v a. (Ord v) => Map Reference (Decl v a) -> [[(Reference, Decl v a)]] intoComponents declMap = let graphInput :: [(Decl v a, Reference, [Reference])] graphInput = Map.foldrWithKey (\k a b -> (a, k, declReferences a) : b) [] declMap diff --git a/parser-typechecker/src/Unison/KindInference/Constraint/Pretty.hs b/parser-typechecker/src/Unison/KindInference/Constraint/Pretty.hs index 5f261aa2cb..27609d13f8 100644 --- a/parser-typechecker/src/Unison/KindInference/Constraint/Pretty.hs +++ b/parser-typechecker/src/Unison/KindInference/Constraint/Pretty.hs @@ -43,7 +43,7 @@ prettyArrow prec lhs rhs = in wrap (lhs <> " -> " <> rhs) prettyCyclicSolvedConstraint :: - Var v => + (Var v) => Solved.Constraint (UVar v loc) v loc -> Int -> Map (UVar v loc) (P.Pretty P.ColorText) -> @@ -62,7 +62,7 @@ prettyCyclicSolvedConstraint constraint prec nameMap visitingSet = case constrai pure (prettyArrow prec pa pb, cyclicLhs <> cyclicRhs) prettyCyclicUVarKindWorker :: - Var v => + (Var v) => Int -> UVar v loc -> Map (UVar v loc) (P.Pretty P.ColorText) -> @@ -78,11 +78,11 @@ prettyCyclicUVarKindWorker prec u nameMap visitingSet = -- | Pretty print the kind constraint on the given @UVar@. -- -- __Precondition:__ The @ConstraintMap@ is acyclic. -prettyUVarKind :: Var v => PrettyPrintEnv -> ConstraintMap v loc -> UVar v loc -> P.Pretty P.ColorText +prettyUVarKind :: (Var v) => PrettyPrintEnv -> ConstraintMap v loc -> UVar v loc -> P.Pretty P.ColorText prettyUVarKind ppe constraints uvar = ppRunner ppe constraints do prettyUVarKind' arrPrec uvar -prettyUVarKind' :: Var v => Int -> UVar v loc -> Solve v loc (P.Pretty P.ColorText) +prettyUVarKind' :: (Var v) => Int -> UVar v loc -> Solve v loc (P.Pretty P.ColorText) prettyUVarKind' prec u = find u >>= \case Nothing -> pure (prettyUnknown prec) @@ -92,7 +92,7 @@ prettyUVarKind' prec u = -- -- __Precondition:__ The @ConstraintMap@ is acyclic. prettySolvedConstraint :: - Var v => + (Var v) => PrettyPrintEnv -> ConstraintMap v loc -> Solved.Constraint (UVar v loc) v loc -> @@ -100,7 +100,7 @@ prettySolvedConstraint :: prettySolvedConstraint ppe constraints c = ppRunner ppe constraints (prettySolvedConstraint' arrPrec c) -prettySolvedConstraint' :: Var v => Int -> Solved.Constraint (UVar v loc) v loc -> Solve v loc (P.Pretty P.ColorText) +prettySolvedConstraint' :: (Var v) => Int -> Solved.Constraint (UVar v loc) v loc -> Solve v loc (P.Pretty P.ColorText) prettySolvedConstraint' prec = \case Solved.IsAbility _ -> pure (prettyAbility prec) Solved.IsType _ -> pure (prettyType prec) @@ -113,7 +113,7 @@ prettySolvedConstraint' prec = \case -- constraint map, but no constraints are added. This runner just -- allows running pretty printers outside of the @Solve@ monad by -- discarding the resulting state. -ppRunner :: Var v => PrettyPrintEnv -> ConstraintMap v loc -> (forall r. Solve v loc r -> r) +ppRunner :: (Var v) => PrettyPrintEnv -> ConstraintMap v loc -> (forall r. Solve v loc r -> r) ppRunner ppe constraints = let st = SolveState @@ -130,7 +130,7 @@ ppRunner ppe constraints = -- -- __Precondition:__ The @UVar@ has a cyclic constraint. prettyCyclicUVarKind :: - Var v => + (Var v) => PrettyPrintEnv -> ConstraintMap v loc -> UVar v loc -> diff --git a/parser-typechecker/src/Unison/KindInference/Error.hs b/parser-typechecker/src/Unison/KindInference/Error.hs index 2e977e0493..e9d0900a0a 100644 --- a/parser-typechecker/src/Unison/KindInference/Error.hs +++ b/parser-typechecker/src/Unison/KindInference/Error.hs @@ -28,7 +28,7 @@ data ConstraintConflict v loc = ConstraintConflict' conflictedConstraint :: Solved.Constraint (UVar v loc) v loc } -lspLoc :: Semigroup loc => KindError v loc -> loc +lspLoc :: (Semigroup loc) => KindError v loc -> loc lspLoc = \case CycleDetected loc _ _ -> loc UnexpectedArgument _ abs arg _ -> varLoc abs <> varLoc arg @@ -45,30 +45,30 @@ data KindError v loc CycleDetected loc (UVar v loc) (ConstraintMap v loc) | -- | Something of kind * or Effect is applied to an argument UnexpectedArgument + -- | src span of abs loc - -- ^ src span of abs + -- | abs var (UVar v loc) - -- ^ abs var + -- | arg var (UVar v loc) - -- ^ arg var - (ConstraintMap v loc) - -- ^ context + -- | context -- | An arrow kind is applied to a type, but its kind doesn't match -- the expected argument kind + (ConstraintMap v loc) | ArgumentMismatch + -- | abs var (UVar v loc) - -- ^ abs var + -- | expected var (UVar v loc) - -- ^ expected var + -- | given var (UVar v loc) - -- ^ given var - (ConstraintMap v loc) - -- ^ context + -- | context -- | Same as @ArgumentMismatch@, but for applications to the builtin -- @Arrow@ type. + (ConstraintMap v loc) | ArgumentMismatchArrow + -- | (The applied arrow range, lhs, rhs) (loc, Type v loc, Type v loc) - -- ^ (The applied arrow range, lhs, rhs) (ConstraintConflict v loc) (ConstraintMap v loc) | -- | Something appeared in an effect list that isn't of kind Effect @@ -77,22 +77,22 @@ data KindError v loc (ConstraintMap v loc) | -- | Generic constraint conflict ConstraintConflict + -- | Failed to add this constraint (GeneratedConstraint v loc) - -- ^ Failed to add this constraint + -- | Due to this conflict (ConstraintConflict v loc) - -- ^ Due to this conflict + -- | in this context (ConstraintMap v loc) - -- ^ in this context -- | Transform generic constraint conflicts into more specific error -- by examining its @ConstraintContext@. -improveError :: Var v => KindError v loc -> Solve v loc (KindError v loc) +improveError :: (Var v) => KindError v loc -> Solve v loc (KindError v loc) improveError = \case ConstraintConflict a b c -> improveError' a b c e -> pure e improveError' :: - Var v => + (Var v) => GeneratedConstraint v loc -> ConstraintConflict v loc -> ConstraintMap v loc -> diff --git a/parser-typechecker/src/Unison/KindInference/Error/Pretty.hs b/parser-typechecker/src/Unison/KindInference/Error/Pretty.hs index b1db1ac911..cf14da1ad6 100644 --- a/parser-typechecker/src/Unison/KindInference/Error/Pretty.hs +++ b/parser-typechecker/src/Unison/KindInference/Error/Pretty.hs @@ -17,7 +17,7 @@ import Unison.Var (Var) -- | Pretty print a user-facing @KindError@. prettyKindError :: - Var v => + (Var v) => -- | How to print types (Type v loc -> Pretty ColorText) -> -- | How to print source spans diff --git a/parser-typechecker/src/Unison/KindInference/Generate.hs b/parser-typechecker/src/Unison/KindInference/Generate.hs index b235108745..ab675534d2 100644 --- a/parser-typechecker/src/Unison/KindInference/Generate.hs +++ b/parser-typechecker/src/Unison/KindInference/Generate.hs @@ -106,7 +106,7 @@ typeConstraintTree resultVar term@ABT.Term {annotation, out} = do effConstraints <- typeConstraintTree effKind eff pure $ ParentConstraint (IsAbility effKind (Provenance EffectsList $ ABT.annotation eff)) effConstraints -handleIntroOuter :: Var v => v -> loc -> (GeneratedConstraint v loc -> Gen v loc r) -> Gen v loc r +handleIntroOuter :: (Var v) => v -> loc -> (GeneratedConstraint v loc -> Gen v loc r) -> Gen v loc r handleIntroOuter v loc k = do let typ = Type.var loc v new <- freshVar typ @@ -171,7 +171,7 @@ dfAnns annAlg cons nil = ABT.cata \ann abt0 -> case abt0 of -- Our rewrite signature machinery generates type annotations that are -- not well kinded. Work around this for now by stripping those -- annotations. -hackyStripAnns :: Ord v => Term.Term v loc -> Term.Term v loc +hackyStripAnns :: (Ord v) => Term.Term v loc -> Term.Term v loc hackyStripAnns = snd . ABT.cata \ann abt0 -> case abt0 of ABT.Var v -> (False, ABT.var ann v) diff --git a/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs b/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs index 7b374d6efa..4271665beb 100644 --- a/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs +++ b/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs @@ -52,7 +52,7 @@ run :: Gen v loc a -> GenState v loc -> (a, GenState v loc) run (Gen ma) st0 = ma st0 -- | Create a unique @UVar@ associated with @typ@ -freshVar :: Var v => T.Type v loc -> Gen v loc (UVar v loc) +freshVar :: (Var v) => T.Type v loc -> Gen v loc (UVar v loc) freshVar typ = do st@GenState {unifVars, newVars} <- get let var :: Symbol @@ -63,7 +63,7 @@ freshVar typ = do pure uvar -- | Associate a fresh @UVar@ with @t@, push onto context -pushType :: Var v => T.Type v loc -> Gen v loc (UVar v loc) +pushType :: (Var v) => T.Type v loc -> Gen v loc (UVar v loc) pushType t = do GenState {typeMap} <- get (var, newTypeMap) <- @@ -75,13 +75,13 @@ pushType t = do pure var -- | Lookup the @UVar@ associated with a @Type@ -lookupType :: Var v => T.Type v loc -> Gen v loc (Maybe (UVar v loc)) +lookupType :: (Var v) => T.Type v loc -> Gen v loc (Maybe (UVar v loc)) lookupType t = do GenState {typeMap} <- get pure (NonEmpty.head <$> Map.lookup t typeMap) -- | Remove a @Type@ from the context -popType :: Var v => T.Type v loc -> Gen v loc () +popType :: (Var v) => T.Type v loc -> Gen v loc () popType t = do modify \st -> st {typeMap = del (typeMap st)} where @@ -94,7 +94,7 @@ popType t = do in Map.alter f t m -- | Helper to run an action with the given @Type@ in the context -scopedType :: Var v => T.Type v loc -> (UVar v loc -> Gen v loc r) -> Gen v loc r +scopedType :: (Var v) => T.Type v loc -> (UVar v loc -> Gen v loc r) -> Gen v loc r scopedType t m = do s <- pushType t r <- m s diff --git a/parser-typechecker/src/Unison/KindInference/Solve.hs b/parser-typechecker/src/Unison/KindInference/Solve.hs index 1bf58960f5..82bdfc8c7c 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve.hs @@ -89,7 +89,7 @@ step e st cs = Right () -> Right finalState -- | Default any unconstrained vars to @Type@ -defaultUnconstrainedVars :: Var v => SolveState v loc -> SolveState v loc +defaultUnconstrainedVars :: (Var v) => SolveState v loc -> SolveState v loc defaultUnconstrainedVars st = let newConstraints = foldl' phi (constraints st) (newUnifVars st) phi b a = U.alter a handleNothing handleJust b @@ -167,8 +167,8 @@ reduce cs0 = dbg "reduce" cs0 (go False []) -- contradictory constraint. addConstraint :: forall v loc. - Ord loc => - Var v => + (Ord loc) => + (Var v) => GeneratedConstraint v loc -> Solve v loc (Either (KindError v loc) ()) addConstraint constraint = do @@ -200,8 +200,8 @@ addConstraint constraint = do -- satisfied. addConstraint' :: forall v loc. - Ord loc => - Var v => + (Ord loc) => + (Var v) => UnsolvedConstraint v loc -> Solve v loc (Either (ConstraintConflict v loc) [UnsolvedConstraint v loc]) addConstraint' = \case @@ -304,7 +304,7 @@ union _unionLoc a b = do -- | Do an occurence check and return an error or the resulting solve -- state verify :: - Var v => + (Var v) => SolveState v loc -> Either (NonEmpty (KindError v loc)) (SolveState v loc) verify st = @@ -347,7 +347,7 @@ assertGen gen = do -- | occurence check and report any errors occCheck :: forall v loc. - Var v => + (Var v) => ConstraintMap v loc -> Either (NonEmpty (KindError v loc)) (ConstraintMap v loc) occCheck constraints0 = @@ -401,7 +401,7 @@ data OccCheckState v loc = OccCheckState kindErrors :: [KindError v loc] } -markVisiting :: Var v => UVar v loc -> M.State (OccCheckState v loc) CycleCheck +markVisiting :: (Var v) => UVar v loc -> M.State (OccCheckState v loc) CycleCheck markVisiting x = do OccCheckState {visitingSet, visitingStack} <- M.get case Set.member x visitingSet of @@ -420,7 +420,7 @@ markVisiting x = do } pure NoCycle -unmarkVisiting :: Var v => UVar v loc -> M.State (OccCheckState v loc) () +unmarkVisiting :: (Var v) => UVar v loc -> M.State (OccCheckState v loc) () unmarkVisiting x = M.modify \st -> st { visitingSet = Set.delete x (visitingSet st), @@ -431,7 +431,7 @@ unmarkVisiting x = M.modify \st -> addError :: KindError v loc -> M.State (OccCheckState v loc) () addError ke = M.modify \st -> st {kindErrors = ke : kindErrors st} -isSolved :: Var v => UVar v loc -> M.State (OccCheckState v loc) Bool +isSolved :: (Var v) => UVar v loc -> M.State (OccCheckState v loc) Bool isSolved x = do OccCheckState {solvedSet} <- M.get pure $ Set.member x solvedSet @@ -444,7 +444,7 @@ data CycleCheck -- Debug output helpers -------------------------------------------------------------------------------- -prettyConstraintD' :: Show loc => Var v => PrettyPrintEnv -> UnsolvedConstraint v loc -> P.Pretty P.ColorText +prettyConstraintD' :: (Show loc) => (Var v) => PrettyPrintEnv -> UnsolvedConstraint v loc -> P.Pretty P.ColorText prettyConstraintD' ppe = P.wrap . \case Unsolved.IsType v p -> prettyUVar ppe v <> " ~ Type" <> prettyProv p @@ -455,10 +455,10 @@ prettyConstraintD' ppe = prettyProv x = "[" <> P.string (show x) <> "]" -prettyConstraints :: Show loc => Var v => PrettyPrintEnv -> [UnsolvedConstraint v loc] -> P.Pretty P.ColorText +prettyConstraints :: (Show loc) => (Var v) => PrettyPrintEnv -> [UnsolvedConstraint v loc] -> P.Pretty P.ColorText prettyConstraints ppe = P.sep "\n" . map (prettyConstraintD' ppe) -prettyUVar :: Var v => PrettyPrintEnv -> UVar v loc -> P.Pretty P.ColorText +prettyUVar :: (Var v) => PrettyPrintEnv -> UVar v loc -> P.Pretty P.ColorText prettyUVar ppe (UVar s t) = TP.pretty ppe t <> " :: " <> P.prettyVar s tracePretty :: P.Pretty P.ColorText -> a -> a diff --git a/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs b/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs index 82090bf237..21cd38b95e 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs @@ -88,7 +88,7 @@ genStateL f st = } -- | Interleave constraint generation into constraint solving -runGen :: Var v => Gen v loc a -> Solve v loc a +runGen :: (Var v) => Gen v loc a -> Solve v loc a runGen gena = do st <- M.get let gena' = do @@ -104,7 +104,7 @@ runGen gena = do -- | Add a unification variable to the constarint mapping with no -- constraints. This is done on uvars created during constraint -- generation to initialize the new uvars (see 'runGen'). -addUnconstrainedVar :: Var v => UVar v loc -> Solve v loc () +addUnconstrainedVar :: (Var v) => UVar v loc -> Solve v loc () addUnconstrainedVar uvar = do st@SolveState {constraints} <- M.get let constraints' = U.insert uvar Descriptor {descriptorConstraint = Nothing} constraints @@ -125,7 +125,7 @@ emptyState = } -- | Lookup the constraints associated with a unification variable -find :: Var v => UVar v loc -> Solve v loc (Maybe (Constraint (UVar v loc) v loc)) +find :: (Var v) => UVar v loc -> Solve v loc (Maybe (Constraint (UVar v loc) v loc)) find k = do st@SolveState {constraints} <- M.get case U.lookupCanon k constraints of diff --git a/parser-typechecker/src/Unison/Parsers.hs b/parser-typechecker/src/Unison/Parsers.hs index 0e985764d9..fc1500a12f 100644 --- a/parser-typechecker/src/Unison/Parsers.hs +++ b/parser-typechecker/src/Unison/Parsers.hs @@ -81,5 +81,5 @@ unsafeParseFileBuiltinsOnly = names = Builtin.names } -unsafeParseFile :: Monad m => String -> Parser.ParsingEnv m -> m (UnisonFile Symbol Ann) +unsafeParseFile :: (Monad m) => String -> Parser.ParsingEnv m -> m (UnisonFile Symbol Ann) unsafeParseFile s pEnv = unsafeGetRightFrom s <$> parseFile "" s pEnv diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Constraint.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Constraint.hs index 06088b8618..10e7ed42a1 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Constraint.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Constraint.hs @@ -39,20 +39,20 @@ data Constraint vt v loc NegLit v PmLit | -- | Positive constraint on list element with position relative to head of list PosListHead + -- | list root v - -- ^ list root + -- | cons position (0 is head) Int - -- ^ cons position (0 is head) + -- | element variable v - -- ^ element variable | -- | Positive constraint on list element with position relative to end of list PosListTail + -- | list root v - -- ^ list root + -- | snoc position (0 is last) Int - -- ^ snoc position (0 is last) + -- | element variable v - -- ^ element variable | -- | Negative constraint on length of the list (/i.e./ the list -- may not be an element of the interval set) NegListInterval v IntervalSet diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Literal.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Literal.hs index 38feb90cc5..7a353817a6 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Literal.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Literal.hs @@ -43,21 +43,21 @@ data Literal vt v loc NegLit v PmLit | -- | Positive constraint on list element with position relative to head of list PosListHead + -- | list root v - -- ^ list root + -- | cons position (0 is head) Int - -- ^ cons position (0 is head) + -- | element variable v - -- ^ element variable (Type vt loc) | -- | Positive constraint on list element with position relative to end of list PosListTail + -- | list root v - -- ^ list root + -- | snoc position (0 is last) Int - -- ^ snoc position (0 is last) + -- | element variable v - -- ^ element variable (Type vt loc) | -- | Negative constraint on length of the list (/i.e./ the list -- may not be an element of the interval set) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/NormalizedConstraints.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/NormalizedConstraints.hs index 4cb60551bd..832a8bb5fe 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/NormalizedConstraints.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/NormalizedConstraints.hs @@ -216,14 +216,14 @@ data VarConstraints vt v loc | Vc'Text (Maybe Text) (Set Text) | Vc'Char (Maybe Char) (Set Char) | Vc'ListRoot + -- | type of list elems (Type vt loc) - -- ^ type of list elems + -- | Positive constraint on cons elements (Seq v) - -- ^ Positive constraint on cons elements + -- | Positive constraint on snoc elements (Seq v) - -- ^ Positive constraint on snoc elements + -- | positive constraint on input list size IntervalSet - -- ^ positive constraint on input list size deriving stock (Show, Eq, Ord, Generic) data EffectInfo diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/PmGrd.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/PmGrd.hs index 9a7721cf58..41bf27573a 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/PmGrd.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/PmGrd.hs @@ -17,39 +17,39 @@ data loc -- annotation = -- | @PmCon x Con xs ys@ corresponds to the constraint @Con ys <- x@ PmCon + -- | Variable v - -- ^ Variable + -- | Constructor ConstructorReference - -- ^ Constructor + -- | Constructor argument values and types [(v, Type vt loc)] - -- ^ Constructor argument values and types | PmEffect + -- | Variable v - -- ^ Variable + -- | Constructor ConstructorReference - -- ^ Constructor + -- | Constructor argument values and types [(v, Type vt loc)] - -- ^ Constructor argument values and types | PmEffectPure v (v, Type vt loc) | PmLit v PmLit | PmListHead + -- | list root v - -- ^ list root + -- | cons position (0 is head) Int - -- ^ cons position (0 is head) + -- | element variable v - -- ^ element variable + -- | element type (Type vt loc) - -- ^ element type | PmListTail + -- | list root v - -- ^ list root + -- | snoc position (0 is last) Int - -- ^ snoc position (0 is last) + -- | element variable v - -- ^ element variable + -- | element type (Type vt loc) - -- ^ element type | -- | The size of the list must fall within this inclusive range PmListInterval v Int Int | -- | If a guard performs an effect diff --git a/parser-typechecker/src/Unison/Result.hs b/parser-typechecker/src/Unison/Result.hs index 2c1a75662e..63df0a99e0 100644 --- a/parser-typechecker/src/Unison/Result.hs +++ b/parser-typechecker/src/Unison/Result.hs @@ -39,7 +39,7 @@ pattern Result notes may = MaybeT (WriterT (Identity (may, notes))) {-# COMPLETE Result #-} -makeResult :: Applicative m => notes -> Maybe a -> ResultT notes m a +makeResult :: (Applicative m) => notes -> Maybe a -> ResultT notes m a makeResult notes value = MaybeT (WriterT (pure (value, notes))) diff --git a/parser-typechecker/src/Unison/Runtime/ANF.hs b/parser-typechecker/src/Unison/Runtime/ANF.hs index f5967cf3f2..48453a9f49 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF.hs @@ -1909,33 +1909,37 @@ anfInitCase u (MatchCase p guard (ABT.AbsN' vs bd)) [] <- vs = AccumText Nothing . Map.singleton (Util.Text.fromText t) <$> anfBody bd | P.Constructor _ (ConstructorReference r t) ps <- p = do - (,) <$> expandBindings ps vs <*> anfBody bd <&> \(us, bd) -> - AccumData r Nothing - . EC.mapSingleton (fromIntegral t) - . (BX <$ us,) - . ABTN.TAbss us - $ bd + (,) + <$> expandBindings ps vs + <*> anfBody bd <&> \(us, bd) -> + AccumData r Nothing + . EC.mapSingleton (fromIntegral t) + . (BX <$ us,) + . ABTN.TAbss us + $ bd | P.EffectPure _ q <- p = - (,) <$> expandBindings [q] vs <*> anfBody bd <&> \(us, bd) -> - AccumPure $ ABTN.TAbss us bd + (,) + <$> expandBindings [q] vs + <*> anfBody bd <&> \(us, bd) -> + AccumPure $ ABTN.TAbss us bd | P.EffectBind _ (ConstructorReference r t) ps pk <- p = do (,,) <$> expandBindings (snoc ps pk) vs <*> Compose (pure <$> fresh) <*> anfBody bd - <&> \(exp, kf, bd) -> - let (us, uk) = - maybe (internalBug "anfInitCase: unsnoc impossible") id $ - unsnoc exp - jn = Builtin "jumpCont" - in flip AccumRequest Nothing - . Map.singleton r - . EC.mapSingleton (fromIntegral t) - . (BX <$ us,) - . ABTN.TAbss us - . TShift r kf - . TName uk (Left jn) [kf] - $ bd + <&> \(exp, kf, bd) -> + let (us, uk) = + maybe (internalBug "anfInitCase: unsnoc impossible") id $ + unsnoc exp + jn = Builtin "jumpCont" + in flip AccumRequest Nothing + . Map.singleton r + . EC.mapSingleton (fromIntegral t) + . (BX <$ us,) + . ABTN.TAbss us + . TShift r kf + . TName uk (Left jn) [kf] + $ bd | P.SequenceLiteral _ [] <- p = AccumSeqEmpty <$> anfBody bd | P.SequenceOp _ l op r <- p, @@ -1985,7 +1989,7 @@ blitLinks :: (Monoid a) => (Bool -> Reference -> a) -> BLit -> a blitLinks f (List s) = foldMap (valueLinks f) s blitLinks _ _ = mempty -groupTermLinks :: Var v => SuperGroup v -> [Reference] +groupTermLinks :: (Var v) => SuperGroup v -> [Reference] groupTermLinks = Set.toList . foldGroupLinks f where f False r = Set.singleton r diff --git a/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs b/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs index 3a501744ff..4bd3c2434f 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs @@ -19,7 +19,7 @@ import Unison.Runtime.ANF.Serialize as ANF import Unison.Var (Var) checkGroupHashes :: - Var v => + (Var v) => [(Referent, SuperGroup v)] -> Either (Text, [Referent]) (Either [Referent] [Referent]) checkGroupHashes rgs = case checkMissing rgs of @@ -32,7 +32,7 @@ checkGroupHashes rgs = case checkMissing rgs of Right ms -> Right (Left $ Ref <$> ms) rehashGroups :: - Var v => + (Var v) => Map.Map Reference (SuperGroup v) -> Either (Text, [Referent]) (Map.Map Reference Reference, Map.Map Reference (SuperGroup v)) rehashGroups m @@ -56,7 +56,7 @@ rehashGroups m (rm, sgs) = rehashSCC scc checkMissing :: - Var v => + (Var v) => [(Referent, SuperGroup v)] -> Either (Text, [Referent]) [Reference] checkMissing (unzip -> (rs, gs)) = do @@ -74,7 +74,7 @@ checkMissing (unzip -> (rs, gs)) = do p _ _ = False rehashSCC :: - Var v => + (Var v) => SCC (Reference, SuperGroup v) -> (Map.Map Reference Reference, Map.Map Reference (SuperGroup v)) rehashSCC scc diff --git a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs index 6bb4b315f2..995856e1b4 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs @@ -19,8 +19,8 @@ import Data.Sequence qualified as Seq import Data.Serialize.Put (runPutLazy) import Data.Text (Text) import Data.Word (Word16, Word32, Word64) -import GHC.Stack import GHC.IsList qualified (fromList) +import GHC.Stack import Unison.ABT.Normalized (Term (..)) import Unison.Reference (Reference, Reference' (Builtin), pattern Derived) import Unison.Runtime.ANF as ANF hiding (Tag) @@ -948,7 +948,7 @@ serializeGroup fops sg = runPutS (putVersion *> putGroup mempty fops sg) -- Supplying a `Builtin` reference is not supported. Such code -- shouldn't be subject to rehashing. serializeGroupForRehash :: - Var v => + (Var v) => EC.EnumMap FOp Text -> Reference -> SuperGroup v -> @@ -962,7 +962,7 @@ serializeGroupForRehash fops (Derived h _) sg = f _ = Nothing refrep = Map.fromList . mapMaybe f $ groupTermLinks sg -getVersionedValue :: MonadGet m => m Value +getVersionedValue :: (MonadGet m) => m Value getVersionedValue = getVersion >>= getValue where getVersion = diff --git a/parser-typechecker/src/Unison/Runtime/Array.hs b/parser-typechecker/src/Unison/Runtime/Array.hs index a067d93383..1b6d34fdc2 100644 --- a/parser-typechecker/src/Unison/Runtime/Array.hs +++ b/parser-typechecker/src/Unison/Runtime/Array.hs @@ -56,7 +56,7 @@ import Data.Primitive.PrimArray as EPA hiding import Data.Primitive.PrimArray qualified as PA import Data.Primitive.Types import Data.Word (Word8) -import GHC.IsList (toList ) +import GHC.IsList (toList) #ifdef ARRAY_CHECK import GHC.Stack diff --git a/parser-typechecker/src/Unison/Runtime/Exception.hs b/parser-typechecker/src/Unison/Runtime/Exception.hs index dff4a627b7..16a149d953 100644 --- a/parser-typechecker/src/Unison/Runtime/Exception.hs +++ b/parser-typechecker/src/Unison/Runtime/Exception.hs @@ -18,7 +18,7 @@ instance Exception RuntimeExn die :: (HasCallStack) => String -> IO a die = throwIO . PE callStack . P.lit . fromString -dieP :: HasCallStack => P.Pretty P.ColorText -> IO a +dieP :: (HasCallStack) => P.Pretty P.ColorText -> IO a dieP = throwIO . PE callStack exn :: (HasCallStack) => String -> a diff --git a/parser-typechecker/src/Unison/Runtime/Interface.hs b/parser-typechecker/src/Unison/Runtime/Interface.hs index 3ef03e6b5e..66139742bb 100644 --- a/parser-typechecker/src/Unison/Runtime/Interface.hs +++ b/parser-typechecker/src/Unison/Runtime/Interface.hs @@ -505,7 +505,7 @@ interpEval activeThreads cleanupThreads ctxVar cl ppe tm = evalInContext ppe ctx activeThreads initw `UnliftIO.finally` cleanupThreads -ensureExists :: HasCallStack => CreateProcess -> (CmdSpec -> Either (Int, String, String) IOException -> Pretty ColorText) -> IO () +ensureExists :: (HasCallStack) => CreateProcess -> (CmdSpec -> Either (Int, String, String) IOException -> Pretty ColorText) -> IO () ensureExists cmd err = ccall >>= \case Nothing -> pure () @@ -517,13 +517,13 @@ ensureExists cmd err = (ExitFailure exitCode, stdout, stderr) -> pure (Just (Left (exitCode, stdout, stderr))) ccall = call `UnliftIO.catch` \(e :: IOException) -> pure . Just $ Right e -ensureRuntimeExists :: HasCallStack => FilePath -> IO () +ensureRuntimeExists :: (HasCallStack) => FilePath -> IO () ensureRuntimeExists executable = ensureExists cmd runtimeErrMsg where cmd = proc executable ["--help"] -ensureRacoExists :: HasCallStack => IO () +ensureRacoExists :: (HasCallStack) => IO () ensureRacoExists = ensureExists (shell "raco help") racoErrMsg prettyCmdSpec :: CmdSpec -> Pretty ColorText diff --git a/parser-typechecker/src/Unison/Runtime/Serialize.hs b/parser-typechecker/src/Unison/Runtime/Serialize.hs index 1d1213cc45..54ae958ce5 100644 --- a/parser-typechecker/src/Unison/Runtime/Serialize.hs +++ b/parser-typechecker/src/Unison/Runtime/Serialize.hs @@ -117,11 +117,11 @@ getLength = unVarInt <$> deserialize -- Checks for negatives, in case you put an Integer, which does not -- behave properly for negative numbers. putPositive :: - MonadPut m => - Bits n => - Bits (Unsigned n) => - Integral n => - Integral (Unsigned n) => + (MonadPut m) => + (Bits n) => + (Bits (Unsigned n)) => + (Integral n) => + (Integral (Unsigned n)) => n -> m () putPositive n @@ -132,9 +132,9 @@ putPositive n -- result type. getPositive :: forall m n. - Bounded n => - Integral n => - MonadGet m => + (Bounded n) => + (Integral n) => + (MonadGet m) => m n getPositive = validate . unVarInt =<< deserialize where diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 9d2c7f23f3..6185747380 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -125,7 +125,7 @@ file = do -- | Final validations and sanity checks to perform before finishing parsing. validateUnisonFile :: - Ord v => + (Ord v) => Map v (TypeReferenceId, DataDeclaration v Ann) -> Map v (TypeReferenceId, EffectDeclaration v Ann) -> [(v, Ann, Term v Ann)] -> @@ -139,7 +139,7 @@ validateUnisonFile datas effects terms watches = -- constructors and verify that no duplicates exist in the file, triggering an error if needed. checkForDuplicateTermsAndConstructors :: forall m v. - Ord v => + (Ord v) => Map v (TypeReferenceId, DataDeclaration v Ann) -> Map v (TypeReferenceId, EffectDeclaration v Ann) -> [(v, Ann, Term v Ann)] -> diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index 3ec03464fd..a7045a90a5 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -969,7 +969,7 @@ prettyBinding0' a@AmbientContext {imports = im, docContext = doc} v term = PP.group $ PP.group (defnLhs v vs <> fmt S.BindingEquals " = ") <> prettyBody - `PP.orElse` ("\n" <> PP.indentN 2 prettyBody) + `PP.orElse` ("\n" <> PP.indentN 2 prettyBody) } _ -> pure $ @@ -1532,7 +1532,7 @@ immediateChildBlockTerms = \case doLet (v, LamsNamedOpt' _ body) = [body | not (Var.isAction v), isLet body] doLet t = error (show t) [] -isSoftHangable :: Var v => Term2 vt at ap v a -> Bool +isSoftHangable :: (Var v) => Term2 vt at ap v a -> Bool -- isSoftHangable (Delay' d) = isLet d || isSoftHangable d || case d of -- Match' scrute cases -> isDestructuringBind scrute cases -- _ -> False @@ -2016,8 +2016,10 @@ toDocSourceElement ppe (Apps' (Ref' r) [tm, toDocSourceAnnotations ppe -> Just a (,annotations) <$> ok tm where ok tm = - Right <$> toDocEmbedTermLink ppe tm - <|> Left <$> toDocEmbedTypeLink ppe tm + Right + <$> toDocEmbedTermLink ppe tm + <|> Left + <$> toDocEmbedTypeLink ppe tm toDocSourceElement _ _ = Nothing toDocSource' :: @@ -2160,7 +2162,7 @@ avoidShadowing tm (PrettyPrintEnv terms types) = & maybe fullName HQ'.NameOnly in (fullName, minimallySuffixed) tweak _ p = p - varToName :: Var v => v -> [Name] + varToName :: (Var v) => v -> [Name] varToName = toList . Name.parseText . Var.name isLeaf :: Term2 vt at ap v a -> Bool diff --git a/parser-typechecker/src/Unison/Syntax/TypeParser.hs b/parser-typechecker/src/Unison/Syntax/TypeParser.hs index 7a143c7877..e270ef25eb 100644 --- a/parser-typechecker/src/Unison/Syntax/TypeParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TypeParser.hs @@ -101,7 +101,7 @@ sequenceTyp = do let a = ann open <> ann close pure $ Type.app a (Type.list a) t -tupleOrParenthesizedType :: Var v => TypeP v m -> TypeP v m +tupleOrParenthesizedType :: (Var v) => TypeP v m -> TypeP v m tupleOrParenthesizedType rec = do (spanAnn, ty) <- tupleOrParenthesized rec DD.unitType pair pure (ty {ABT.annotation = ABT.annotation ty <> spanAnn}) diff --git a/parser-typechecker/src/Unison/Typechecker.hs b/parser-typechecker/src/Unison/Typechecker.hs index d20c7bec0c..b40b5a5626 100644 --- a/parser-typechecker/src/Unison/Typechecker.hs +++ b/parser-typechecker/src/Unison/Typechecker.hs @@ -249,7 +249,7 @@ typeDirectedNameResolution ppe oldNotes oldType env = do guard x a = if x then Just a else Nothing - suggestedVar :: Var v => v -> Text -> v + suggestedVar :: (Var v) => v -> Text -> v suggestedVar v name = case Var.typeOf v of Var.MissingResult -> v diff --git a/parser-typechecker/src/Unison/Typechecker/Context.hs b/parser-typechecker/src/Unison/Typechecker/Context.hs index 075622ecee..89eb193212 100644 --- a/parser-typechecker/src/Unison/Typechecker/Context.hs +++ b/parser-typechecker/src/Unison/Typechecker/Context.hs @@ -606,15 +606,15 @@ debugTrace :: String -> Bool debugTrace e | debugEnabled = trace e False debugTrace _ = False -showType :: Var v => Type.Type v a -> String +showType :: (Var v) => Type.Type v a -> String showType ty = TP.prettyStr (Just 120) PPE.empty ty -debugType :: Var v => String -> Type.Type v a -> Bool +debugType :: (Var v) => String -> Type.Type v a -> Bool debugType tag ty | debugEnabled = debugTrace $ "(" <> show tag <> "," <> showType ty <> ")" | otherwise = False -debugTypes :: Var v => String -> Type.Type v a -> Type.Type v a -> Bool +debugTypes :: (Var v) => String -> Type.Type v a -> Type.Type v a -> Bool debugTypes tag t1 t2 | debugEnabled = debugTrace $ "(" <> show tag <> ",\n " <> showType t1 <> ",\n " <> showType t2 <> ")" | otherwise = False diff --git a/parser-typechecker/src/Unison/UnisonFile.hs b/parser-typechecker/src/Unison/UnisonFile.hs index 9613ce1642..e532912c83 100644 --- a/parser-typechecker/src/Unison/UnisonFile.hs +++ b/parser-typechecker/src/Unison/UnisonFile.hs @@ -78,7 +78,7 @@ emptyUnisonFile = watches = Map.empty } -leftBiasedMerge :: forall v a. Ord v => UnisonFile v a -> UnisonFile v a -> UnisonFile v a +leftBiasedMerge :: forall v a. (Ord v) => UnisonFile v a -> UnisonFile v a -> UnisonFile v a leftBiasedMerge lhs rhs = let mergedTerms = Map.foldlWithKey' (addNotIn lhsTermNames) (terms lhs) (terms rhs) mergedWatches = Map.foldlWithKey' addWatch (watches lhs) (watches rhs) @@ -128,10 +128,20 @@ allWatches = join . Map.elems . watches -- | Get the location of a given definition in the file. definitionLocation :: (Var v) => v -> UnisonFile v a -> Maybe a definitionLocation v uf = - terms uf ^? ix v . _1 - <|> watches uf ^? folded . folded . filteredBy (_1 . only v) . _2 - <|> dataDeclarations uf ^? ix v . _2 . to DD.annotation - <|> effectDeclarations uf ^? ix v . _2 . to (DD.annotation . DD.toDataDecl) + terms uf + ^? ix v + . _1 + <|> watches uf + ^? folded + . folded + . filteredBy (_1 . only v) + . _2 + <|> dataDeclarations uf + ^? ix v + . _2 + . to DD.annotation + <|> effectDeclarations uf + ^? ix v . _2 . to (DD.annotation . DD.toDataDecl) -- Converts a file to a single let rec with a body of `()`, for -- purposes of typechecking. @@ -282,8 +292,10 @@ lookupDecl :: TypecheckedUnisonFile v a -> Maybe (Reference.Id, DD.Decl v a) lookupDecl v uf = - over _2 Right <$> (Map.lookup v (dataDeclarationsId' uf)) - <|> over _2 Left <$> (Map.lookup v (effectDeclarationsId' uf)) + over _2 Right + <$> (Map.lookup v (dataDeclarationsId' uf)) + <|> over _2 Left + <$> (Map.lookup v (effectDeclarationsId' uf)) indexByReference :: TypecheckedUnisonFile v a -> @@ -340,7 +352,7 @@ dependencies (UnisonFile ds es ts ws) = <> foldMap (Term.dependencies . snd) ts <> foldMap (foldMap (Term.dependencies . view _3)) ws -discardTypes :: Ord v => TypecheckedUnisonFile v a -> UnisonFile v a +discardTypes :: (Ord v) => TypecheckedUnisonFile v a -> UnisonFile v a discardTypes (TypecheckedUnisonFileId datas effects terms watches _) = let watches' = g . mconcat <$> List.multimap watches g tup3s = [(v, a, e) | (v, a, e, _t) <- tup3s] diff --git a/parser-typechecker/src/Unison/UnisonFile/Names.hs b/parser-typechecker/src/Unison/UnisonFile/Names.hs index 87f9fb6d12..00fdd5f115 100644 --- a/parser-typechecker/src/Unison/UnisonFile/Names.hs +++ b/parser-typechecker/src/Unison/UnisonFile/Names.hs @@ -28,7 +28,7 @@ import Unison.Var (Var) import Unison.Var qualified as Var import Unison.WatchKind qualified as WK -toNames :: Var v => UnisonFile v a -> Names +toNames :: (Var v) => UnisonFile v a -> Names toNames uf = datas <> effects where datas = foldMap (DD.Names.dataDeclToNames' Name.unsafeParseVar) (Map.toList (UF.dataDeclarationsId uf)) @@ -106,7 +106,7 @@ bindNames names (UnisonFileId d e ts ws) = do -- -- It's used below in `environmentFor` and also during the term resolution -- process. -variableCanonicalizer :: forall v. Var v => [v] -> Map v v +variableCanonicalizer :: forall v. (Var v) => [v] -> Map v v variableCanonicalizer vs = done $ List.multimap do v <- vs diff --git a/parser-typechecker/src/Unison/Util/Text.hs b/parser-typechecker/src/Unison/Util/Text.hs index 16947d41f7..2d112a74eb 100644 --- a/parser-typechecker/src/Unison/Util/Text.hs +++ b/parser-typechecker/src/Unison/Util/Text.hs @@ -140,16 +140,17 @@ indexOf needle haystack = ordinal :: (IsString s) => Int -> s ordinal n = do let s = show n - fromString $ s ++ - case L.drop (L.length s - 2) s of - ['1', '1'] -> "th" - ['1', '2'] -> "th" - ['1', '3'] -> "th" - _ -> case last s of - '1' -> "st" - '2' -> "nd" - '3' -> "rd" - _ -> "th" + fromString $ + s + ++ case L.drop (L.length s - 2) s of + ['1', '1'] -> "th" + ['1', '2'] -> "th" + ['1', '3'] -> "th" + _ -> case last s of + '1' -> "st" + '2' -> "nd" + '3' -> "rd" + _ -> "th" -- Drop with both a maximum size and a predicate. Yields actual number of -- dropped characters. diff --git a/parser-typechecker/tests/Unison/Test/Util/Text.hs b/parser-typechecker/tests/Unison/Test/Util/Text.hs index 083e042868..8a114b9e7b 100644 --- a/parser-typechecker/tests/Unison/Test/Util/Text.hs +++ b/parser-typechecker/tests/Unison/Test/Util/Text.hs @@ -49,7 +49,7 @@ test = (t1 <> t2 <> t3) `compare` t3 == (t1s <> t2s <> t3s) - `compare` t3s + `compare` t3s scope "take" . expect' $ Text.toText (Text.take k (t1s <> t2s)) == T.take k (t1 <> t2) scope "drop" . expect' $ diff --git a/unison-cli/src/Unison/Cli/DownloadUtils.hs b/unison-cli/src/Unison/Cli/DownloadUtils.hs index bb8ca79047..343ebfeeb5 100644 --- a/unison-cli/src/Unison/Cli/DownloadUtils.hs +++ b/unison-cli/src/Unison/Cli/DownloadUtils.hs @@ -34,7 +34,7 @@ import Unison.Sync.Types qualified as Share -- | Download a project/branch from Share. downloadProjectBranchFromShare :: - HasCallStack => + (HasCallStack) => Share.IncludeSquashedHead -> Share.RemoteProjectBranch -> Cli (Either Output.ShareError CausalHash) diff --git a/unison-cli/src/Unison/Cli/ServantClientUtils.hs b/unison-cli/src/Unison/Cli/ServantClientUtils.hs index af6723fec1..8b22b26f3d 100644 --- a/unison-cli/src/Unison/Cli/ServantClientUtils.hs +++ b/unison-cli/src/Unison/Cli/ServantClientUtils.hs @@ -25,11 +25,11 @@ classifyConnectionError exception0 = HttpClient.ConnectionFailure exception1 -> do ioException <- fromException @IOException exception1 if - | -- This may not be 100% accurate... but if the initial `getAddrInfo` request fails it will indeed throw - -- a "does not exist" error. It seems in order to *know* that `getAddrInfo` was the cause of this - -- exception, we'd have to parse the `show` output, which is preposterous. - isDoesNotExistError ioException -> - Just ConnectionError'Offline - | otherwise -> Nothing + | -- This may not be 100% accurate... but if the initial `getAddrInfo` request fails it will indeed throw + -- a "does not exist" error. It seems in order to *know* that `getAddrInfo` was the cause of this + -- exception, we'd have to parse the `show` output, which is preposterous. + isDoesNotExistError ioException -> + Just ConnectionError'Offline + | otherwise -> Nothing _ -> Nothing _ -> ConnectionError'SomethingEntirelyUnexpected exception0 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs index 8f2a24e305..2e4144c06d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs @@ -5,6 +5,8 @@ module Unison.Codebase.Editor.HandleInput.DebugSynhashTerm where import Control.Monad.Reader (ask) +import Data.Text qualified as Text +import Data.Text.IO qualified as Text import U.Util.Base32Hex qualified as Base32Hex import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -22,11 +24,9 @@ import Unison.Names qualified as Names import Unison.Prelude import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.Reference qualified as Reference +import Unison.Syntax.Name qualified as Name import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pretty -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import qualified Unison.Syntax.Name as Name handleDebugSynhashTerm :: Name -> Cli () handleDebugSynhashTerm name = do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FormatFile.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FormatFile.hs index fde32e2235..e0f2cf4294 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FormatFile.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FormatFile.hs @@ -39,7 +39,7 @@ import Unison.Var qualified as Var -- | Format a file, returning a list of Text replacements to apply to the file. formatFile :: - Monad m => + (Monad m) => (Maybe (UnisonFile Symbol Ann.Ann) -> Maybe (TypecheckedUnisonFile Symbol Ann.Ann) -> m PPED.PrettyPrintEnvDecl) -> Int -> Path.Absolute -> @@ -197,7 +197,7 @@ annToInterval ann = annToRange ann <&> rangeToInterval -- | Returns 'True' if the given symbol is a term with a user provided type signature in the -- parsed file, false otherwise. -hasUserTypeSignature :: Eq v => UnisonFile v a -> v -> Bool +hasUserTypeSignature :: (Eq v) => UnisonFile v a -> v -> Bool hasUserTypeSignature parsedFile sym = Map.toList (UF.terms parsedFile) & any (\(v, (_, trm)) -> v == sym && isJust (Term.getTypeAnnotation trm)) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 176a781bfa..eca5b5158a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -489,7 +489,7 @@ loadLibdeps branches = do ------------------------------------------------------------------------------------------------------------------------ -- Merge precondition violation checks -hasDefnsInLib :: Applicative m => V2.Branch m -> m Bool +hasDefnsInLib :: (Applicative m) => V2.Branch m -> m Bool hasDefnsInLib branch = do libdeps <- case Map.lookup NameSegment.libSegment branch.children of diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs index 172ceea300..409f7bac89 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs @@ -82,12 +82,12 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} = q = \case Term.App' (Term.Constructor' (ConstructorReference ref cid)) (Term.Text' msg) -> if - | ref == DD.testResultRef -> - if - | cid == DD.okConstructorId -> Just (Right msg) - | cid == DD.failConstructorId -> Just (Left msg) - | otherwise -> Nothing - | otherwise -> Nothing + | ref == DD.testResultRef -> + if + | cid == DD.okConstructorId -> Just (Right msg) + | cid == DD.failConstructorId -> Just (Left msg) + | otherwise -> Nothing + | otherwise -> Nothing _ -> Nothing let stats = Output.CachedTests (Set.size testRefs) (Map.size cachedTests) names <- Cli.currentNames @@ -225,9 +225,9 @@ partitionTestResults tm = fold $ do Term.App' (Term.Constructor' (ConstructorReference conRef cid)) (Term.Text' msg) -> do guard (conRef == DD.testResultRef) if - | cid == DD.okConstructorId -> pure (mempty, [msg]) - | cid == DD.failConstructorId -> pure ([msg], mempty) - | otherwise -> empty + | cid == DD.okConstructorId -> pure (mempty, [msg]) + | cid == DD.failConstructorId -> pure ([msg], mempty) + | otherwise -> empty _ -> empty isTestOk :: Term v Ann -> Bool diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 007103597a..6b76376900 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -378,12 +378,12 @@ makeUnisonFile abort codebase doFindCtorNames defns = do overwriteConstructorNames name ed.toDataDecl <&> \ed' -> uf & #effectDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') Right dd -> overwriteConstructorNames name dd <&> \dd' -> uf & #dataDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') -- Constructor names are bogus when pulled from the database, so we set them to what they should be here overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann) diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 959bc451ef..427c549507 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -127,8 +127,8 @@ data Input | PushRemoteBranchI PushRemoteBranchInput | ResetRootI BranchId | ResetI (BranchId2 {- namespace to reset it to -}) (Maybe UnresolvedProjectBranch {- ProjectBranch to reset -}) - -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? - | -- Does it make sense to fork from not-the-root of a Github repo? + | -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? + -- Does it make sense to fork from not-the-root of a Github repo? -- used in Welcome module to give directions to user CreateMessage (P.Pretty P.ColorText) | -- Change directory. diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index c4358247e5..6ae0b23616 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -199,15 +199,15 @@ data Output | -- | Function found, but has improper type -- Note: the constructor name is misleading here; we weren't necessarily looking for a "main". BadMainFunction + -- | what we were trying to do (e.g. "run", "io.test") Text - -- ^ what we were trying to do (e.g. "run", "io.test") + -- | name of function (HQ.HashQualified Name) - -- ^ name of function + -- | bad type of function (Type Symbol Ann) - -- ^ bad type of function PPE.PrettyPrintEnv + -- | acceptable type(s) of function [Type Symbol Ann] - -- ^ acceptable type(s) of function | BranchEmpty WhichBranchEmpty | LoadPullRequest (ReadRemoteNamespace Void) (ReadRemoteNamespace Void) Path' Path' Path' Path' | CreatedNewBranch Path.Absolute @@ -244,12 +244,12 @@ data Output -- for terms. This additional info is used to provide an enhanced -- error message. SearchTermsNotFoundDetailed + -- | @True@ if we are searching for a term, @False@ if we are searching for a type Bool - -- ^ @True@ if we are searching for a term, @False@ if we are searching for a type + -- | Misses (search terms that returned no hits for terms or types) [HQ.HashQualified Name] - -- ^ Misses (search terms that returned no hits for terms or types) + -- | Hits for types if we are searching for terms or terms if we are searching for types [HQ.HashQualified Name] - -- ^ Hits for types if we are searching for terms or terms if we are searching for types | -- ask confirmation before deleting the last branch that contains some defns -- `Path` is one of the paths the user has requested to delete, and is paired -- with whatever named definitions would not have any remaining names if @@ -392,8 +392,8 @@ data Output | CalculatingDiff | -- | The `local` in a `clone remote local` is ambiguous AmbiguousCloneLocal + -- | Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) - -- ^ Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) | -- | The `remote` in a `clone remote local` is ambiguous AmbiguousCloneRemote ProjectName (ProjectAndBranch ProjectName ProjectBranchName) diff --git a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs index 14e7412c4e..fe4857f1b5 100644 --- a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs +++ b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs @@ -30,8 +30,10 @@ type P = P.Parsec Void Text.Text readRemoteNamespaceParser :: ProjectBranchSpecifier branch -> P (ReadRemoteNamespace (These ProjectName branch)) readRemoteNamespaceParser specifier = - ReadShare'ProjectBranch <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier - <|> ReadShare'LooseCode <$> readShareLooseCode + ReadShare'ProjectBranch + <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier + <|> ReadShare'LooseCode + <$> readShareLooseCode projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths :: ProjectBranchSpecifier branch -> diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 159dac83a7..a253f0df02 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -256,7 +256,7 @@ formatStructuredArgument schLength = \case BranchAtProjectPath pp -> pp & PP.absPath_ - %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) + %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) & PP.toNames & into @Text @@ -507,7 +507,7 @@ handleBranchIdArg = BranchAtProjectPath pp -> pp & PP.absPath_ - %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) + %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) & BranchAtProjectPath SA.Namespace hash -> pure . BranchAtSCH $ SCH.fromFullHash hash otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg diff --git a/unison-cli/src/Unison/LSP/Configuration.hs b/unison-cli/src/Unison/LSP/Configuration.hs index e47bff3d76..a95badc33a 100644 --- a/unison-cli/src/Unison/LSP/Configuration.hs +++ b/unison-cli/src/Unison/LSP/Configuration.hs @@ -9,7 +9,7 @@ import Unison.LSP.Types import Unison.Prelude -- | Handle configuration changes. -updateConfig :: Applicative m => Config -> m () +updateConfig :: (Applicative m) => Config -> m () updateConfig _newConfig = pure () parseConfig :: Config -> Value -> Either Text Config diff --git a/unison-cli/src/Unison/LSP/Queries.hs b/unison-cli/src/Unison/LSP/Queries.hs index d8391b8bf7..9613781937 100644 --- a/unison-cli/src/Unison/LSP/Queries.hs +++ b/unison-cli/src/Unison/LSP/Queries.hs @@ -258,7 +258,6 @@ findSmallestEnclosingNode pos term _ -> Nothing ann = getTermSpanAnn term - -- | Most nodes have the property that their annotation spans all their children, but there are some exceptions. getTermSpanAnn :: Term Symbol Ann -> Ann getTermSpanAnn tm = case ABT.out tm of diff --git a/unison-core/src/Unison/ABT.hs b/unison-core/src/Unison/ABT.hs index fe9a8f930e..f98aa284e0 100644 --- a/unison-core/src/Unison/ABT.hs +++ b/unison-core/src/Unison/ABT.hs @@ -154,7 +154,8 @@ baseFunctor_ :: m (Term f v a) baseFunctor_ f t = t - & abt_ %%~ \case + & abt_ + %%~ \case Tm fx -> Tm <$> f (fx) x -> pure x diff --git a/unison-core/src/Unison/Name/Internal.hs b/unison-core/src/Unison/Name/Internal.hs index 3272d43df1..4e00652456 100644 --- a/unison-core/src/Unison/Name/Internal.hs +++ b/unison-core/src/Unison/Name/Internal.hs @@ -33,10 +33,10 @@ import Unison.Util.Alphabetical -- - ".." --> Name Absolute (".." :| []) data Name = Name + -- | whether the name is positioned absolutely (to some arbitrary root namespace), or relatively Position - -- ^ whether the name is positioned absolutely (to some arbitrary root namespace), or relatively + -- | the name segments in reverse order (List.NonEmpty NameSegment) - -- ^ the name segments in reverse order deriving stock (Eq, Generic, Show) -- | Compare names (kinda) alphabetically: absolute comes before relative, but otherwise compare the name segments @@ -49,10 +49,11 @@ instance Alphabetical Name where _ -> compareAlphabetical (segments n1) (segments n2) instance - TypeError - ( 'TypeError.Text - "You cannot make a Name from a string literal because there may (some day) be more than one syntax" - ) => + ( TypeError + ( 'TypeError.Text + "You cannot make a Name from a string literal because there may (some day) be more than one syntax" + ) + ) => IsString Name where fromString = undefined diff --git a/unison-core/src/Unison/Names.hs b/unison-core/src/Unison/Names.hs index 7080122c04..9b8c2af8ee 100644 --- a/unison-core/src/Unison/Names.hs +++ b/unison-core/src/Unison/Names.hs @@ -542,7 +542,7 @@ lenientToNametree names = (lenientRelationToNametree names.terms) (lenientRelationToNametree names.types) where - lenientRelationToNametree :: Ord a => Relation Name a -> Nametree (Map NameSegment a) + lenientRelationToNametree :: (Ord a) => Relation Name a -> Nametree (Map NameSegment a) lenientRelationToNametree = unflattenNametree . lenientRelationToLeftUniqueRelation diff --git a/unison-core/src/Unison/Util/Defns.hs b/unison-core/src/Unison/Util/Defns.hs index 34e17de7e7..e61c5ba7bb 100644 --- a/unison-core/src/Unison/Util/Defns.hs +++ b/unison-core/src/Unison/Util/Defns.hs @@ -56,7 +56,7 @@ type DefnsF3 f g h terms types = type DefnsF4 f g h i terms types = Defns (f (g (h (i terms)))) (f (g (h (i types)))) -alignDefnsWith :: Semialign f => (These a b -> c) -> Defns (f a) (f b) -> f c +alignDefnsWith :: (Semialign f) => (These a b -> c) -> Defns (f a) (f b) -> f c alignDefnsWith f defns = alignWith f defns.terms defns.types diff --git a/unison-core/src/Unison/Util/Nametree.hs b/unison-core/src/Unison/Util/Nametree.hs index 18a6ba3769..a1f52e3316 100644 --- a/unison-core/src/Unison/Util/Nametree.hs +++ b/unison-core/src/Unison/Util/Nametree.hs @@ -49,7 +49,7 @@ instance Unzip Nametree where (ys, zs) = unzipWith (unzipWith f) xs -- | Traverse over a nametree, with access to the list of name segments (in reverse order) leading to each value. -traverseNametreeWithName :: Applicative f => ([NameSegment] -> a -> f b) -> Nametree a -> f (Nametree b) +traverseNametreeWithName :: (Applicative f) => ([NameSegment] -> a -> f b) -> Nametree a -> f (Nametree b) traverseNametreeWithName f = go [] where @@ -81,7 +81,7 @@ unfoldNametree f x = -- > } flattenNametree :: forall a b. - Ord b => + (Ord b) => (a -> Map NameSegment b) -> Nametree a -> BiMultimap b Name @@ -120,7 +120,7 @@ flattenNametree f = -- > "baz" = #baz -- > } -- > } -unflattenNametree :: Ord a => BiMultimap a Name -> Nametree (Map NameSegment a) +unflattenNametree :: (Ord a) => BiMultimap a Name -> Nametree (Map NameSegment a) unflattenNametree = unfoldNametree unflattenLevel . map (first Name.segments) . Map.toList . BiMultimap.range where diff --git a/unison-core/src/Unison/Var.hs b/unison-core/src/Unison/Var.hs index a78b6638e2..981378624a 100644 --- a/unison-core/src/Unison/Var.hs +++ b/unison-core/src/Unison/Var.hs @@ -58,7 +58,7 @@ named n = typed (User n) -- This bakes the fresh id into the name portion of the variable -- and resets the id to 0. -bakeId :: Var v => v -> v +bakeId :: (Var v) => v -> v bakeId v = named (name v) rawName :: Type -> Text diff --git a/unison-merge/src/Unison/Merge/CombineDiffs.hs b/unison-merge/src/Unison/Merge/CombineDiffs.hs index c983eba79f..973a6911a8 100644 --- a/unison-merge/src/Unison/Merge/CombineDiffs.hs +++ b/unison-merge/src/Unison/Merge/CombineDiffs.hs @@ -44,7 +44,7 @@ combine :: These (DiffOp (Synhashed a)) (DiffOp (Synhashed a)) -> CombinedDiffOp combine = TwoDiffOps.make >>> combine1 >>> fmap (view #value) -combine1 :: Eq a => TwoDiffOps a -> CombinedDiffOp a +combine1 :: (Eq a) => TwoDiffOps a -> CombinedDiffOp a combine1 = \case TwoDiffOps'Add x -> CombinedDiffOp'Add (xor2ior x) TwoDiffOps'Delete x -> CombinedDiffOp'Delete (xor2ior x) diff --git a/unison-merge/src/Unison/Merge/Database.hs b/unison-merge/src/Unison/Merge/Database.hs index 28cc05c937..47d40954e6 100644 --- a/unison-merge/src/Unison/Merge/Database.hs +++ b/unison-merge/src/Unison/Merge/Database.hs @@ -47,7 +47,7 @@ data MergeDatabase = MergeDatabase loadV1TermComponent :: Hash -> Transaction [(V1.Term V1.Symbol V1.Ann, V1.Type V1.Symbol V1.Ann)] } -makeMergeDatabase :: MonadIO m => Codebase IO V1.Symbol V1.Ann -> m MergeDatabase +makeMergeDatabase :: (MonadIO m) => Codebase IO V1.Symbol V1.Ann -> m MergeDatabase makeMergeDatabase codebase = liftIO do -- Create a bunch of cached database lookup functions loadCausal <- do diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 302e46a298..34e3139f4d 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -134,7 +134,7 @@ data IncoherentDeclReason checkDeclCoherency :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m (Either IncoherentDeclReason DeclNameLookup) @@ -162,7 +162,7 @@ data IncoherentDeclReasons = IncoherentDeclReasons -- | Like 'checkDeclCoherency', but returns info about all of the incoherent decls found, not just the first. checkAllDeclCoherency :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m (Either IncoherentDeclReasons DeclNameLookup) @@ -207,7 +207,7 @@ data OnIncoherentDeclReasons m = OnIncoherentDeclReasons checkDeclCoherencyWith :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> OnIncoherentDeclReasons m -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> @@ -232,7 +232,7 @@ checkDeclCoherencyWith loadDeclNumConstructors callbacks = checkDeclCoherencyWith_DoTerms :: forall m. - Monad m => + (Monad m) => OnIncoherentDeclReasons m -> [NameSegment] -> (NameSegment, Referent) -> @@ -262,7 +262,7 @@ checkDeclCoherencyWith_DoTerms callbacks prefix = \case checkDeclCoherencyWith_DoTypes :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> OnIncoherentDeclReasons m -> ( [NameSegment] -> @@ -331,7 +331,7 @@ checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix child -- does, we still need to compute *some* syntactic hash for its decls. lenientCheckDeclCoherency :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m PartialDeclNameLookup @@ -432,7 +432,7 @@ emptyConstructorNames :: Int -> ConstructorNames emptyConstructorNames numConstructors = IntMap.fromAscList [(i, Nothing) | i <- [0 .. numConstructors - 1]] -recordConstructorName :: HasCallStack => ConstructorId -> Name -> ConstructorNames -> Either Name ConstructorNames +recordConstructorName :: (HasCallStack) => ConstructorId -> Name -> ConstructorNames -> Either Name ConstructorNames recordConstructorName conId conName = IntMap.alterF f (fromIntegral @Word64 @Int conId) where diff --git a/unison-merge/src/Unison/Merge/DeclNameLookup.hs b/unison-merge/src/Unison/Merge/DeclNameLookup.hs index 08611a944c..35e5b5e10f 100644 --- a/unison-merge/src/Unison/Merge/DeclNameLookup.hs +++ b/unison-merge/src/Unison/Merge/DeclNameLookup.hs @@ -40,13 +40,13 @@ data DeclNameLookup = DeclNameLookup deriving stock (Generic) deriving (Semigroup) via (GenericSemigroupMonoid DeclNameLookup) -expectDeclName :: HasCallStack => DeclNameLookup -> Name -> Name +expectDeclName :: (HasCallStack) => DeclNameLookup -> Name -> Name expectDeclName DeclNameLookup {constructorToDecl} x = case Map.lookup x constructorToDecl of Nothing -> error (reportBug "E246726" ("Expected constructor name key " <> show x <> " in decl name lookup")) Just y -> y -expectConstructorNames :: HasCallStack => DeclNameLookup -> Name -> [Name] +expectConstructorNames :: (HasCallStack) => DeclNameLookup -> Name -> [Name] expectConstructorNames DeclNameLookup {declToConstructors} x = case Map.lookup x declToConstructors of Nothing -> error (reportBug "E077058" ("Expected decl name key " <> show x <> " in decl name lookup")) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index 492687e29a..ca57953a2c 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -143,7 +143,7 @@ diffNamespaceDefns = f old new = Map.mapMaybe id (alignWith g old new) - g :: Eq x => These x x -> Maybe (DiffOp x) + g :: (Eq x) => These x x -> Maybe (DiffOp x) g = \case This old -> Just (DiffOp'Delete old) That new -> Just (DiffOp'Add new) @@ -158,7 +158,7 @@ deepNamespaceDefinitionsToPpe :: Defns (BiMultimap Referent Name) (BiMultimap Ty deepNamespaceDefinitionsToPpe Defns {terms, types} = PrettyPrintEnv (arbitraryName terms) (arbitraryName types) where - arbitraryName :: Ord ref => BiMultimap ref Name -> ref -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)] + arbitraryName :: (Ord ref) => BiMultimap ref Name -> ref -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)] arbitraryName names ref = BiMultimap.lookupDom ref names & Set.lookupMin @@ -168,7 +168,7 @@ deepNamespaceDefinitionsToPpe Defns {terms, types} = -- Syntactic hashing helpers synhashDefnsWith :: - Monad m => + (Monad m) => (Name -> term -> m Hash) -> (Name -> typ -> m Hash) -> Defns (BiMultimap term Name) (BiMultimap typ Name) -> diff --git a/unison-merge/src/Unison/Merge/Libdeps.hs b/unison-merge/src/Unison/Merge/Libdeps.hs index 61b5754417..defacf036b 100644 --- a/unison-merge/src/Unison/Merge/Libdeps.hs +++ b/unison-merge/src/Unison/Merge/Libdeps.hs @@ -72,11 +72,11 @@ mergeDiffs :: mergeDiffs alice bob = catMaybes (alignWith combineDiffOps alice bob) -combineDiffOps :: Eq a => These (DiffOp a) (DiffOp a) -> Maybe (LibdepDiffOp a) +combineDiffOps :: (Eq a) => These (DiffOp a) (DiffOp a) -> Maybe (LibdepDiffOp a) combineDiffOps = TwoDiffOps.make >>> combineDiffOps1 -combineDiffOps1 :: Eq a => TwoDiffOps a -> Maybe (LibdepDiffOp a) +combineDiffOps1 :: (Eq a) => TwoDiffOps a -> Maybe (LibdepDiffOp a) combineDiffOps1 = \case TwoDiffOps'Add new -> Just (AddLibdep (EitherWay.value new)) -- If Alice deletes a dep and Bob doesn't touch it, ignore the delete, since Bob may still be using it. diff --git a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs index 05787791f5..1a858deb94 100644 --- a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs +++ b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs @@ -64,7 +64,7 @@ makeInitialIdentifyConflictsState diff = } identifyConflicts :: - HasCallStack => + (HasCallStack) => TwoWay DeclNameLookup -> TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> @@ -97,7 +97,8 @@ identifyConflicts declNameLookups defns = typeConflicts <- Map.upsertF (maybe (Just ref) (const Nothing)) name (view myTypeConflicts_ s) Just $ s - & myTypeConflicts_ .~ typeConflicts + & myTypeConflicts_ + .~ typeConflicts & case ref of ReferenceBuiltin _ -> id -- builtin types don't have constructors ReferenceDerived _ -> theirTermStack_ %~ (expectConstructorNames myDeclNameLookup name ++) diff --git a/unison-merge/src/Unison/Merge/Synhash.hs b/unison-merge/src/Unison/Merge/Synhash.hs index da9a988449..ec28369bfc 100644 --- a/unison-merge/src/Unison/Merge/Synhash.hs +++ b/unison-merge/src/Unison/Merge/Synhash.hs @@ -116,11 +116,11 @@ hashConstructorNameToken declName conName = ) in H.Text (Name.toText strippedConName) -hashDerivedTerm :: Var v => PrettyPrintEnv -> Term v a -> Hash +hashDerivedTerm :: (Var v) => PrettyPrintEnv -> Term v a -> Hash hashDerivedTerm ppe term = H.accumulate (hashDerivedTermTokens ppe term) -hashDerivedTermTokens :: forall a v. Var v => PrettyPrintEnv -> Term v a -> [Token] +hashDerivedTermTokens :: forall a v. (Var v) => PrettyPrintEnv -> Term v a -> [Token] hashDerivedTermTokens ppe = (isNotBuiltinTag :) . (isTermTag :) . go [] where @@ -138,18 +138,18 @@ hashConstructorType = \case CT.Effect -> H.Tag 0 CT.Data -> H.Tag 1 -hashDataDeclTokens :: Var v => PrettyPrintEnv -> Name -> DataDeclaration v a -> [Token] +hashDataDeclTokens :: (Var v) => PrettyPrintEnv -> Name -> DataDeclaration v a -> [Token] hashDataDeclTokens ppe declName (DD.DataDeclaration modifier _ bound ctors) = hashModifierTokens modifier <> (ctors >>= hashConstructorTokens ppe declName bound) -- separating constructor types with tag of 99, which isn't used elsewhere -hashConstructorTokens :: Var v => PrettyPrintEnv -> Name -> [v] -> (a, v, Type v a) -> [Token] +hashConstructorTokens :: (Var v) => PrettyPrintEnv -> Name -> [v] -> (a, v, Type v a) -> [Token] hashConstructorTokens ppe declName bound (_, conName, ty) = H.Tag 99 : hashConstructorNameToken declName (Name.unsafeParseVar conName) : hashTypeTokens ppe bound ty -hashDeclTokens :: Var v => PrettyPrintEnv -> Name -> Decl v a -> [Token] +hashDeclTokens :: (Var v) => PrettyPrintEnv -> Name -> Decl v a -> [Token] hashDeclTokens ppe name decl = hashConstructorType (DD.constructorType decl) : hashDataDeclTokens ppe name (DD.asDataDecl decl) @@ -157,7 +157,7 @@ hashDeclTokens ppe name decl = -- they they are the same sort of decl (both are data decls or both are effect decls), the unique type guid is the same, -- the constructors appear in the same order and have the same names, and the constructors' types have the same -- syntactic hashes. -synhashDerivedDecl :: Var v => PrettyPrintEnv -> Name -> Decl v a -> Hash +synhashDerivedDecl :: (Var v) => PrettyPrintEnv -> Name -> Decl v a -> Hash synhashDerivedDecl ppe name decl = H.accumulate $ isNotBuiltinTag : isDeclTag : hashDeclTokens ppe name decl @@ -170,7 +170,7 @@ hashKindTokens k = case k of K.Star -> [H.Tag 0] K.Arrow k1 k2 -> H.Tag 1 : (hashKindTokens k1 <> hashKindTokens k2) -hashLengthToken :: Foldable t => t a -> Token +hashLengthToken :: (Foldable t) => t a -> Token hashLengthToken = H.Nat . fromIntegral @Int @Word64 . length @@ -224,7 +224,7 @@ synhashTerm loadTerm ppe = \case ReferenceBuiltin builtin -> pure (hashBuiltinTerm builtin) ReferenceDerived ref -> hashDerivedTerm ppe <$> loadTerm ref -hashTermFTokens :: Var v => PrettyPrintEnv -> Term.F v a a () -> [Token] +hashTermFTokens :: (Var v) => PrettyPrintEnv -> Term.F v a a () -> [Token] hashTermFTokens ppe = \case Term.Int n -> [H.Tag 0, H.Int n] Term.Nat n -> [H.Tag 1, H.Nat n] @@ -255,11 +255,11 @@ hashTermFTokens ppe = \case -- | Syntactically hash a type, using reference names rather than hashes. -- Two types will have the same syntactic hash if they would -- print the the same way under the given pretty-print env. -synhashType :: Var v => PrettyPrintEnv -> Type v a -> Hash +synhashType :: (Var v) => PrettyPrintEnv -> Type v a -> Hash synhashType ppe ty = H.accumulate $ hashTypeTokens ppe [] ty -hashTypeTokens :: forall v a. Var v => PrettyPrintEnv -> [v] -> Type v a -> [Token] +hashTypeTokens :: forall v a. (Var v) => PrettyPrintEnv -> [v] -> Type v a -> [Token] hashTypeTokens ppe = go where go :: [v] -> Type v a -> [Token] @@ -286,7 +286,7 @@ hashTypeReferenceToken :: PrettyPrintEnv -> TypeReference -> Token hashTypeReferenceToken ppe = hashHQNameToken . PPE.typeNameOrHashOnlyFq ppe -hashVarToken :: Var v => [v] -> v -> Token +hashVarToken :: (Var v) => [v] -> v -> Token hashVarToken bound v = case List.elemIndex v bound of Nothing -> error (reportBug "E633940" ("var " ++ show v ++ " not bound in " ++ show bound)) diff --git a/unison-merge/src/Unison/Merge/TwoWay.hs b/unison-merge/src/Unison/Merge/TwoWay.hs index 05640a3786..bad9a928f9 100644 --- a/unison-merge/src/Unison/Merge/TwoWay.hs +++ b/unison-merge/src/Unison/Merge/TwoWay.hs @@ -80,7 +80,7 @@ twoWay f TwoWay {alice, bob} = f alice bob -- | Unzip a @Map k (TwoWay v)@ into a @TwoWay (Map k v)@. -unzipMap :: Ord k => Map k (TwoWay v) -> TwoWay (Map k v) +unzipMap :: (Ord k) => Map k (TwoWay v) -> TwoWay (Map k v) unzipMap = fromPair . unzipWith (\TwoWay {alice, bob} -> (alice, bob)) diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs index 5ca0c1f155..6bea3c704a 100644 --- a/unison-share-api/src/Unison/Server/Backend.hs +++ b/unison-share-api/src/Unison/Server/Backend.hs @@ -213,10 +213,10 @@ data BackendError = NoSuchNamespace Path.Absolute | -- Failed to parse path BadNamespace + -- | error message String - -- ^ error message + -- | namespace String - -- ^ namespace | CouldntExpandBranchHash ShortCausalHash | AmbiguousBranchHash ShortCausalHash (Set ShortCausalHash) | AmbiguousHashForDefinition ShortHash @@ -462,11 +462,11 @@ getTermTag codebase r sig = do V2Referent.Con ref _ -> Just <$> Codebase.runTransaction codebase (Codebase.getDeclType codebase ref) pure $ if - | isDoc -> Doc - | isTest -> Test - | Just CT.Effect <- constructorType -> Constructor Ability - | Just CT.Data <- constructorType -> Constructor Data - | otherwise -> Plain + | isDoc -> Doc + | isTest -> Test + | Just CT.Effect <- constructorType -> Constructor Ability + | Just CT.Data <- constructorType -> Constructor Data + | otherwise -> Plain getTypeTag :: (Var v) => diff --git a/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs b/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs index 443f064545..d69f0ac8a3 100644 --- a/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs +++ b/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs @@ -16,7 +16,7 @@ import Unison.Server.Types (DisplayObjectDiff (..), SemanticSyntaxDiff (..)) import Unison.Util.AnnotatedText (AnnotatedText (..)) import Unison.Util.AnnotatedText qualified as AT -diffDisplayObjects :: HasCallStack => DisplayObject SyntaxText SyntaxText -> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff +diffDisplayObjects :: (HasCallStack) => DisplayObject SyntaxText SyntaxText -> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff diffDisplayObjects from to = case (from, to) of (BuiltinObject fromST, BuiltinObject toST) -> DisplayObjectDiff (BuiltinObject (diffSyntaxText fromST toST)) (MissingObject fromSH, MissingObject toSH) diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/UCM.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/UCM.hs index d657a23e13..09ed27a12b 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/UCM.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/UCM.hs @@ -11,5 +11,5 @@ import Unison.Server.Local.Endpoints.Current (Current, CurrentEndpoint, serveCur type UCMAPI = CurrentEndpoint -ucmServer :: MonadIO m => Codebase m v a -> Backend m Current +ucmServer :: (MonadIO m) => Codebase m v a -> Backend m Current ucmServer codebase = serveCurrent codebase diff --git a/unison-syntax/src/Unison/Lexer/Pos.hs b/unison-syntax/src/Unison/Lexer/Pos.hs index 9286d36b05..e78bb61c88 100644 --- a/unison-syntax/src/Unison/Lexer/Pos.hs +++ b/unison-syntax/src/Unison/Lexer/Pos.hs @@ -10,7 +10,7 @@ type Line = Int type Column = Int -data Pos = Pos { line :: {-# UNPACK #-} !Line, column :: {-# UNPACK #-} !Column} deriving (Show, Eq, Ord) +data Pos = Pos {line :: {-# UNPACK #-} !Line, column :: {-# UNPACK #-} !Column} deriving (Show, Eq, Ord) instance Semigroup Pos where Pos line col <> Pos line2 col2 = diff --git a/unison-syntax/src/Unison/Syntax/HashQualified.hs b/unison-syntax/src/Unison/Syntax/HashQualified.hs index 927f548805..9cc25f61cc 100644 --- a/unison-syntax/src/Unison/Syntax/HashQualified.hs +++ b/unison-syntax/src/Unison/Syntax/HashQualified.hs @@ -66,7 +66,7 @@ toVar = -- | A hash-qualified parser. hashQualifiedP :: - Monad m => + (Monad m) => ParsecT (Token Text) [Char] m name -> ParsecT (Token Text) [Char] m (HashQualified name) hashQualifiedP nameP = diff --git a/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs b/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs index 6326006c7a..406a8eae2f 100644 --- a/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs +++ b/unison-syntax/src/Unison/Syntax/HashQualifiedPrime.hs @@ -48,7 +48,7 @@ toText = -- | A hash-qualified parser. hashQualifiedP :: - Monad m => + (Monad m) => ParsecT (Token Text) [Char] m name -> ParsecT (Token Text) [Char] m (HQ'.HashQualified name) hashQualifiedP nameP = diff --git a/unison-syntax/src/Unison/Syntax/Name.hs b/unison-syntax/src/Unison/Syntax/Name.hs index 17112b6b95..a0de444b2b 100644 --- a/unison-syntax/src/Unison/Syntax/Name.hs +++ b/unison-syntax/src/Unison/Syntax/Name.hs @@ -85,7 +85,7 @@ toText (Name pos (x0 :| xs)) = Relative -> "" -- | Parse a name from a var, by first rendering the var as a string. -parseVar :: Var v => v -> Maybe Name +parseVar :: (Var v) => v -> Maybe Name parseVar = parseText . Var.name @@ -105,7 +105,7 @@ toVar = -- Name parsers -- | A name parser. -nameP :: Monad m => ParsecT (Token NameSegment.ParseErr) [Char] m Name +nameP :: (Monad m) => ParsecT (Token NameSegment.ParseErr) [Char] m Name nameP = P.try do leadingDot <- isJust <$> P.optional (P.char '.') @@ -113,7 +113,7 @@ nameP = pure (if leadingDot then Name.makeAbsolute name else name) -- | A relative name parser. -relativeNameP :: forall m. Monad m => ParsecT (Token NameSegment.ParseErr) [Char] m Name +relativeNameP :: forall m. (Monad m) => ParsecT (Token NameSegment.ParseErr) [Char] m Name relativeNameP = do Name.fromSegments <$> Monad.sepBy1 NameSegment.segmentP separatorP where @@ -123,7 +123,7 @@ relativeNameP = do -- This allows (for example) the "a." in "forall a. a -> a" to successfully parse as an identifier "a" followed by -- the reserved symbol ".", rathern than fail to parse as an identifier, because it looks like the prefix of some -- "a.b" that stops in the middle. - separatorP :: Ord e => ParsecT e [Char] m Char + separatorP :: (Ord e) => ParsecT e [Char] m Char separatorP = P.try do c <- P.char '.' diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 015537c467..affab5bf2c 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -280,7 +280,7 @@ semi = label "newline or semicolon" $ queryToken go closeBlock :: (Ord v) => P v m (L.Token ()) closeBlock = void <$> matchToken L.Close -wordyPatternName :: Var v => P v m (L.Token v) +wordyPatternName :: (Var v) => P v m (L.Token v) wordyPatternName = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just $ Name.toVar n _ -> Nothing @@ -304,27 +304,27 @@ prefixTermName = wordyTermName <|> parenthesize symbolyTermName _ -> Nothing -- Parse a wordy identifier e.g. Foo, discarding any hash -wordyDefinitionName :: Var v => P v m (L.Token v) +wordyDefinitionName :: (Var v) => P v m (L.Token v) wordyDefinitionName = queryToken $ \case L.WordyId n -> Just $ Name.toVar (HQ'.toName n) L.Blank s -> Just $ Var.nameds ("_" <> s) _ -> Nothing -- Parse a wordyId as a Name, rejecting any hash -importWordyId :: Ord v => P v m (L.Token Name) +importWordyId :: (Ord v) => P v m (L.Token Name) importWordyId = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just n L.Blank s | not (null s) -> Just $ Name.unsafeParseText (Text.pack ("_" <> s)) _ -> Nothing -- The `+` in: use Foo.bar + as a Name -importSymbolyId :: Ord v => P v m (L.Token Name) +importSymbolyId :: (Ord v) => P v m (L.Token Name) importSymbolyId = queryToken \case L.SymbolyId (HQ'.NameOnly n) -> Just n _ -> Nothing -- Parse a symboly ID like >>= or &&, discarding any hash -symbolyDefinitionName :: Var v => P v m (L.Token v) +symbolyDefinitionName :: (Var v) => P v m (L.Token v) symbolyDefinitionName = queryToken $ \case L.SymbolyId n -> Just $ Name.toVar (HQ'.toName n) _ -> Nothing @@ -345,7 +345,7 @@ hqPrefixId = hqWordyId_ <|> parenthesize hqSymbolyId_ hqInfixId = hqSymbolyId_ -- Parse a hash-qualified alphanumeric identifier -hqWordyId_ :: Ord v => P v m (L.Token (HQ.HashQualified Name)) +hqWordyId_ :: (Ord v) => P v m (L.Token (HQ.HashQualified Name)) hqWordyId_ = queryToken \case L.WordyId n -> Just $ HQ'.toHQ n L.Hash h -> Just $ HQ.HashOnly h @@ -353,7 +353,7 @@ hqWordyId_ = queryToken \case _ -> Nothing -- Parse a hash-qualified symboly ID like >>=#foo or && -hqSymbolyId_ :: Ord v => P v m (L.Token (HQ.HashQualified Name)) +hqSymbolyId_ :: (Ord v) => P v m (L.Token (HQ.HashQualified Name)) hqSymbolyId_ = queryToken \case L.SymbolyId n -> Just (HQ'.toHQ n) _ -> Nothing @@ -409,7 +409,7 @@ string = queryToken getString -- -- returns the result of combining elements with 'pair', alongside the annotation containing -- the full parenthesized expression. -tupleOrParenthesized :: Ord v => P v m a -> (Ann -> a) -> (a -> a -> a) -> P v m (Ann {- spanAnn -}, a) +tupleOrParenthesized :: (Ord v) => P v m a -> (Ann -> a) -> (a -> a -> a) -> P v m (Ann {- spanAnn -}, a) tupleOrParenthesized p unit pair = do seq' "(" go p where From f7633ce7c7404948ce2f0fbfd83aa95a73ee5431 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 18 Jul 2024 18:26:01 -0600 Subject: [PATCH 480/631] Manually reformat chains of single constraints Changing `(A x) => (B y) => x -> y` to `(A x, B y) => x -> y`. --- .../src/Unison/KindInference/Solve.hs | 10 ++++------ parser-typechecker/src/Unison/Runtime/Serialize.hs | 13 ++----------- 2 files changed, 6 insertions(+), 17 deletions(-) diff --git a/parser-typechecker/src/Unison/KindInference/Solve.hs b/parser-typechecker/src/Unison/KindInference/Solve.hs index 82bdfc8c7c..623152972a 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve.hs @@ -167,8 +167,7 @@ reduce cs0 = dbg "reduce" cs0 (go False []) -- contradictory constraint. addConstraint :: forall v loc. - (Ord loc) => - (Var v) => + (Ord loc, Var v) => GeneratedConstraint v loc -> Solve v loc (Either (KindError v loc) ()) addConstraint constraint = do @@ -200,8 +199,7 @@ addConstraint constraint = do -- satisfied. addConstraint' :: forall v loc. - (Ord loc) => - (Var v) => + (Ord loc, Var v) => UnsolvedConstraint v loc -> Solve v loc (Either (ConstraintConflict v loc) [UnsolvedConstraint v loc]) addConstraint' = \case @@ -444,7 +442,7 @@ data CycleCheck -- Debug output helpers -------------------------------------------------------------------------------- -prettyConstraintD' :: (Show loc) => (Var v) => PrettyPrintEnv -> UnsolvedConstraint v loc -> P.Pretty P.ColorText +prettyConstraintD' :: (Show loc, Var v) => PrettyPrintEnv -> UnsolvedConstraint v loc -> P.Pretty P.ColorText prettyConstraintD' ppe = P.wrap . \case Unsolved.IsType v p -> prettyUVar ppe v <> " ~ Type" <> prettyProv p @@ -455,7 +453,7 @@ prettyConstraintD' ppe = prettyProv x = "[" <> P.string (show x) <> "]" -prettyConstraints :: (Show loc) => (Var v) => PrettyPrintEnv -> [UnsolvedConstraint v loc] -> P.Pretty P.ColorText +prettyConstraints :: (Show loc, Var v) => PrettyPrintEnv -> [UnsolvedConstraint v loc] -> P.Pretty P.ColorText prettyConstraints ppe = P.sep "\n" . map (prettyConstraintD' ppe) prettyUVar :: (Var v) => PrettyPrintEnv -> UVar v loc -> P.Pretty P.ColorText diff --git a/parser-typechecker/src/Unison/Runtime/Serialize.hs b/parser-typechecker/src/Unison/Runtime/Serialize.hs index 54ae958ce5..064200cd55 100644 --- a/parser-typechecker/src/Unison/Runtime/Serialize.hs +++ b/parser-typechecker/src/Unison/Runtime/Serialize.hs @@ -117,11 +117,7 @@ getLength = unVarInt <$> deserialize -- Checks for negatives, in case you put an Integer, which does not -- behave properly for negative numbers. putPositive :: - (MonadPut m) => - (Bits n) => - (Bits (Unsigned n)) => - (Integral n) => - (Integral (Unsigned n)) => + (MonadPut m, Bits n, Bits (Unsigned n), Integral n, Integral (Unsigned n)) => n -> m () putPositive n @@ -130,12 +126,7 @@ putPositive n -- Reads as an Integer, then checks that the result will fit in the -- result type. -getPositive :: - forall m n. - (Bounded n) => - (Integral n) => - (MonadGet m) => - m n +getPositive :: forall m n. (Bounded n, Integral n, MonadGet m) => m n getPositive = validate . unVarInt =<< deserialize where mx0 :: n From 9ac6a04ec1825c66c22cd81f0c35761390341a52 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 18 Jul 2024 19:10:49 -0600 Subject: [PATCH 481/631] Inform Ormolu of some operator precedences This adds a .ormolu file to tell Ormolu what some operator precedences are, to improve indentation of multi-line operator sequences. --- .ormolu | 4 ++ lib/unison-util-bytes/test/Main.hs | 6 +-- parser-typechecker/src/Unison/Codebase.hs | 9 ++--- .../Codebase/SqliteCodebase/Operations.hs | 2 +- parser-typechecker/src/Unison/Runtime/ANF.hs | 38 +++++++++---------- .../src/Unison/Syntax/TermParser.hs | 9 ++--- .../src/Unison/Syntax/TermPrinter.hs | 6 +-- parser-typechecker/src/Unison/UnisonFile.hs | 24 +++--------- parser-typechecker/src/Unison/Util/Text.hs | 19 +++++----- .../tests/Unison/Test/Util/Text.hs | 6 +-- .../Codebase/Editor/HandleInput/Update2.hs | 4 +- .../src/Unison/Codebase/Editor/UriParser.hs | 6 +-- .../src/Unison/CommandLine/InputPatterns.hs | 4 +- unison-core/src/Unison/ABT.hs | 3 +- .../Unison/Merge/PartitionCombinedDiffs.hs | 3 +- 15 files changed, 57 insertions(+), 86 deletions(-) create mode 100644 .ormolu diff --git a/.ormolu b/.ormolu new file mode 100644 index 0000000000..fb60d7db30 --- /dev/null +++ b/.ormolu @@ -0,0 +1,4 @@ +infixl 8 ^? +infixr 4 %%~, %~ +infixl 3 <|> +infixl 1 &, <&> diff --git a/lib/unison-util-bytes/test/Main.hs b/lib/unison-util-bytes/test/Main.hs index 0302e6efa5..98906571a4 100644 --- a/lib/unison-util-bytes/test/Main.hs +++ b/lib/unison-util-bytes/test/Main.hs @@ -42,10 +42,8 @@ test = scope "<>" . expect' $ Bytes.toArray (b1s <> b2s <> b3s) == b1 <> b2 <> b3 scope "Ord" . expect' $ - (b1 <> b2 <> b3) - `compare` b3 - == (b1s <> b2s <> b3s) - `compare` b3s + (b1 <> b2 <> b3) `compare` b3 + == (b1s <> b2s <> b3s) `compare` b3s scope "take" . expect' $ Bytes.toArray (Bytes.take k (b1s <> b2s)) == BS.take k (b1 <> b2) scope "drop" . expect' $ diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 79b00026a4..a741477b0c 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -396,12 +396,9 @@ typeLookupForDependencies codebase s = do unseen :: TL.TypeLookup Symbol a -> Reference -> Bool unseen tl r = isNothing - ( Map.lookup r (TL.dataDecls tl) - $> () - <|> Map.lookup r (TL.typeOfTerms tl) - $> () - <|> Map.lookup r (TL.effectDecls tl) - $> () + ( Map.lookup r (TL.dataDecls tl) $> () + <|> Map.lookup r (TL.typeOfTerms tl) $> () + <|> Map.lookup r (TL.effectDecls tl) $> () ) toCodeLookup :: (MonadIO m) => Codebase m Symbol Parser.Ann -> CL.CodeLookup Symbol m Parser.Ann diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index 74c56278ac..050d7f5fda 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -543,7 +543,7 @@ filterReferentsHavingTypeImpl :: filterReferentsHavingTypeImpl doGetDeclType typRef termRefs = Ops.filterTermsByReferentHavingType (Cv.reference1to2 typRef) (Cv.referentid1to2 <$> toList termRefs) >>= traverse (Cv.referentid2to1 doGetDeclType) - <&> Set.fromList + <&> Set.fromList -- | The number of base32 characters needed to distinguish any two references in the codebase. hashLength :: Transaction Int diff --git a/parser-typechecker/src/Unison/Runtime/ANF.hs b/parser-typechecker/src/Unison/Runtime/ANF.hs index 48453a9f49..0c2fa20ff8 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF.hs @@ -1911,35 +1911,31 @@ anfInitCase u (MatchCase p guard (ABT.AbsN' vs bd)) | P.Constructor _ (ConstructorReference r t) ps <- p = do (,) <$> expandBindings ps vs - <*> anfBody bd <&> \(us, bd) -> - AccumData r Nothing - . EC.mapSingleton (fromIntegral t) - . (BX <$ us,) - . ABTN.TAbss us - $ bd + <*> anfBody bd + <&> \(us, bd) -> + AccumData r Nothing . EC.mapSingleton (fromIntegral t) . (BX <$ us,) $ ABTN.TAbss us bd | P.EffectPure _ q <- p = (,) <$> expandBindings [q] vs - <*> anfBody bd <&> \(us, bd) -> - AccumPure $ ABTN.TAbss us bd + <*> anfBody bd + <&> \(us, bd) -> AccumPure $ ABTN.TAbss us bd | P.EffectBind _ (ConstructorReference r t) ps pk <- p = do (,,) <$> expandBindings (snoc ps pk) vs <*> Compose (pure <$> fresh) <*> anfBody bd - <&> \(exp, kf, bd) -> - let (us, uk) = - maybe (internalBug "anfInitCase: unsnoc impossible") id $ - unsnoc exp - jn = Builtin "jumpCont" - in flip AccumRequest Nothing - . Map.singleton r - . EC.mapSingleton (fromIntegral t) - . (BX <$ us,) - . ABTN.TAbss us - . TShift r kf - . TName uk (Left jn) [kf] - $ bd + <&> \(exp, kf, bd) -> + let (us, uk) = + maybe (internalBug "anfInitCase: unsnoc impossible") id $ + unsnoc exp + jn = Builtin "jumpCont" + in flip AccumRequest Nothing + . Map.singleton r + . EC.mapSingleton (fromIntegral t) + . (BX <$ us,) + . ABTN.TAbss us + . TShift r kf + $ TName uk (Left jn) [kf] bd | P.SequenceLiteral _ [] <- p = AccumSeqEmpty <$> anfBody bd | P.SequenceOp _ l op r <- p, diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 9e5b23f701..635a974d89 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -1011,12 +1011,9 @@ force = P.label "force" $ P.try do seqOp :: (Ord v) => P v m Pattern.SeqOp seqOp = - Pattern.Snoc - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.snocSegment))) - <|> Pattern.Cons - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment))) - <|> Pattern.Concat - <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment))) + Pattern.Snoc <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.snocSegment))) + <|> Pattern.Cons <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment))) + <|> Pattern.Concat <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment))) term4 :: (Monad m, Var v) => TermP v m term4 = f <$> some termLeaf diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index a7045a90a5..faeda76020 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -2016,10 +2016,8 @@ toDocSourceElement ppe (Apps' (Ref' r) [tm, toDocSourceAnnotations ppe -> Just a (,annotations) <$> ok tm where ok tm = - Right - <$> toDocEmbedTermLink ppe tm - <|> Left - <$> toDocEmbedTypeLink ppe tm + Right <$> toDocEmbedTermLink ppe tm + <|> Left <$> toDocEmbedTypeLink ppe tm toDocSourceElement _ _ = Nothing toDocSource' :: diff --git a/parser-typechecker/src/Unison/UnisonFile.hs b/parser-typechecker/src/Unison/UnisonFile.hs index e532912c83..8de9b15224 100644 --- a/parser-typechecker/src/Unison/UnisonFile.hs +++ b/parser-typechecker/src/Unison/UnisonFile.hs @@ -128,20 +128,10 @@ allWatches = join . Map.elems . watches -- | Get the location of a given definition in the file. definitionLocation :: (Var v) => v -> UnisonFile v a -> Maybe a definitionLocation v uf = - terms uf - ^? ix v - . _1 - <|> watches uf - ^? folded - . folded - . filteredBy (_1 . only v) - . _2 - <|> dataDeclarations uf - ^? ix v - . _2 - . to DD.annotation - <|> effectDeclarations uf - ^? ix v . _2 . to (DD.annotation . DD.toDataDecl) + terms uf ^? ix v . _1 + <|> watches uf ^? folded . folded . filteredBy (_1 . only v) . _2 + <|> dataDeclarations uf ^? ix v . _2 . to DD.annotation + <|> effectDeclarations uf ^? ix v . _2 . to (DD.annotation . DD.toDataDecl) -- Converts a file to a single let rec with a body of `()`, for -- purposes of typechecking. @@ -292,10 +282,8 @@ lookupDecl :: TypecheckedUnisonFile v a -> Maybe (Reference.Id, DD.Decl v a) lookupDecl v uf = - over _2 Right - <$> (Map.lookup v (dataDeclarationsId' uf)) - <|> over _2 Left - <$> (Map.lookup v (effectDeclarationsId' uf)) + over _2 Right <$> (Map.lookup v (dataDeclarationsId' uf)) + <|> over _2 Left <$> (Map.lookup v (effectDeclarationsId' uf)) indexByReference :: TypecheckedUnisonFile v a -> diff --git a/parser-typechecker/src/Unison/Util/Text.hs b/parser-typechecker/src/Unison/Util/Text.hs index 2d112a74eb..c588e35743 100644 --- a/parser-typechecker/src/Unison/Util/Text.hs +++ b/parser-typechecker/src/Unison/Util/Text.hs @@ -141,16 +141,15 @@ ordinal :: (IsString s) => Int -> s ordinal n = do let s = show n fromString $ - s - ++ case L.drop (L.length s - 2) s of - ['1', '1'] -> "th" - ['1', '2'] -> "th" - ['1', '3'] -> "th" - _ -> case last s of - '1' -> "st" - '2' -> "nd" - '3' -> "rd" - _ -> "th" + s ++ case L.drop (L.length s - 2) s of + ['1', '1'] -> "th" + ['1', '2'] -> "th" + ['1', '3'] -> "th" + _ -> case last s of + '1' -> "st" + '2' -> "nd" + '3' -> "rd" + _ -> "th" -- Drop with both a maximum size and a predicate. Yields actual number of -- dropped characters. diff --git a/parser-typechecker/tests/Unison/Test/Util/Text.hs b/parser-typechecker/tests/Unison/Test/Util/Text.hs index 8a114b9e7b..245ca3424e 100644 --- a/parser-typechecker/tests/Unison/Test/Util/Text.hs +++ b/parser-typechecker/tests/Unison/Test/Util/Text.hs @@ -46,10 +46,8 @@ test = scope "<>" . expect' $ Text.toText (t1s <> t2s <> t3s) == t1 <> t2 <> t3 scope "Ord" . expect' $ - (t1 <> t2 <> t3) - `compare` t3 - == (t1s <> t2s <> t3s) - `compare` t3s + (t1 <> t2 <> t3) `compare` t3 + == (t1s <> t2s <> t3s) `compare` t3s scope "take" . expect' $ Text.toText (Text.take k (t1s <> t2s)) == T.take k (t1 <> t2) scope "drop" . expect' $ diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 6b76376900..007103597a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -378,12 +378,12 @@ makeUnisonFile abort codebase doFindCtorNames defns = do overwriteConstructorNames name ed.toDataDecl <&> \ed' -> uf & #effectDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') Right dd -> overwriteConstructorNames name dd <&> \dd' -> uf & #dataDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') -- Constructor names are bogus when pulled from the database, so we set them to what they should be here overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann) diff --git a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs index fe4857f1b5..14e7412c4e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs +++ b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs @@ -30,10 +30,8 @@ type P = P.Parsec Void Text.Text readRemoteNamespaceParser :: ProjectBranchSpecifier branch -> P (ReadRemoteNamespace (These ProjectName branch)) readRemoteNamespaceParser specifier = - ReadShare'ProjectBranch - <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier - <|> ReadShare'LooseCode - <$> readShareLooseCode + ReadShare'ProjectBranch <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier + <|> ReadShare'LooseCode <$> readShareLooseCode projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths :: ProjectBranchSpecifier branch -> diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index a253f0df02..159dac83a7 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -256,7 +256,7 @@ formatStructuredArgument schLength = \case BranchAtProjectPath pp -> pp & PP.absPath_ - %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) + %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) & PP.toNames & into @Text @@ -507,7 +507,7 @@ handleBranchIdArg = BranchAtProjectPath pp -> pp & PP.absPath_ - %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) + %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name)) & BranchAtProjectPath SA.Namespace hash -> pure . BranchAtSCH $ SCH.fromFullHash hash otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg diff --git a/unison-core/src/Unison/ABT.hs b/unison-core/src/Unison/ABT.hs index f98aa284e0..fe9a8f930e 100644 --- a/unison-core/src/Unison/ABT.hs +++ b/unison-core/src/Unison/ABT.hs @@ -154,8 +154,7 @@ baseFunctor_ :: m (Term f v a) baseFunctor_ f t = t - & abt_ - %%~ \case + & abt_ %%~ \case Tm fx -> Tm <$> f (fx) x -> pure x diff --git a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs index 1a858deb94..5b63f0323e 100644 --- a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs +++ b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs @@ -97,8 +97,7 @@ identifyConflicts declNameLookups defns = typeConflicts <- Map.upsertF (maybe (Just ref) (const Nothing)) name (view myTypeConflicts_ s) Just $ s - & myTypeConflicts_ - .~ typeConflicts + & myTypeConflicts_ .~ typeConflicts & case ref of ReferenceBuiltin _ -> id -- builtin types don't have constructors ReferenceDerived _ -> theirTermStack_ %~ (expectConstructorNames myDeclNameLookup name ++) From 6ede3fcfd5aad8d561fbd5ef12753194522006a8 Mon Sep 17 00:00:00 2001 From: Eduard Nicodei Date: Mon, 15 Jul 2024 22:36:38 +0100 Subject: [PATCH 482/631] fix jit generation in ci.yaml --- .github/workflows/ci.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index a9bf5c83e6..ba690c2ca6 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -388,7 +388,7 @@ jobs: write-mode: overwrite contents: | ```ucm - .> project.create-empty jit-setup + scratch/main> project.create-empty jit-setup jit-setup/main> lib.install ${{ env.jit_version }} ``` ```unison From 4584e1f883d22621b1c7b3f7390f5161c6abe303 Mon Sep 17 00:00:00 2001 From: Cody Allen Date: Mon, 22 Jul 2024 10:11:10 -0400 Subject: [PATCH 483/631] Don't limit max line length on .u scratch files The recently added `.editorconfig` sets a max line length of 120 characters for all file types. I found this to be pretty frustrating when writing Unison scratch files. While writing Unison code my editor would seemingly randomly create a new line, generating invalid Unison code. This came up more often when writing `Doc` values, since I tend to write longer lines in prose than in code. The formatting in scratch files is ephemeral, so I don't think that there is any good reason to force a max line length on it. --- .editorconfig | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.editorconfig b/.editorconfig index 24503cfc21..ca6aaebbd5 100644 --- a/.editorconfig +++ b/.editorconfig @@ -9,3 +9,6 @@ indent_style = space insert_final_newline = true max_line_length = 120 trim_trailing_whitespace = true + +[*.u] +max_line_length = off From 05826172b8cebe6b98e4183f18dbb6a5c638343b Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 22 Jul 2024 10:58:54 -0700 Subject: [PATCH 484/631] Remove reset-root, fix docs for reset --- .../src/Unison/Codebase/Editor/HandleInput.hs | 14 ------- .../src/Unison/Codebase/Editor/Input.hs | 7 ++-- .../src/Unison/CommandLine/InputPatterns.hs | 40 ++++--------------- .../src/Unison/CommandLine/OutputMessages.hs | 5 +-- 4 files changed, 13 insertions(+), 53 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 7f830ec2d7..e85879cc4a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -262,17 +262,6 @@ loop e = do description <- inputDescription input _ <- Cli.updateAt description target (const newRoot) Cli.respond Success - ResetRootI src0 -> - Cli.time "reset-root" do - newRoot <- - case src0 of - BranchAtSCH hash -> Cli.resolveShortCausalHash hash - BranchAtPath path' -> Cli.expectBranchAtPath' path' - BranchAtProjectPath pp -> Cli.getBranchFromProjectPath pp - description <- inputDescription input - pb <- getCurrentProjectBranch - void $ Cli.updateProjectBranchRoot_ pb description (const newRoot) - Cli.respond Success ForkLocalBranchI src0 dest0 -> do (srcb, branchEmpty) <- case src0 of @@ -908,9 +897,6 @@ inputDescription input = let tgtText = into @Text tgt pure (" " <> tgtText) pure ("reset " <> hashTxt <> tgt) - ResetRootI src0 -> do - let src = into @Text src0 - pure ("reset-root " <> src) AliasTermI force src0 dest0 -> do src <- hhqs' src0 dest <- ps' dest0 diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 427c549507..d0bc3ae9d2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -125,11 +125,10 @@ data Input | DiffNamespaceI BranchId2 BranchId2 -- old new | PullI !PullSourceTarget !PullMode | PushRemoteBranchI PushRemoteBranchInput - | ResetRootI BranchId | ResetI (BranchId2 {- namespace to reset it to -}) (Maybe UnresolvedProjectBranch {- ProjectBranch to reset -}) - | -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? - -- Does it make sense to fork from not-the-root of a Github repo? - -- used in Welcome module to give directions to user + -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? + -- Does it make sense to fork from not-the-root of a Github repo? + | -- used in Welcome module to give directions to user CreateMessage (P.Pretty P.ColorText) | -- Change directory. SwitchBranchI Path' diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 159dac83a7..6dc5581f62 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -100,7 +100,6 @@ module Unison.CommandLine.InputPatterns renameTerm, renameType, reset, - resetRoot, runScheme, saveExecuteResult, sfind, @@ -1661,11 +1660,14 @@ reset = [ ("namespace, hash, or branch to reset to", Required, namespaceOrProjectBranchArg config), ("namespace to be reset", Optional, namespaceOrProjectBranchArg config) ] - ( P.wrapColumn2 - [ ("`reset #pvfd222s8n`", "reset the current namespace to the causal `#pvfd222s8n`"), - ("`reset foo`", "reset the current namespace to that of the `foo` namespace."), - ("`reset foo bar`", "reset the namespace `bar` to that of the `foo` namespace."), - ("`reset #pvfd222s8n /topic`", "reset the branch `topic` of the current project to the causal `#pvfd222s8n`.") + ( P.lines + [ P.wrapColumn2 + [ ("`reset #pvfd222s8n`", "reset the current namespace to the hash `#pvfd222s8n`"), + ("`reset foo`", "reset the current namespace to the state of the `foo` namespace."), + ("`reset #pvfd222s8n /topic`", "reset the branch `topic` of the current project to the causal `#pvfd222s8n`.") + ], + "", + P.wrap $ "If you make a mistake using reset, consult the " <> makeExample' branchReflog <> " command and use another " <> makeExample' reset <> " command to return to a previous state." ] ) \case @@ -1680,31 +1682,6 @@ reset = branchInclusion = AllBranches } --- asBranch = tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) (Text.pack inputString) - -resetRoot :: InputPattern -resetRoot = - InputPattern - "reset-root" - [] - I.Hidden - [("namespace or hash to reset to", Required, namespaceArg)] - ( P.lines - [ "Deprecated because it's incompatible with projects. ⚠️ Warning, this command can cause codebase corruption.", - P.wrapColumn2 - [ ( makeExample resetRoot [".foo"], - "Reset the root namespace (along with its history) to that of the `.foo` namespace. Deprecated" - ), - ( makeExample resetRoot ["#9dndk3kbsk13nbpeu"], - "Reset the root namespace (along with its history) to that of the namespace with hash `#9dndk3kbsk13nbpeu`." - ) - ] - ] - ) - $ \case - [src] -> Input.ResetRootI <$> handleBranchIdArg src - args -> wrongArgsLength "exactly one argument" args - pull :: InputPattern pull = pullImpl "pull" [] Input.PullWithHistory "" @@ -3502,7 +3479,6 @@ validInputs = renameType, moveAll, reset, - resetRoot, runScheme, saveExecuteResult, test, diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 473e3d01c6..31b2056fec 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -997,7 +997,6 @@ notifyUser dir = \case -- defs in the codebase. In some cases it's fine for bindings to -- shadow codebase names, but you don't want it to capture them in -- the decompiled output. - let prettyBindings = P.bracket . P.lines $ P.wrap "The watch expression(s) reference these definitions:" @@ -1290,8 +1289,8 @@ notifyUser dir = \case "to make an old namespace accessible again," ), (mempty, mempty), - ( IP.makeExample IP.resetRoot [prettySCH prevSCH], - "to reset the root namespace and its history to that of the specified" + ( IP.makeExample IP.reset [prettySCH prevSCH], + "to reset the current namespace and its history to that of the specified" <> "namespace." ) ] From 6e6c0ab8e22b774ee9b8f8611284fce2cf27fcd1 Mon Sep 17 00:00:00 2001 From: ChrisPenner Date: Mon, 22 Jul 2024 17:59:57 +0000 Subject: [PATCH 485/631] automatically run ormolu --- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 31b2056fec..d061f37f54 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -997,6 +997,7 @@ notifyUser dir = \case -- defs in the codebase. In some cases it's fine for bindings to -- shadow codebase names, but you don't want it to capture them in -- the decompiled output. + let prettyBindings = P.bracket . P.lines $ P.wrap "The watch expression(s) reference these definitions:" From 5bedaf3d1a6902ade433c9897aec4858503cb5a7 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 22 Jul 2024 11:01:24 -0700 Subject: [PATCH 486/631] Update transcripts --- unison-src/transcripts/help.output.md | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/unison-src/transcripts/help.output.md b/unison-src/transcripts/help.output.md index b8d12061e4..aad724347c 100644 --- a/unison-src/transcripts/help.output.md +++ b/unison-src/transcripts/help.output.md @@ -683,15 +683,17 @@ scratch/main> help reset `reset #pvfd222s8n` reset the current namespace to the - causal `#pvfd222s8n` - `reset foo` reset the current namespace to - that of the `foo` namespace. - `reset foo bar` reset the namespace `bar` to that - of the `foo` namespace. + hash `#pvfd222s8n` + `reset foo` reset the current namespace to the + state of the `foo` namespace. `reset #pvfd222s8n /topic` reset the branch `topic` of the current project to the causal `#pvfd222s8n`. + If you make a mistake using reset, consult the `branch.reflog` + command and use another `reset` command to return to a + previous state. + rewrite (or sfind.replace) `rewrite rule1` rewrites definitions in the latest scratch file. From 1b22343c24579d9abdf841ef79045daf4b3aeca4 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 22 Jul 2024 14:36:51 -0700 Subject: [PATCH 487/631] branch.reflog -> reflog --- .../src/Unison/CommandLine/InputPatterns.hs | 8 +-- unison-src/transcripts/alias-many.output.md | 4 +- .../transcripts/debug-name-diffs.output.md | 4 +- unison-src/transcripts/delete.output.md | 56 +++++++++---------- .../transcripts/diff-namespace.output.md | 4 +- unison-src/transcripts/help.output.md | 12 ++-- .../transcripts/move-namespace.output.md | 4 +- 7 files changed, 46 insertions(+), 46 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 6dc5581f62..671265a960 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2270,13 +2270,13 @@ deprecatedViewRootReflog = branchReflog :: InputPattern branchReflog = InputPattern - "branch.reflog" - ["reflog.branch", "reflog"] + "reflog" + ["reflog.branch", "branch.reflog"] I.Visible [] ( P.lines - [ "`branch.reflog` lists all the changes that have affected the current branch.", - "`branch.reflog /mybranch` lists all the changes that have affected /mybranch." + [ "`reflog` lists all the changes that have affected the current branch.", + "`reflog /mybranch` lists all the changes that have affected /mybranch." ] ) ( \case diff --git a/unison-src/transcripts/alias-many.output.md b/unison-src/transcripts/alias-many.output.md index 0e2114f88e..4924cee59c 100644 --- a/unison-src/transcripts/alias-many.output.md +++ b/unison-src/transcripts/alias-many.output.md @@ -39,8 +39,8 @@ scratch/main> alias.many List.adjacentPairs List.all List.any List.chunk List.ch 14. List.tail : [a] -> Optional [a] 15. List.takeWhile : (a ->{𝕖} Boolean) -> [a] ->{𝕖} [a] - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. scratch/main> find-in mylib diff --git a/unison-src/transcripts/debug-name-diffs.output.md b/unison-src/transcripts/debug-name-diffs.output.md index 9033106895..b9b0742e53 100644 --- a/unison-src/transcripts/debug-name-diffs.output.md +++ b/unison-src/transcripts/debug-name-diffs.output.md @@ -45,8 +45,8 @@ scratch/main> delete.term.verbose a.b.one 1. a.b.one : ##Nat - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. scratch/main> alias.term a.two a.newtwo diff --git a/unison-src/transcripts/delete.output.md b/unison-src/transcripts/delete.output.md index c87f5140bd..6107a7fd04 100644 --- a/unison-src/transcripts/delete.output.md +++ b/unison-src/transcripts/delete.output.md @@ -36,8 +36,8 @@ scratch/main> delete.verbose foo 1. foo : Nat - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. scratch/main> delete.verbose Foo @@ -45,8 +45,8 @@ scratch/main> delete.verbose Foo 1. structural type Foo - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. scratch/main> delete.verbose Foo.Foo @@ -54,8 +54,8 @@ scratch/main> delete.verbose Foo.Foo 1. Foo.Foo : '#089vmor9c5 - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. ``` How about an ambiguous term? @@ -93,8 +93,8 @@ scratch/main> delete.verbose a.foo 2. a.bar ┐ 3. a.foo#dcgdua2lj6 (removed) 4. a.foo#dcgdua2lj6 ┘ - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. scratch/main> ls a @@ -134,8 +134,8 @@ scratch/main> delete.verbose a.Foo 4. lib.builtins.Unit │ 5. a.Foo#00nv2kob8f ┘ - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. scratch/main> delete.verbose a.Foo.Foo @@ -143,8 +143,8 @@ scratch/main> delete.verbose a.Foo.Foo 1. a.Foo.Foo : '#089vmor9c5 - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. ``` Finally, let's try to delete a term and a type with the same name. @@ -169,8 +169,8 @@ scratch/main> delete.verbose foo 1. structural type foo 2. foo : Nat - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. ``` We want to be able to delete multiple terms at once @@ -198,8 +198,8 @@ scratch/main> delete.verbose a b c 2. b : Text 3. c : Text - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. ``` We can delete terms and types in the same invocation of delete @@ -230,8 +230,8 @@ scratch/main> delete.verbose a b c Foo 3. b : Text 4. c : Text - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. scratch/main> delete.verbose Foo.Foo @@ -241,8 +241,8 @@ scratch/main> delete.verbose Foo.Foo 1. Foo.Foo ┐ 2. Foo.Foo (removed) 3. foo.Foo ┘ - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. ``` We can delete a type and its constructors @@ -270,8 +270,8 @@ scratch/main> delete.verbose Foo Foo.Foo 2. Foo.Foo ┐ 3. Foo.Foo (removed) 4. foo.Foo ┘ - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. ``` You should not be able to delete terms which are referenced by other terms @@ -335,8 +335,8 @@ scratch/main> delete.verbose e f g h 3. g : Nat 4. h : Nat - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. ``` You should be able to delete a type and all the functions that reference it in a single command @@ -365,8 +365,8 @@ scratch/main> delete.verbose Foo Foo.Foo incrementFoo 2. Foo.Foo : Nat -> Foo 3. incrementFoo : Foo -> Nat - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. ``` If you mess up on one of the names of your command, delete short circuits @@ -417,8 +417,8 @@ scratch/main> delete.verbose ping 1. ping : 'Nat - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. scratch/main> view pong diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md index d54ff32e00..91be4c076f 100644 --- a/unison-src/transcripts/diff-namespace.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -268,8 +268,8 @@ scratch/ns2> delete.term.verbose fromJust' 1. fromJust' ┐ 2. fromJust' (removed) 3. yoohoo ┘ - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. scratch/main> diff.namespace /ns3: /ns2: diff --git a/unison-src/transcripts/help.output.md b/unison-src/transcripts/help.output.md index aad724347c..248fb6b4fc 100644 --- a/unison-src/transcripts/help.output.md +++ b/unison-src/transcripts/help.output.md @@ -44,10 +44,6 @@ scratch/main> help branch.empty (or branch.create-empty, create.empty-branch) Create a new empty branch. - branch.reflog (or reflog.branch, reflog) - `branch.reflog` lists all the changes that have affected the current branch. - `branch.reflog /mybranch` lists all the changes that have affected /mybranch. - branch.rename (or rename.branch) `branch.rename foo` renames the current branch to `foo` @@ -181,7 +177,7 @@ scratch/main> help PATH. deprecated.root-reflog - `deprecated.root-reflog` lists the changes that have affected the root namespace. This has been deprecated in favor of `branch.reflog` which shows the reflog for the current project. + `deprecated.root-reflog` lists the changes that have affected the root namespace. This has been deprecated in favor of `reflog` which shows the reflog for the current project. diff.namespace `diff.namespace before after` shows how the namespace `after` @@ -675,6 +671,10 @@ scratch/main> help quit (or exit, :q) Exits the Unison command line interface. + reflog (or reflog.branch, branch.reflog) + `reflog` lists all the changes that have affected the current branch. + `reflog /mybranch` lists all the changes that have affected /mybranch. + reflog.global `reflog.global` lists all recent changes across all projects and branches. @@ -690,7 +690,7 @@ scratch/main> help current project to the causal `#pvfd222s8n`. - If you make a mistake using reset, consult the `branch.reflog` + If you make a mistake using reset, consult the `reflog` command and use another `reset` command to return to a previous state. diff --git a/unison-src/transcripts/move-namespace.output.md b/unison-src/transcripts/move-namespace.output.md index a93618b0de..c90e352696 100644 --- a/unison-src/transcripts/move-namespace.output.md +++ b/unison-src/transcripts/move-namespace.output.md @@ -358,8 +358,8 @@ scratch/existing> move.namespace a b A branch existed at the destination: b so I over-wrote it. - Tip: You can use `undo` or use a hash from `branch.reflog` to - undo this change. + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. Done. From c7a55f0196c4c6b3bb9661f09a77c73da00d3b43 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 22 Jul 2024 18:26:14 -0400 Subject: [PATCH 488/631] update work --- .../src/Unison/Util/BiMultimap.hs | 18 ++ parser-typechecker/src/Unison/UnisonFile.hs | 29 ++ unison-cli/src/Unison/Cli/UpdateUtils.hs | 245 ++++++++++++++++ .../Codebase/Editor/HandleInput/Merge2.hs | 173 ++---------- .../Codebase/Editor/HandleInput/Todo.hs | 4 + .../Codebase/Editor/HandleInput/Update2.hs | 261 +++++++++++++++--- .../src/Unison/CommandLine/OutputMessages.hs | 4 +- unison-cli/unison-cli.cabal | 1 + .../src/Unison/ConstructorReference.hs | 5 + unison-core/src/Unison/Names.hs | 8 +- unison-core/src/Unison/Referent.hs | 15 +- unison-core/src/Unison/Util/Defn.hs | 9 + unison-core/src/Unison/Util/Nametree.hs | 4 +- unison-core/unison-core1.cabal | 1 + .../src/Unison/Merge/DeclCoherencyCheck.hs | 249 +++++++++-------- 15 files changed, 718 insertions(+), 308 deletions(-) create mode 100644 unison-cli/src/Unison/Cli/UpdateUtils.hs create mode 100644 unison-core/src/Unison/Util/Defn.hs diff --git a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs index e970281f07..5609751b51 100644 --- a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs +++ b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs @@ -3,6 +3,9 @@ module Unison.Util.BiMultimap ( BiMultimap, Unison.Util.BiMultimap.empty, + -- ** Basic queries + isEmpty, + -- ** Lookup memberDom, lookupDom, @@ -32,6 +35,9 @@ module Unison.Util.BiMultimap dom, ran, + -- ** Relations + toRelation, + -- ** Insert insert, unsafeInsert, @@ -48,6 +54,8 @@ import Data.Set.NonEmpty qualified as Set.NonEmpty import Unison.Prelude import Unison.Util.Map qualified as Map import Prelude hiding (filter) +import Unison.Util.Relation (Relation) +import qualified Unison.Util.Relation as Relation -- | A left-unique relation. -- @@ -62,6 +70,11 @@ data BiMultimap a b = BiMultimap empty :: (Ord a, Ord b) => BiMultimap a b empty = BiMultimap mempty mempty +-- | Is a left-unique relation empty? +isEmpty :: BiMultimap a b -> Bool +isEmpty = + Map.null . domain + memberDom :: Ord a => a -> BiMultimap a b -> Bool memberDom x = Map.member x . domain @@ -200,6 +213,11 @@ ran :: BiMultimap a b -> Set b ran = Map.keysSet . toMapR +-- | Convert a left-unique relation to a relation (forgetting its left-uniqueness). +toRelation :: (Ord a, Ord b) => BiMultimap a b -> Relation a b +toRelation = + Relation.fromMultimap . Map.map Set.NonEmpty.toSet . domain + -- | Insert a pair into a left-unique relation, maintaining left-uniqueness, preferring the latest inserted element. -- -- That is, if a left-unique relation already contains the pair @(x, y)@, then inserting the pair @(z, y)@ will cause diff --git a/parser-typechecker/src/Unison/UnisonFile.hs b/parser-typechecker/src/Unison/UnisonFile.hs index 9613ce1642..98e30c0363 100644 --- a/parser-typechecker/src/Unison/UnisonFile.hs +++ b/parser-typechecker/src/Unison/UnisonFile.hs @@ -36,6 +36,8 @@ module Unison.UnisonFile typecheckedUnisonFile, Unison.UnisonFile.rewrite, prepareRewrite, + termNamespaceBindings, + typeNamespaceBindings, ) where @@ -49,6 +51,7 @@ import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType qualified as CT import Unison.DataDeclaration (DataDeclaration, EffectDeclaration (..)) import Unison.DataDeclaration qualified as DD +import Unison.DataDeclaration qualified as DataDeclaration import Unison.Hash qualified as Hash import Unison.Hashing.V2.Convert qualified as Hashing import Unison.LabeledDependency (LabeledDependency) @@ -67,6 +70,7 @@ import Unison.Util.List qualified as List import Unison.Var (Var) import Unison.Var qualified as Var import Unison.WatchKind (WatchKind, pattern TestWatch) +import Unison.WatchKind qualified as WatchKind -- | An empty Unison file. emptyUnisonFile :: UnisonFile v a @@ -390,3 +394,28 @@ constructorsForDecls types uf = & fmap (DD.toDataDecl . snd) & concatMap DD.constructorVars in Set.fromList (dataConstructors <> effectConstructors) + +-- | All bindings in the term namespace: terms, test watches (since those are the only watches that are actually stored +-- in the codebase), data constructors, and effect constructors. +termNamespaceBindings :: Ord v => TypecheckedUnisonFile v a -> Set v +termNamespaceBindings uf = + terms <> tests <> datacons <> effcons + where + terms = foldMap (Set.fromList . map (view _1)) uf.topLevelComponents' + tests = + uf.watchComponents & foldMap \case + (WatchKind.TestWatch, watches) -> Set.fromList (map (view _1) watches) + _ -> Set.empty + datacons = foldMap (Set.fromList . DataDeclaration.constructorVars . view _2) uf.dataDeclarationsId' + effcons = + foldMap + (Set.fromList . DataDeclaration.constructorVars . DataDeclaration.toDataDecl . view _2) + uf.effectDeclarationsId' + +-- | All bindings in the term namespace: data declarations and effect declarations. +typeNamespaceBindings :: Ord v => TypecheckedUnisonFile v a -> Set v +typeNamespaceBindings uf = + datas <> effs + where + datas = Map.keysSet uf.dataDeclarationsId' + effs = Map.keysSet uf.effectDeclarationsId' diff --git a/unison-cli/src/Unison/Cli/UpdateUtils.hs b/unison-cli/src/Unison/Cli/UpdateUtils.hs new file mode 100644 index 0000000000..aacfa601b7 --- /dev/null +++ b/unison-cli/src/Unison/Cli/UpdateUtils.hs @@ -0,0 +1,245 @@ +-- | This module contains functionality that is common to the general idea of "updating" a term in Unison, which is when +-- we reassign a name from one hash to another and then see if all dependents still typecheck. +-- +-- This occurs in the `pull`, `merge`, `update`, and `upgrade` commands. +module Unison.Cli.UpdateUtils + ( -- * Narrowing definitions + narrowDefns, + + -- * Hydrating definitions + hydrateDefns, + hydrateDefnsRel, + + -- * Rendering definitions + renderDefnsForUnisonFile, + ) +where + +import Control.Lens (mapped, _1, _2) +import Control.Monad.Writer (Writer) +import Control.Monad.Writer qualified as Writer +import Data.Bitraversable (bitraverse) +import Data.Foldable qualified as Foldable +import Data.List qualified as List +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import U.Codebase.Reference (TermReferenceId, TypeReferenceId) +import Unison.Builtin.Decls qualified as Builtin.Decls +import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) +import Unison.DataDeclaration (Decl) +import Unison.Hash (Hash) +import Unison.HashQualified qualified as HQ +import Unison.HashQualifiedPrime qualified as HQ' +import Unison.Merge.DeclNameLookup (DeclNameLookup (..), expectConstructorNames) +import Unison.Name (Name) +import Unison.Prelude +import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) +import Unison.Reference qualified as Reference +import Unison.Referent (Referent) +import Unison.Referent qualified as Referent +import Unison.Syntax.DeclPrinter (AccessorName) +import Unison.Syntax.DeclPrinter qualified as DeclPrinter +import Unison.Syntax.TermPrinter qualified as TermPrinter +import Unison.Term (Term) +import Unison.Type (Type) +import Unison.Typechecker qualified as Typechecker +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defn (Defn (..)) +import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Util.Monoid qualified as Monoid +import Unison.Util.Pretty (ColorText, Pretty) +import Unison.Util.Pretty qualified as Pretty +import Unison.Util.Relation (Relation) +import Unison.Util.Relation qualified as Relation +import Unison.Util.Set qualified as Set +import Unison.Var (Var) +import Prelude hiding (unzip, zip, zipWith) + +------------------------------------------------------------------------------------------------------------------------ +-- Narrowing definitions + +-- | "Narrow" a namespace that may contain conflicted names, resulting in either a failure (if we find a conflicted +-- name), or the narrowed left-unique relation namespace without conflicted names. +narrowDefns :: + (Ord term, Ord typ) => + DefnsF (Relation Name) term typ -> + Either (Defn Name Name) (Defns (BiMultimap term Name) (BiMultimap typ Name)) +narrowDefns = + bitraverse (mapLeft TermDefn . go) (mapLeft TypeDefn . go) + where + go :: (Ord ref) => Relation Name ref -> Either Name (BiMultimap ref Name) + go = + fmap BiMultimap.fromRange . Map.traverseWithKey unconflicted . Relation.domain + where + unconflicted :: Name -> Set ref -> Either Name ref + unconflicted name refs = + case Set.asSingleton refs of + Nothing -> Left name + Just ref -> Right ref + +------------------------------------------------------------------------------------------------------------------------ +-- Hydrating definitions + +-- | Hydrate term/type references to actual terms/types. +hydrateDefns :: + forall m name term typ. + (Monad m, Ord name) => + (Hash -> m [term]) -> + (Hash -> m [typ]) -> + DefnsF (Map name) TermReferenceId TypeReferenceId -> + m (DefnsF (Map name) term (TypeReferenceId, typ)) +hydrateDefns getTermComponent getTypeComponent = do + bitraverse hydrateTerms hydrateTypes + where + hydrateTerms :: Map name TermReferenceId -> m (Map name term) + hydrateTerms terms = + hydrateDefns_ getTermComponent terms \_ _ -> id + + hydrateTypes :: Map name TypeReferenceId -> m (Map name (TypeReferenceId, typ)) + hydrateTypes types = + hydrateDefns_ getTypeComponent types \_ -> (,) + +hydrateDefns_ :: + forall a b name m. + (Monad m, Ord name) => + (Hash -> m [a]) -> + Map name Reference.Id -> + (name -> Reference.Id -> a -> b) -> + m (Map name b) +hydrateDefns_ getComponent defns modify = + Foldable.foldlM f Map.empty (foldMap (Set.singleton . Reference.idToHash) defns) + where + f :: Map name b -> Hash -> m (Map name b) + f acc hash = + List.foldl' g acc . Reference.componentFor hash <$> getComponent hash + + g :: Map name b -> (Reference.Id, a) -> Map name b + g acc (ref, thing) = + Set.foldl' (h ref thing) acc (BiMultimap.lookupDom ref defns2) + + h :: Reference.Id -> a -> Map name b -> name -> Map name b + h ref thing acc name = + Map.insert name (modify name ref thing) acc + + defns2 :: BiMultimap Reference.Id name + defns2 = + BiMultimap.fromRange defns + +-- | Like 'hydrateDefns', but when you have a relation (i.e. names can be conflicted). Maybe this code should be deleted +-- in favor of just asserting that names can't be conflicted before doing something (since it's easy to resolve: just +-- rename one). But, for now, this exists. +hydrateDefnsRel :: + forall m name term typ. + (Monad m, Ord name, Ord term, Ord typ) => + (Hash -> m [term]) -> + (Hash -> m [typ]) -> + DefnsF (Relation name) TermReferenceId TypeReferenceId -> + m (DefnsF (Relation name) term (TypeReferenceId, typ)) +hydrateDefnsRel getTermComponent getTypeComponent = do + bitraverse hydrateTerms hydrateTypes + where + hydrateTerms :: Relation name TermReferenceId -> m (Relation name term) + hydrateTerms terms = + hydrateDefnsRel_ getTermComponent terms \_ _ -> id + + hydrateTypes :: Relation name TypeReferenceId -> m (Relation name (TypeReferenceId, typ)) + hydrateTypes types = + hydrateDefnsRel_ getTypeComponent types \_ -> (,) + +hydrateDefnsRel_ :: + forall a b name m. + (Ord b, Monad m, Ord name) => + (Hash -> m [a]) -> + Relation name Reference.Id -> + (name -> Reference.Id -> a -> b) -> + m (Relation name b) +hydrateDefnsRel_ getComponent defns modify = + let hashes :: [Hash] + hashes = + defns + & Relation.toList + & List.foldl' (\acc (_, ref) -> Set.insert (Reference.idToHash ref) acc) Set.empty + & Set.toList + in hashes & Monoid.foldMapM \hash -> do + component <- getComponent hash + pure + ( List.foldl' + f + Relation.empty + (Reference.componentFor hash component) + ) + where + f :: Relation name b -> (Reference.Id, a) -> Relation name b + f acc (ref, x) = + List.foldl' (g ref x) acc (Set.toList (Relation.lookupRan ref defns)) + + g :: Reference.Id -> a -> Relation name b -> name -> Relation name b + g ref x acc2 name = + Relation.insert name (modify name ref x) acc2 + +------------------------------------------------------------------------------------------------------------------------ +-- Rendering definitions + +-- | Render definitions destined for a Unison file. +-- +-- This first renders the types (discovering which record accessors will be generated upon parsing), then renders the +-- terms (being careful not to render any record accessors, since those would cause duplicate binding errors upon +-- parsing). +renderDefnsForUnisonFile :: + forall a v. + (Var v, Monoid a) => + DeclNameLookup -> + PrettyPrintEnvDecl -> + DefnsF (Map Name) (Term v a, Type v a) (TypeReferenceId, Decl v a) -> + DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) +renderDefnsForUnisonFile declNameLookup ppe defns = + let (types, accessorNames) = Writer.runWriter (Map.traverseWithKey renderType defns.types) + in Defns + { terms = Map.mapMaybeWithKey (renderTerm accessorNames) defns.terms, + types + } + where + renderType :: Name -> (TypeReferenceId, Decl v a) -> Writer (Set AccessorName) (Pretty ColorText) + renderType name (ref, typ) = + fmap Pretty.syntaxToColor $ + DeclPrinter.prettyDeclW + -- Sort of a hack; since the decl printer looks in the PPE for names of constructors, + -- we just delete all term names out and add back the constructors... + -- probably no need to wipe out the suffixified side but we do it anyway + (setPpedToConstructorNames declNameLookup name ref ppe) + (Reference.fromId ref) + (HQ.NameOnly name) + typ + + renderTerm :: Set Name -> Name -> (Term v a, Type v a) -> Maybe (Pretty ColorText) + renderTerm accessorNames name (term, typ) = do + guard (not (Set.member name accessorNames)) + let hqName = HQ.NameOnly name + let rendered + | Typechecker.isEqual (Builtin.Decls.testResultListType mempty) typ = + "test> " <> TermPrinter.prettyBindingWithoutTypeSignature ppe.suffixifiedPPE hqName term + | otherwise = TermPrinter.prettyBinding ppe.suffixifiedPPE hqName term + Just (Pretty.syntaxToColor rendered) + +setPpedToConstructorNames :: DeclNameLookup -> Name -> TypeReferenceId -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl +setPpedToConstructorNames declNameLookup name ref = + set (#unsuffixifiedPPE . #termNames) referentNames + . set (#suffixifiedPPE . #termNames) referentNames + where + constructorNameMap :: Map ConstructorReference Name + constructorNameMap = + Map.fromList + ( name + & expectConstructorNames declNameLookup + & List.zip [0 ..] + & over (mapped . _1) (ConstructorReference (Reference.fromId ref)) + ) + + referentNames :: Referent -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)] + referentNames = \case + Referent.Con conRef _ -> + case Map.lookup conRef constructorNameMap of + Nothing -> [] + Just conName -> let hqConName = HQ'.NameOnly conName in [(hqConName, hqConName)] + Referent.Ref _ -> [] diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 176a781bfa..85d10b7d74 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -15,10 +15,7 @@ module Unison.Codebase.Editor.HandleInput.Merge2 ) where -import Control.Lens (mapped, _1) import Control.Monad.Reader (ask) -import Control.Monad.Writer (Writer) -import Control.Monad.Writer qualified as Writer import Data.Bifoldable (bifoldMap) import Data.Bitraversable (bitraverse) import Data.Foldable qualified as Foldable @@ -47,12 +44,12 @@ import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Queries -import Unison.Builtin.Decls qualified as Builtin.Decls import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceAndTarget (..), MergeSourceOrTarget (..)) 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.UpdateUtils (hydrateDefns, renderDefnsForUnisonFile) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) @@ -74,13 +71,8 @@ import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache) import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions import Unison.Codebase.SqliteCodebase.Operations qualified as Operations -import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) -import Unison.DataDeclaration (Decl) import Unison.Debug qualified as Debug -import Unison.Hash (Hash) import Unison.Hash qualified as Hash -import Unison.HashQualified qualified as HQ -import Unison.HashQualifiedPrime qualified as HQ' import Unison.Merge.CombineDiffs (CombinedDiffOp (..), combineDiffs) import Unison.Merge.Database (MergeDatabase (..), makeMergeDatabase, referent2to1) import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason (..), checkDeclCoherency, lenientCheckDeclCoherency) @@ -112,7 +104,6 @@ import Unison.NameSegment.Internal qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Prelude -import Unison.PrettyPrintEnv (PrettyPrintEnv (..)) import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.PrettyPrintEnvDecl.Names qualified as PPED @@ -123,13 +114,7 @@ import Unison.Referent qualified as Referent import Unison.ReferentPrime qualified as Referent' import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite -import Unison.Syntax.DeclPrinter (AccessorName) -import Unison.Syntax.DeclPrinter qualified as DeclPrinter import Unison.Syntax.Name qualified as Name -import Unison.Syntax.TermPrinter qualified as TermPrinter -import Unison.Term (Term) -import Unison.Type (Type) -import Unison.Typechecker qualified as Typechecker import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3, alignDefnsWith, defnsAreEmpty, zipDefnsWith, zipDefnsWith3) @@ -141,8 +126,6 @@ import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Relation import Unison.Util.Star2 (Star2) import Unison.Util.Star2 qualified as Star2 -import Unison.Util.SyntaxText (SyntaxText') -import Unison.Var (Var) import Witch (unsafeFrom) import Prelude hiding (unzip, zip, zipWith) @@ -260,14 +243,21 @@ doMerge info = do Just (who, branch) -> do defns <- loadDefns branch declNameLookup <- - Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) & onLeftM \err -> - done case err of - IncoherentDeclReason'ConstructorAlias typeName conName1 conName2 -> - Output.MergeConstructorAlias who typeName conName1 conName2 - IncoherentDeclReason'MissingConstructorName name -> Output.MergeMissingConstructorName who name - IncoherentDeclReason'NestedDeclAlias shorterName longerName -> - Output.MergeNestedDeclAlias who shorterName longerName - IncoherentDeclReason'StrayConstructor name -> Output.MergeStrayConstructor who name + Cli.runTransaction + ( checkDeclCoherency + db.loadDeclNumConstructors + Referent.toConstructorReferenceId + Reference.toId + defns + ) + & onLeftM \err -> + done case err of + IncoherentDeclReason'ConstructorAlias typeName conName1 conName2 -> + Output.MergeConstructorAlias who typeName conName1 conName2 + IncoherentDeclReason'MissingConstructorName name -> Output.MergeMissingConstructorName who name + IncoherentDeclReason'NestedDeclAlias shorterName longerName -> + Output.MergeNestedDeclAlias who shorterName longerName + IncoherentDeclReason'StrayConstructor _typeRef name -> Output.MergeStrayConstructor who name pure (defns, declNameLookup) (aliceDefns0, aliceDeclNameLookup) <- load (Just (mergeTarget, branches.alice)) @@ -345,32 +335,14 @@ doMerge info = do in (,) <$> hydrate conflicts1 <*> hydrate dependents1 let (renderedConflicts, renderedDependents) = - let honk declNameLookup ppe defns = - let (types, accessorNames) = - Writer.runWriter $ - defns.types & Map.traverseWithKey \name (ref, typ) -> - renderTypeBinding - -- Sort of a hack; since the decl printer looks in the PPE for names of constructors, - -- we just delete all term names out and add back the constructors... - -- probably no need to wipe out the suffixified side but we do it anyway - (setPpedToConstructorNames declNameLookup name ref ppe) - name - ref - typ - terms = - defns.terms & Map.mapMaybeWithKey \name (term, typ) -> - if Set.member name accessorNames - then Nothing - else Just (renderTermBinding ppe.suffixifiedPPE name term typ) - in Defns {terms, types} - in unzip $ - ( \declNameLookup (conflicts, dependents) ppe -> - let honk1 = honk declNameLookup ppe - in (honk1 conflicts, honk1 dependents) - ) - <$> declNameLookups - <*> hydratedThings - <*> ppes + unzip $ + ( \declNameLookup (conflicts, dependents) ppe -> + let honk1 = renderDefnsForUnisonFile declNameLookup ppe + in (honk1 conflicts, honk1 dependents) + ) + <$> declNameLookups + <*> hydratedThings + <*> ppes let prettyUnisonFile = makePrettyUnisonFile @@ -489,7 +461,7 @@ loadLibdeps branches = do ------------------------------------------------------------------------------------------------------------------------ -- Merge precondition violation checks -hasDefnsInLib :: Applicative m => V2.Branch m -> m Bool +hasDefnsInLib :: (Applicative m) => V2.Branch m -> m Bool hasDefnsInLib branch = do libdeps <- case Map.lookup NameSegment.libSegment branch.children of @@ -500,95 +472,6 @@ hasDefnsInLib branch = do ------------------------------------------------------------------------------------------------------------------------ -- Creating Unison files -hydrateDefns :: - (Monad m, Ord name) => - (Hash -> m [term]) -> - (Hash -> m [typ]) -> - DefnsF (Map name) TermReferenceId TypeReferenceId -> - m (DefnsF (Map name) term (TypeReferenceId, typ)) -hydrateDefns getTermComponent getTypeComponent = do - bitraverse (hydrateTerms getTermComponent) (hydrateTypes getTypeComponent) - -hydrateTerms :: (Monad m, Ord name) => (Hash -> m [term]) -> Map name TermReferenceId -> m (Map name term) -hydrateTerms getTermComponent terms = - componenty getTermComponent terms \_ _ -> id - -hydrateTypes :: - (Monad m, Ord name) => - (Hash -> m [typ]) -> - Map name TypeReferenceId -> - m (Map name (TypeReferenceId, typ)) -hydrateTypes getTypeComponent types = - componenty getTypeComponent types \_ -> (,) - -componenty :: - forall a b name m. - (Monad m, Ord name) => - (Hash -> m [a]) -> - Map name Reference.Id -> - (name -> Reference.Id -> a -> b) -> - m (Map name b) -componenty getComponent things modify = - Foldable.foldlM f Map.empty (foldMap (Set.singleton . Reference.idToHash) things) - where - f :: Map name b -> Hash -> m (Map name b) - f acc hash = - List.foldl' g acc . Reference.componentFor hash <$> getComponent hash - - g :: Map name b -> (Reference.Id, a) -> Map name b - g acc (ref, thing) = - Set.foldl' (h ref thing) acc (BiMultimap.lookupDom ref things2) - - h :: Reference.Id -> a -> Map name b -> name -> Map name b - h ref thing acc name = - Map.insert name (modify name ref thing) acc - - things2 :: BiMultimap Reference.Id name - things2 = - BiMultimap.fromRange things - -renderTermBinding :: (Monoid a, Var v) => PrettyPrintEnv -> Name -> Term v a -> Type v a -> Pretty ColorText -renderTermBinding ppe (HQ.NameOnly -> name) term typ = - Pretty.syntaxToColor rendered - where - rendered :: Pretty (SyntaxText' Reference) - rendered = - if Typechecker.isEqual (Builtin.Decls.testResultListType mempty) typ - then "test> " <> TermPrinter.prettyBindingWithoutTypeSignature ppe name term - else TermPrinter.prettyBinding ppe name term - -renderTypeBinding :: - (Var v) => - PrettyPrintEnvDecl -> - Name -> - TypeReferenceId -> - Decl v a -> - Writer (Set AccessorName) (Pretty ColorText) -renderTypeBinding ppe name ref decl = - Pretty.syntaxToColor <$> DeclPrinter.prettyDeclW ppe (Reference.fromId ref) (HQ.NameOnly name) decl - -setPpedToConstructorNames :: DeclNameLookup -> Name -> TypeReferenceId -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl -setPpedToConstructorNames declNameLookup name ref = - set (#unsuffixifiedPPE . #termNames) referentNames - . set (#suffixifiedPPE . #termNames) referentNames - where - constructorNameMap :: Map ConstructorReference Name - constructorNameMap = - Map.fromList - ( name - & expectConstructorNames declNameLookup - & List.zip [0 ..] - & over (mapped . _1) (ConstructorReference (Reference.fromId ref)) - ) - - referentNames :: Referent -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)] - referentNames = \case - Referent.Con conRef _ -> - case Map.lookup conRef constructorNameMap of - Nothing -> [] - Just conName -> let hqConName = HQ'.NameOnly conName in [(hqConName, hqConName)] - Referent.Ref _ -> [] - makePrettyUnisonFile :: TwoWay Text -> TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> @@ -696,7 +579,7 @@ defnsAndLibdepsToBranch0 codebase defns libdeps = let -- Unflatten the collection of terms into tree, ditto for types nametrees :: DefnsF2 Nametree (Map NameSegment) Referent TypeReference nametrees = - bimap go go defns + bimap unflattenNametree unflattenNametree defns -- Align the tree of terms and tree of types into one tree nametree :: Nametree (DefnsF (Map NameSegment) Referent TypeReference) @@ -715,10 +598,6 @@ defnsAndLibdepsToBranch0 codebase defns libdeps = -- Awkward: we have a Branch Transaction but we need a Branch IO (because reasons) branch2 = Branch.transform0 (Codebase.runTransaction codebase) branch1 in branch2 - where - go :: (Ord v) => Map Name v -> Nametree (Map NameSegment v) - go = - unflattenNametree . BiMultimap.fromRange nametreeToBranch0 :: Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> Branch0 m nametreeToBranch0 nametree = diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index 108ceee2a4..3771eeb224 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -27,6 +27,8 @@ import Unison.Reference (TermReference) import Unison.Syntax.Name qualified as Name import Unison.Util.Defns (Defns (..)) import Unison.Util.Set qualified as Set +import qualified Unison.Referent as Referent +import qualified Unison.Reference as Reference handleTodo :: Cli () handleTodo = do @@ -72,6 +74,8 @@ handleTodo = do fmap (Either.fromLeft (IncoherentDeclReasons [] [] [] [])) $ checkAllDeclCoherency Operations.expectDeclNumConstructors + Referent.toConstructorReferenceId + Reference.toId (Names.lenientToNametree (Branch.toNames currentNamespaceWithoutLibdeps)) pure (defnsInLib, dependentsOfTodo.terms, directDependencies, hashLen, incoherentDeclReasons) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 007103597a..9dae25fa1c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -23,16 +23,20 @@ import Control.Lens qualified as Lens import Control.Monad.RWS (ask) import Data.Bifoldable (bifoldMap) import Data.Foldable qualified as Foldable +import Data.List qualified as List import Data.List.NonEmpty qualified as NonEmpty import Data.List.NonEmpty.Extra ((|>)) import Data.Map qualified as Map import Data.Maybe (fromJust) +import Data.Semialign (alignWith) import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.Lazy qualified as Lazy.Text +import Data.These (These (..)) import Text.Pretty.Simple (pShow) import U.Codebase.Reference (Reference, TermReferenceId) import U.Codebase.Reference qualified as Reference +import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Operations qualified as Ops import Unison.Builtin.Decls qualified as Decls import Unison.Cli.Monad (Cli) @@ -41,6 +45,7 @@ import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.Pretty qualified as Pretty import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) import Unison.Cli.UniqueTypeGuidLookup qualified as Cli +import Unison.Cli.UpdateUtils (hydrateDefns, hydrateDefnsRel, narrowDefns, renderDefnsForUnisonFile) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch @@ -51,14 +56,17 @@ import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath (ProjectPath) +import Unison.Codebase.SqliteCodebase.Operations qualified as Operations import Unison.Codebase.Type (Codebase) import Unison.ConstructorReference (GConstructorReference (ConstructorReference)) import Unison.DataDeclaration (DataDeclaration, Decl) +import Unison.DataDeclaration qualified as DataDeclaration import Unison.DataDeclaration qualified as Decl import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.Debug qualified as Debug import Unison.FileParsers qualified as FileParsers import Unison.Hash (Hash) +import Unison.Merge.DeclCoherencyCheck (checkDeclCoherency) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Name.Forward (ForwardName (..)) @@ -75,7 +83,7 @@ import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl) import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.PrettyPrintEnvDecl.Names qualified as PPED -import Unison.Reference (TypeReference, TypeReferenceId) +import Unison.Reference (Reference' (..), TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference (fromId) import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -93,9 +101,10 @@ import Unison.UnisonFile.Names qualified as UF import Unison.UnisonFile.Type (TypecheckedUnisonFile) import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap -import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty) import Unison.Util.Monoid qualified as Monoid -import Unison.Util.Pretty (Pretty) +import Unison.Util.Nametree (Nametree, unflattenNametree) +import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Relation @@ -110,51 +119,156 @@ handleUpdate2 = do let termAndDeclNames = getTermAndDeclNames tuf pp <- Cli.getCurrentProjectPath currentBranch0 <- Cli.getCurrentBranch0 + let currentBranch0ExcludingLibdeps = Branch.deleteLibdeps currentBranch0 let namesIncludingLibdeps = Branch.toNames currentBranch0 - let namesExcludingLibdeps = Branch.toNames (currentBranch0 & over Branch.children (Map.delete NameSegment.libSegment)) + let namesExcludingLibdeps = Branch.toNames currentBranch0ExcludingLibdeps let ctorNames = forwardCtorNames namesExcludingLibdeps Cli.respond Output.UpdateLookingForDependents - (pped, bigUf) <- Cli.runTransactionWithRollback \abort -> do - dependents <- - getNamespaceDependentsOf namesExcludingLibdeps (getExistingReferencesNamed termAndDeclNames namesExcludingLibdeps) - hashLen <- Codebase.hashLength - bigUf <- - addDefinitionsToUnisonFile - abort - codebase - (findCtorNames Output.UOUUpdate namesExcludingLibdeps ctorNames) - dependents - (UF.discardTypes tuf) - pure (makeComplicatedPPE hashLen namesIncludingLibdeps (UF.typecheckedToNames tuf) dependents, bigUf) - - -- If the new-unison-file-to-typecheck is the same as old-unison-file-that-we-already-typechecked, then don't bother - -- typechecking again. + + -- Get all namings of all dependents of the stuff we're considering updating. + dependentsAndConstructors <- do + dependents0 <- + Cli.runTransaction do + getNamespaceDependentsOf + namesExcludingLibdeps + (getExistingReferencesNamed termAndDeclNames namesExcludingLibdeps) + + -- Throw away the dependents that are shadowed by the file itself + let dependents1 :: DefnsF (Relation Name) TermReferenceId TypeReferenceId + dependents1 = + bimap + (Relation.subtractDom (Set.map Name.unsafeParseVar (UF.termNamespaceBindings tuf))) + (Relation.subtractDom (Set.map Name.unsafeParseVar (UF.typeNamespaceBindings tuf))) + dependents0 + + let dependentTypeRefs :: Set TypeReferenceId + dependentTypeRefs = + Relation.ran dependents1.types + + -- Add in constructors of dependent types. The constructors aren't "dependents" per se, but we need them for + -- computing the decl name lookup for all dependent types. + -- + -- Unlike top-level term and type definitions, these names aren't shadowed by the Unison file. For example, if some + -- "Foo.Bar = 5" term exists, we still want to fetch any "Foo.Bar" constructor here, too. The name collision will + -- manifest as a duplicate binding error later on. + let dependents2 :: DefnsF (Relation Name) Referent.Id TypeReferenceId + dependents2 = + dependents1 + & over #terms \terms -> + Relation.union + (Relation.mapRanMonotonic Referent.RefId terms) + ( foldr + ( \case + (Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) conTy, name) + | Set.member typeRef dependentTypeRefs -> + Relation.insert name (Referent.ConId (ConstructorReference typeRef conId) conTy) + _ -> id + ) + Relation.empty + (Relation.toList (Branch.deepTerms currentBranch0ExcludingLibdeps)) + ) + + -- Of the ones that remain, try to narrow to a left-unique relation (no conflicted names). + dependents3 <- + narrowDefns dependents2 & onLeft \conflictedName -> + wundefined conflictedName + + -- Throw away the ref->name direction because we don't need it + let dependents4 :: DefnsF (Map Name) Referent.Id TypeReferenceId + dependents4 = + bimap BiMultimap.range BiMultimap.range dependents3 + + pure dependents4 + + let dependents :: DefnsF (Map Name) TermReferenceId TypeReferenceId + dependents = + over #terms (Map.mapMaybe Referent.toTermReference) dependentsAndConstructors + + let dependentsNametree :: Nametree (DefnsF (Map NameSegment) Referent.Id TypeReferenceId) + dependentsNametree = + alignWith + ( \case + This terms -> Defns {terms, types = Map.empty} + That types -> Defns {terms = Map.empty, types} + These terms types -> Defns {terms, types} + ) + (unflattenNametree dependentsAndConstructors.terms) + (unflattenNametree dependentsAndConstructors.types) + + dependentsDeclNameLookup <- + Cli.runTransaction + ( checkDeclCoherency + Operations.expectDeclNumConstructors + Referent.toConstructorReference + Just + dependentsNametree + ) + & onLeftM \err -> liftIO (print err) >> wundefined + secondTuf <- do - let smallUf = UF.discardTypes tuf - let noChanges = - and - [ Map.size (UF.dataDeclarationsId smallUf) == Map.size (UF.dataDeclarationsId bigUf), - Map.size (UF.effectDeclarationsId smallUf) == Map.size (UF.effectDeclarationsId bigUf), - Map.size (UF.terms smallUf) == Map.size (UF.terms bigUf), - Map.size (UF.watches smallUf) == Map.size (UF.watches bigUf) - ] - if noChanges - then pure tuf - else do + case defnsAreEmpty dependents of + -- If there are no dependents of the updates, then just use the already-typechecked file. + True -> pure tuf + False -> do + hydratedDependents <- + Cli.runTransaction do + hydrateDefns + (Codebase.unsafeGetTermComponent codebase) + Operations.expectDeclComponent + dependents + + let ppe = makeComplicatedPPE2 10 namesIncludingLibdeps (UF.typecheckedToNames tuf) dependents + + let renderedDependents :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) + renderedDependents = + renderDefnsForUnisonFile dependentsDeclNameLookup ppe hydratedDependents + + let prettyUnisonFile = + makePrettyUnisonFile + ( Pretty.prettyUnisonFile + (makeComplicatedPPE2 10 namesIncludingLibdeps (UF.typecheckedToNames tuf) dependents) + (UF.discardTypes tuf) + ) + renderedDependents + Cli.respond Output.UpdateStartTypechecking + parsingEnv <- makeParsingEnv pp namesIncludingLibdeps + secondTuf <- - prettyParseTypecheck bigUf pped parsingEnv & onLeftM \prettyUf -> do + prettyParseTypecheck2 prettyUnisonFile parsingEnv & onLeftM \prettyUf -> do scratchFilePath <- fst <$> Cli.expectLatestFile liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUf) Cli.returnEarly Output.UpdateTypecheckingFailure + Cli.respond Output.UpdateTypecheckingSuccess + pure secondTuf saveTuf (findCtorNamesMaybe Output.UOUUpdate namesExcludingLibdeps ctorNames Nothing) secondTuf Cli.respond Output.Success +makePrettyUnisonFile :: Pretty ColorText -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) -> Pretty ColorText +makePrettyUnisonFile originalFile dependents = + originalFile + <> Pretty.newline + <> Pretty.newline + <> "-- The definitions below are not compatible with the updated definitions above." + <> "-- Please fix the errors and run `update` again." + <> Pretty.newline + <> Pretty.newline + <> ( dependents + & inAlphabeticalOrder + & let f = foldMap (<> "\n") in bifoldMap f f + ) + where + inAlphabeticalOrder :: DefnsF (Map Name) a b -> DefnsF [] a b + inAlphabeticalOrder = + bimap f f + where + f = map snd . List.sortOn (Name.toText . fst) . Map.toList + -- TODO: find a better module for this function, as it's used in a couple places prettyParseTypecheck :: UnisonFile Symbol Ann -> @@ -378,12 +492,12 @@ makeUnisonFile abort codebase doFindCtorNames defns = do overwriteConstructorNames name ed.toDataDecl <&> \ed' -> uf & #effectDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') Right dd -> overwriteConstructorNames name dd <&> \dd' -> uf & #dataDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') -- Constructor names are bogus when pulled from the database, so we set them to what they should be here overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann) @@ -580,12 +694,79 @@ makeComplicatedPPE :: DefnsF (Relation Name) TermReferenceId TypeReferenceId -> PrettyPrintEnvDecl makeComplicatedPPE hashLen names initialFileNames dependents = - PPED.makePPED (PPE.namer namesInTheFile) (PPE.suffixifyByName namesInTheFile) - `PPED.addFallback` PPED.makePPED (PPE.hqNamer hashLen namesInTheNamespace) (PPE.suffixifyByHash namesInTheNamespace) + primaryPPE `PPED.addFallback` secondaryPPE where + primaryPPE = + PPED.makePPED (PPE.namer namesInTheFile) (PPE.suffixifyByName namesInTheFile) + + secondaryPPE = + PPED.makePPED + (PPE.hqNamer hashLen names) + -- We don't want to over-suffixify for a reference in the namespace. For example, say we have "foo.bar" in the + -- namespace and "oink.bar" in the file. "bar" may be a unique suffix among the namespace names, but would be + -- ambiguous in the context of namespace + file names. + -- + -- So, we use `unionLeftName`, which starts with the LHS names (the namespace), and adds to it names from the + -- RHS (the initial file names, i.e. what was originally saved) that don't already exist in the LHS. + (PPE.suffixifyByHash (Names.unionLeftName names initialFileNames)) + namesInTheFile = - initialFileNames - <> Names - (Relation.mapRan Referent.fromTermReferenceId dependents.terms) - (Relation.mapRan Reference.fromId dependents.types) - namesInTheNamespace = Names.unionLeftName names initialFileNames + initialFileNames <> dependentsNames + + dependentsNames = + Names + { terms = Relation.mapRan Referent.fromTermReferenceId dependents.terms, + types = Relation.mapRan Reference.fromId dependents.types + } + +-- The big picture behind PPE building, though there are many details: +-- +-- * We are updating old references to new references by rendering old references as names that are then parsed +-- back to resolve to new references (the world's weirdest implementation of AST substitution). +-- +-- * We have to render names that refer to definitions in the file with a different suffixification strategy +-- (namely, "suffixify by name") than names that refer to things in the codebase. +-- +-- This is because you *may* refer to aliases that share a suffix by that suffix for definitions in the +-- codebase, but not in the file. +-- +-- For example, the following file will fail to parse: +-- +-- one.foo = 10 +-- two.foo = 10 +-- hey = foo + foo -- "Which foo do you mean? There are two." +-- +-- However, the following file will not fail to parse, if `one.foo` and `two.foo` are aliases in the codebase: +-- +-- hey = foo + foo +makeComplicatedPPE2 :: + Int -> + Names -> + Names -> + DefnsF (Map Name) TermReferenceId TypeReferenceId -> + PrettyPrintEnvDecl +makeComplicatedPPE2 hashLen names initialFileNames dependents = + primaryPPE `PPED.addFallback` secondaryPPE + where + primaryPPE = + PPED.makePPED (PPE.namer namesInTheFile) (PPE.suffixifyByName namesInTheFile) + + secondaryPPE = + PPED.makePPED + (PPE.hqNamer hashLen names) + -- We don't want to over-suffixify for a reference in the namespace. For example, say we have "foo.bar" in the + -- namespace and "oink.bar" in the file. "bar" may be a unique suffix among the namespace names, but would be + -- ambiguous in the context of namespace + file names. + -- + -- So, we use `unionLeftName`, which starts with the LHS names (the namespace), and adds to it names from the + -- RHS (the initial file names, i.e. what was originally saved) that don't already exist in the LHS. + (PPE.suffixifyByHash (Names.unionLeftName names initialFileNames)) + + namesInTheFile = + initialFileNames <> dependentsNames + + dependentsNames = + Names + { terms = Relation.fromMap (Map.map Referent.fromTermReferenceId dependents.terms), + types = Relation.fromMap (Map.map Reference.fromId dependents.types) + } diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 473e3d01c6..861b339eb3 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2773,7 +2773,7 @@ handleTodoOutput todo [] -> pure mempty constructors -> do nums <- - for constructors \constructor -> do + for constructors \(_typeRef, constructor) -> do addNumberedArg (SA.Name constructor) -- Note [StrayConstructorMessage] If you change this, also change the other similar one pure $ @@ -2784,7 +2784,7 @@ handleTodoOutput todo 2 ( P.lines ( zipWith - (\n constructor -> formatNum n <> prettyName constructor) + (\n (_typeRef, constructor) -> formatNum n <> prettyName constructor) nums constructors ) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index b5a29cc483..5d192ddbbc 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -47,6 +47,7 @@ library Unison.Cli.Share.Projects.Types Unison.Cli.TypeCheck Unison.Cli.UniqueTypeGuidLookup + Unison.Cli.UpdateUtils Unison.Codebase.Editor.AuthorInfo Unison.Codebase.Editor.HandleInput Unison.Codebase.Editor.HandleInput.AddRun diff --git a/unison-core/src/Unison/ConstructorReference.hs b/unison-core/src/Unison/ConstructorReference.hs index 20fc68a9c5..32985c69b8 100644 --- a/unison-core/src/Unison/ConstructorReference.hs +++ b/unison-core/src/Unison/ConstructorReference.hs @@ -4,6 +4,7 @@ module Unison.ConstructorReference ConstructorReference, ConstructorReferenceId, reference_, + toId, toShortHash, ) where @@ -29,6 +30,10 @@ reference_ :: Lens (GConstructorReference r) (GConstructorReference s) r s reference_ = lens (\(ConstructorReference r _) -> r) \(ConstructorReference _ i) r -> ConstructorReference r i +toId :: ConstructorReference -> Maybe ConstructorReferenceId +toId (ConstructorReference typeRef conId) = + ConstructorReference <$> Reference.toId typeRef <*> pure conId + toShortHash :: ConstructorReference -> ShortHash toShortHash (ConstructorReference r i) = case Reference.toShortHash r of diff --git a/unison-core/src/Unison/Names.hs b/unison-core/src/Unison/Names.hs index 7080122c04..8cef280107 100644 --- a/unison-core/src/Unison/Names.hs +++ b/unison-core/src/Unison/Names.hs @@ -544,10 +544,6 @@ lenientToNametree names = where lenientRelationToNametree :: Ord a => Relation Name a -> Nametree (Map NameSegment a) lenientRelationToNametree = - unflattenNametree . lenientRelationToLeftUniqueRelation - - lenientRelationToLeftUniqueRelation :: (Ord a, Ord b) => Relation a b -> BiMultimap b a - lenientRelationToLeftUniqueRelation = - -- The partial `Set.findMin` are fine here because Relation.domain only has non-empty Set values. A NESet would be + -- The partial `Set.findMin` is fine here because Relation.domain only has non-empty Set values. A NESet would be -- better. - BiMultimap.fromRange . Map.map Set.findMin . Relation.domain + unflattenNametree . Map.map Set.findMin . Relation.domain diff --git a/unison-core/src/Unison/Referent.hs b/unison-core/src/Unison/Referent.hs index 104a88e6f0..bf89ed878f 100644 --- a/unison-core/src/Unison/Referent.hs +++ b/unison-core/src/Unison/Referent.hs @@ -12,6 +12,8 @@ module Unison.Referent toId, toReference, toReferenceId, + toConstructorReference, + toConstructorReferenceId, toTermReference, toTermReferenceId, fromId, @@ -119,7 +121,16 @@ toReference = toReference' toReferenceId :: Referent -> Maybe Reference.Id toReferenceId = Reference.toId . toReference -toTermReference :: Referent -> Maybe TermReference +toConstructorReference :: Referent' r -> Maybe (GConstructorReference r) +toConstructorReference = \case + Con' r _ -> Just r + Ref' _ -> Nothing + +toConstructorReferenceId :: Referent -> Maybe ConstructorReferenceId +toConstructorReferenceId = + toConstructorReference >=> ConstructorReference.toId + +toTermReference :: Referent' r -> Maybe r toTermReference = \case Con' _ _ -> Nothing Ref' reference -> Just reference @@ -129,7 +140,7 @@ toTermReferenceId r = toTermReference r >>= Reference.toId -- | Inject a Term Reference into a Referent fromTermReference :: TermReference -> Referent -fromTermReference r = Ref r +fromTermReference = Ref fromTermReferenceId :: TermReferenceId -> Referent fromTermReferenceId = fromTermReference . Reference.fromId diff --git a/unison-core/src/Unison/Util/Defn.hs b/unison-core/src/Unison/Util/Defn.hs new file mode 100644 index 0000000000..d897491de4 --- /dev/null +++ b/unison-core/src/Unison/Util/Defn.hs @@ -0,0 +1,9 @@ +module Unison.Util.Defn + ( Defn (..), + ) +where + +-- | A "definition" is either a term or a type. +data Defn term typ + = TermDefn term + | TypeDefn typ diff --git a/unison-core/src/Unison/Util/Nametree.hs b/unison-core/src/Unison/Util/Nametree.hs index 18a6ba3769..e5d6c468ac 100644 --- a/unison-core/src/Unison/Util/Nametree.hs +++ b/unison-core/src/Unison/Util/Nametree.hs @@ -120,9 +120,9 @@ flattenNametree f = -- > "baz" = #baz -- > } -- > } -unflattenNametree :: Ord a => BiMultimap a Name -> Nametree (Map NameSegment a) +unflattenNametree :: Ord a => Map Name a -> Nametree (Map NameSegment a) unflattenNametree = - unfoldNametree unflattenLevel . map (first Name.segments) . Map.toList . BiMultimap.range + unfoldNametree unflattenLevel . map (first Name.segments) . Map.toList where unflattenLevel :: [(NonEmpty NameSegment, a)] -> (Map NameSegment a, Map NameSegment [(NonEmpty NameSegment, a)]) unflattenLevel = diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal index 51f20e271a..d32e775306 100644 --- a/unison-core/unison-core1.cabal +++ b/unison-core/unison-core1.cabal @@ -55,6 +55,7 @@ library Unison.Type Unison.Type.Names Unison.Util.Components + Unison.Util.Defn Unison.Util.Defns Unison.Util.Nametree Unison.Var diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 302e46a298..465b08ff5f 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -103,7 +103,7 @@ import Data.Map.Strict qualified as Map import Data.Maybe (fromJust) import Data.Set qualified as Set import U.Codebase.Reference (Reference' (..), TypeReference, TypeReferenceId) -import Unison.ConstructorReference (GConstructorReference (..)) +import Unison.ConstructorReference (ConstructorReferenceId, GConstructorReference (..)) import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) @@ -130,43 +130,49 @@ data IncoherentDeclReason -- Foo#Foo -- Foo.Bar#Foo IncoherentDeclReason'NestedDeclAlias !Name !Name -- shorter name, longer name - | IncoherentDeclReason'StrayConstructor !Name + | IncoherentDeclReason'StrayConstructor !TypeReferenceId !Name + deriving stock (Show) checkDeclCoherency :: - forall m. - Monad m => + forall m tm ty. + (Monad m) => (TypeReferenceId -> m Int) -> - Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> + (tm -> Maybe ConstructorReferenceId) -> + (ty -> Maybe TypeReferenceId) -> + Nametree (DefnsF (Map NameSegment) tm ty) -> m (Either IncoherentDeclReason DeclNameLookup) -checkDeclCoherency loadDeclNumConstructors nametree = - Except.runExceptT - ( checkDeclCoherencyWith - (lift . loadDeclNumConstructors) - OnIncoherentDeclReasons - { onConstructorAlias = \x y z -> Except.throwError (IncoherentDeclReason'ConstructorAlias x y z), -- :: Name -> Name -> Name -> m (), - onMissingConstructorName = \x -> Except.throwError (IncoherentDeclReason'MissingConstructorName x), -- :: Name -> m (), - onNestedDeclAlias = \x y -> Except.throwError (IncoherentDeclReason'NestedDeclAlias x y), -- :: Name -> Name -> m (), - onStrayConstructor = \x -> Except.throwError (IncoherentDeclReason'StrayConstructor x) -- :: Name -> m () - } - nametree - ) +checkDeclCoherency loadDeclNumConstructors toConRefId toTypeRefId nametree = + Except.runExceptT $ + checkDeclCoherencyWith + (lift . loadDeclNumConstructors) + OnIncoherentDeclReasons + { onConstructorAlias = \x y z -> Except.throwError (IncoherentDeclReason'ConstructorAlias x y z), + onMissingConstructorName = \x -> Except.throwError (IncoherentDeclReason'MissingConstructorName x), + onNestedDeclAlias = \x y -> Except.throwError (IncoherentDeclReason'NestedDeclAlias x y), + onStrayConstructor = \x y -> Except.throwError (IncoherentDeclReason'StrayConstructor x y) + } + toConRefId + toTypeRefId + nametree data IncoherentDeclReasons = IncoherentDeclReasons { constructorAliases :: ![(Name, Name, Name)], missingConstructorNames :: ![Name], nestedDeclAliases :: ![(Name, Name)], - strayConstructors :: ![Name] + strayConstructors :: ![(TypeReferenceId, Name)] } deriving stock (Eq, Generic) -- | Like 'checkDeclCoherency', but returns info about all of the incoherent decls found, not just the first. checkAllDeclCoherency :: - forall m. - Monad m => + forall m tm ty. + (Monad m) => (TypeReferenceId -> m Int) -> - Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> + (tm -> Maybe ConstructorReferenceId) -> + (ty -> Maybe TypeReferenceId) -> + Nametree (DefnsF (Map NameSegment) tm ty) -> m (Either IncoherentDeclReasons DeclNameLookup) -checkAllDeclCoherency loadDeclNumConstructors nametree = do +checkAllDeclCoherency loadDeclNumConstructors toConRefId toTypeRefId nametree = do State.runStateT doCheck emptyReasons <&> \(declNameLookup, reasons) -> if reasons == emptyReasons then Right declNameLookup @@ -180,9 +186,11 @@ checkAllDeclCoherency loadDeclNumConstructors nametree = do { onConstructorAlias = \x y z -> #constructorAliases %= ((x, y, z) :), onMissingConstructorName = \x -> #missingConstructorNames %= (x :), onNestedDeclAlias = \x y -> #nestedDeclAliases %= ((x, y) :), - onStrayConstructor = \x -> #strayConstructors %= (x :) + onStrayConstructor = \x y -> #strayConstructors %= ((x, y) :) } ) + toConRefId + toTypeRefId nametree emptyReasons :: IncoherentDeclReasons @@ -202,126 +210,149 @@ data OnIncoherentDeclReasons m = OnIncoherentDeclReasons { onConstructorAlias :: Name -> Name -> Name -> m (), onMissingConstructorName :: Name -> m (), onNestedDeclAlias :: Name -> Name -> m (), - onStrayConstructor :: Name -> m () + onStrayConstructor :: TypeReferenceId -> Name -> m () } checkDeclCoherencyWith :: - forall m. - Monad m => + forall m tm ty. + (Monad m) => (TypeReferenceId -> m Int) -> OnIncoherentDeclReasons m -> - Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> + (tm -> Maybe ConstructorReferenceId) -> + (ty -> Maybe TypeReferenceId) -> + Nametree (DefnsF (Map NameSegment) tm ty) -> m DeclNameLookup -checkDeclCoherencyWith loadDeclNumConstructors callbacks = +checkDeclCoherencyWith loadDeclNumConstructors callbacks toConRefId toTypeRefId = fmap (view #declNameLookup) . (`State.execStateT` DeclCoherencyCheckState Map.empty (DeclNameLookup Map.empty Map.empty)) . go [] where go :: [NameSegment] -> - (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + (Nametree (DefnsF (Map NameSegment) tm ty)) -> StateT DeclCoherencyCheckState m () go prefix (Nametree defns children) = do - for_ (Map.toList defns.terms) (checkDeclCoherencyWith_DoTerms callbacks prefix) + for_ + (Map.toList defns.terms) + ( checkDeclCoherencyWith_DoTerms + callbacks + toConRefId + prefix + ) childrenWeWentInto <- forMaybe (Map.toList defns.types) - (checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix children) + (checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks toTypeRefId go prefix children) let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child checkDeclCoherencyWith_DoTerms :: - forall m. - Monad m => + forall m ref. + (Monad m) => OnIncoherentDeclReasons m -> + (ref -> Maybe ConstructorReferenceId) -> [NameSegment] -> - (NameSegment, Referent) -> + (NameSegment, ref) -> StateT DeclCoherencyCheckState m () -checkDeclCoherencyWith_DoTerms callbacks prefix = \case - (_, Referent.Ref _) -> pure () - (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure () - (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do +checkDeclCoherencyWith_DoTerms callbacks toConRefId prefix (segment, ref) = + whenJust (toConRefId ref) \(ConstructorReference typeRef conId) -> do + let f :: Maybe (Name, ConstructorNames) -> MaybeT m (Name, ConstructorNames) + f = \case + Nothing -> do + lift (callbacks.onStrayConstructor typeRef conName) + MaybeT (pure Nothing) + Just (typeName, expected) -> + case recordConstructorName conId conName expected of + Left existingName -> do + lift (callbacks.onConstructorAlias typeName existingName conName) + MaybeT (pure Nothing) + Right expected1 -> pure (typeName, expected1) + where + conName = + Name.fromReverseSegments (segment :| prefix) state <- State.get whenJustM (lift (runMaybeT (Map.upsertF f typeRef state.expectedConstructors))) \expectedConstructors1 -> #expectedConstructors .= expectedConstructors1 - where - f :: Maybe (Name, ConstructorNames) -> MaybeT m (Name, ConstructorNames) - f = \case - Nothing -> do - lift (callbacks.onStrayConstructor name1) - MaybeT (pure Nothing) - Just (typeName, expected) -> - case recordConstructorName conId name1 expected of - Left existingName -> do - lift (callbacks.onConstructorAlias typeName existingName name1) - MaybeT (pure Nothing) - Right expected1 -> pure (typeName, expected1) - where - name1 = - Name.fromReverseSegments (name :| prefix) checkDeclCoherencyWith_DoTypes :: - forall m. - Monad m => + forall m tm ty. + (Monad m) => (TypeReferenceId -> m Int) -> OnIncoherentDeclReasons m -> + (ty -> Maybe TypeReferenceId) -> ( [NameSegment] -> - (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + (Nametree (DefnsF (Map NameSegment) tm ty)) -> StateT DeclCoherencyCheckState m () ) -> [NameSegment] -> - Map NameSegment (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> - (NameSegment, TypeReference) -> + Map NameSegment (Nametree (DefnsF (Map NameSegment) tm ty)) -> + (NameSegment, ty) -> StateT DeclCoherencyCheckState m (Maybe NameSegment) -checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix children = \case - (_, ReferenceBuiltin _) -> pure Nothing - (name, ReferenceDerived typeRef) -> do - state <- State.get - maybeWhatHappened <- do - let recordNewDecl :: - Maybe (Name, ConstructorNames) -> - Compose (MaybeT m) WhatHappened (Name, ConstructorNames) - recordNewDecl = - Compose . \case - Just (shorterTypeName, _) -> do - lift (callbacks.onNestedDeclAlias shorterTypeName typeName) - MaybeT (pure Nothing) - Nothing -> - lift (loadDeclNumConstructors typeRef) <&> \case - 0 -> UninhabitedDecl - n -> InhabitedDecl (typeName, emptyConstructorNames n) - lift (runMaybeT (getCompose (Map.upsertF recordNewDecl typeRef state.expectedConstructors))) - case maybeWhatHappened of - Nothing -> pure Nothing - Just UninhabitedDecl -> do - #declNameLookup . #declToConstructors %= Map.insert typeName [] - pure Nothing - Just (InhabitedDecl expectedConstructors1) -> do - case Map.lookup name children of - Nothing -> do - lift (callbacks.onMissingConstructorName typeName) - pure Nothing - Just child -> do - #expectedConstructors .= expectedConstructors1 - go (name : prefix) child - state <- State.get - -- fromJust is safe here because we upserted `typeRef` key above - let (fromJust -> (_typeName, maybeConstructorNames), expectedConstructors1) = - Map.deleteLookup typeRef state.expectedConstructors - #expectedConstructors .= expectedConstructors1 - case sequence (IntMap.elems maybeConstructorNames) of - Nothing -> lift (callbacks.onMissingConstructorName typeName) - Just constructorNames -> do - #declNameLookup . #constructorToDecl %= \constructorToDecl -> - List.foldl' - (\acc constructorName -> Map.insert constructorName typeName acc) - constructorToDecl - constructorNames - #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames - pure (Just name) - where - typeName = - Name.fromReverseSegments (name :| prefix) +checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks toTypeRefId go prefix children (name, ref) = + case toTypeRefId ref of + Nothing -> pure Nothing + Just refId -> + checkDeclCoherencyWith_DoTypes2 loadDeclNumConstructors callbacks go prefix children name refId + +checkDeclCoherencyWith_DoTypes2 :: + forall m tm ty. + (Monad m) => + (TypeReferenceId -> m Int) -> + OnIncoherentDeclReasons m -> + ( [NameSegment] -> + (Nametree (DefnsF (Map NameSegment) tm ty)) -> + StateT DeclCoherencyCheckState m () + ) -> + [NameSegment] -> + Map NameSegment (Nametree (DefnsF (Map NameSegment) tm ty)) -> + NameSegment -> + TypeReferenceId -> + StateT DeclCoherencyCheckState m (Maybe NameSegment) +checkDeclCoherencyWith_DoTypes2 loadDeclNumConstructors callbacks go prefix children name typeRef = do + state <- State.get + lift (runMaybeT (getCompose (Map.upsertF recordNewDecl typeRef state.expectedConstructors))) >>= \case + Nothing -> pure Nothing + Just UninhabitedDecl -> do + #declNameLookup . #declToConstructors %= Map.insert typeName [] + pure Nothing + Just (InhabitedDecl expectedConstructors1) -> do + case Map.lookup name children of + Nothing -> do + lift (callbacks.onMissingConstructorName typeName) + pure Nothing + Just child -> do + #expectedConstructors .= expectedConstructors1 + go (name : prefix) child + state <- State.get + -- fromJust is safe here because we upserted `typeRef` key above + let (fromJust -> (_typeName, maybeConstructorNames), expectedConstructors1) = + Map.deleteLookup typeRef state.expectedConstructors + #expectedConstructors .= expectedConstructors1 + case sequence (IntMap.elems maybeConstructorNames) of + Nothing -> lift (callbacks.onMissingConstructorName typeName) + Just constructorNames -> do + #declNameLookup . #constructorToDecl %= \constructorToDecl -> + List.foldl' + (\acc constructorName -> Map.insert constructorName typeName acc) + constructorToDecl + constructorNames + #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames + pure (Just name) + where + typeName :: Name + typeName = + Name.fromReverseSegments (name :| prefix) + + recordNewDecl :: Maybe (Name, ConstructorNames) -> Compose (MaybeT m) WhatHappened (Name, ConstructorNames) + recordNewDecl = + Compose . \case + Just (shorterTypeName, _) -> do + lift (callbacks.onNestedDeclAlias shorterTypeName typeName) + MaybeT (pure Nothing) + Nothing -> + lift (loadDeclNumConstructors typeRef) <&> \case + 0 -> UninhabitedDecl + n -> InhabitedDecl (typeName, emptyConstructorNames n) -- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns partial decl name lookup, -- which doesn't require a name for every constructor, and allows a constructor with a nameless decl. @@ -331,7 +362,7 @@ checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix child -- does, we still need to compute *some* syntactic hash for its decls. lenientCheckDeclCoherency :: forall m. - Monad m => + (Monad m) => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m PartialDeclNameLookup @@ -432,7 +463,7 @@ emptyConstructorNames :: Int -> ConstructorNames emptyConstructorNames numConstructors = IntMap.fromAscList [(i, Nothing) | i <- [0 .. numConstructors - 1]] -recordConstructorName :: HasCallStack => ConstructorId -> Name -> ConstructorNames -> Either Name ConstructorNames +recordConstructorName :: (HasCallStack) => ConstructorId -> Name -> ConstructorNames -> Either Name ConstructorNames recordConstructorName conId conName = IntMap.alterF f (fromIntegral @Word64 @Int conId) where From 4b68359e6ed666770e1b8f556948dc63cc88b9de Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 23 Jul 2024 10:50:49 -0400 Subject: [PATCH 489/631] simplify update --- .../src/Unison/Codebase/Branch.hs | 4 +- .../src/Unison/Codebase/Branch/Type.hs | 14 +- unison-cli/src/Unison/Cli/UpdateUtils.hs | 86 ++++++++++- .../Codebase/Editor/HandleInput/Merge2.hs | 62 +------- .../Codebase/Editor/HandleInput/Update2.hs | 146 ++++++------------ unison-core/package.yaml | 1 + unison-core/src/Unison/Util/Nametree.hs | 32 +++- unison-core/unison-core1.cabal | 2 + 8 files changed, 175 insertions(+), 172 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Branch.hs b/parser-typechecker/src/Unison/Codebase/Branch.hs index 00e2f76901..14629643ec 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch.hs @@ -86,6 +86,7 @@ module Unison.Codebase.Branch -- ** Term/type queries deepTerms, deepTypes, + deepDefns, deepEdits, deepPaths, deepReferents, @@ -112,6 +113,7 @@ import Unison.Codebase.Branch.Type UnwrappedBranch, branch0, children, + deepDefns, deepEdits, deepPaths, deepTerms, @@ -318,7 +320,7 @@ cons = step . const -- | Construct a two-parent merge node. mergeNode :: forall m. - Applicative m => + (Applicative m) => Branch0 m -> (CausalHash, m (Branch m)) -> (CausalHash, m (Branch m)) -> diff --git a/parser-typechecker/src/Unison/Codebase/Branch/Type.hs b/parser-typechecker/src/Unison/Codebase/Branch/Type.hs index a0692e5ab4..ebc0ae467e 100644 --- a/parser-typechecker/src/Unison/Codebase/Branch/Type.hs +++ b/parser-typechecker/src/Unison/Codebase/Branch/Type.hs @@ -10,8 +10,8 @@ module Unison.Codebase.Branch.Type Branch (..), Branch0, branch0, - terms, - types, + Unison.Codebase.Branch.Type.terms, + Unison.Codebase.Branch.Type.types, children, nonEmptyChildren, history, @@ -19,6 +19,7 @@ module Unison.Codebase.Branch.Type isEmpty0, deepTerms, deepTypes, + deepDefns, deepPaths, deepEdits, Star, @@ -47,9 +48,11 @@ import Unison.NameSegment qualified as NameSegment import Unison.Prelude hiding (empty) import Unison.Reference (Reference, TypeReference) import Unison.Referent (Referent) +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.Monoid qualified as Monoid import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as R +import Unison.Util.Relation qualified as Relation import Unison.Util.Star2 qualified as Star2 import Prelude hiding (head, read, subtract) @@ -148,6 +151,13 @@ deepTerms = _deepTerms deepTypes :: Branch0 m -> Relation TypeReference Name deepTypes = _deepTypes +deepDefns :: Branch0 m -> DefnsF (Relation Name) Referent TypeReference +deepDefns branch = + Defns + { terms = Relation.swap (deepTerms branch), + types = Relation.swap (deepTypes branch) + } + deepPaths :: Branch0 m -> Set Path deepPaths = _deepPaths diff --git a/unison-cli/src/Unison/Cli/UpdateUtils.hs b/unison-cli/src/Unison/Cli/UpdateUtils.hs index aacfa601b7..5fda1f3ab6 100644 --- a/unison-cli/src/Unison/Cli/UpdateUtils.hs +++ b/unison-cli/src/Unison/Cli/UpdateUtils.hs @@ -3,7 +3,11 @@ -- -- This occurs in the `pull`, `merge`, `update`, and `upgrade` commands. module Unison.Cli.UpdateUtils - ( -- * Narrowing definitions + ( -- * Loading definitions + loadNamespaceDefinitions, + ConflictedName (..), + + -- * Narrowing definitions narrowDefns, -- * Hydrating definitions @@ -15,15 +19,23 @@ module Unison.Cli.UpdateUtils ) where -import Control.Lens (mapped, _1, _2) +import Control.Lens (mapped, _1) import Control.Monad.Writer (Writer) import Control.Monad.Writer qualified as Writer import Data.Bitraversable (bitraverse) import Data.Foldable qualified as Foldable import Data.List qualified as List +import Data.List.NonEmpty qualified as List.NonEmpty import Data.Map.Strict qualified as Map +import Data.Semialign (alignWith) import Data.Set qualified as Set +import Data.Set.NonEmpty (NESet) +import Data.Set.NonEmpty qualified as Set.NonEmpty +import Data.These (These (..)) +import U.Codebase.Branch qualified as V2 +import U.Codebase.Causal qualified import U.Codebase.Reference (TermReferenceId, TypeReferenceId) +import U.Codebase.Referent qualified as V2 import Unison.Builtin.Decls qualified as Builtin.Decls import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) import Unison.DataDeclaration (Decl) @@ -32,8 +44,12 @@ import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' import Unison.Merge.DeclNameLookup (DeclNameLookup (..), expectConstructorNames) import Unison.Name (Name) +import Unison.Name qualified as Name +import Unison.NameSegment (NameSegment) +import Unison.NameSegment qualified as NameSegment import Unison.Prelude import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) +import Unison.Reference (TypeReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -46,8 +62,9 @@ import Unison.Typechecker qualified as Typechecker import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defn (Defn (..)) -import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2) import Unison.Util.Monoid qualified as Monoid +import Unison.Util.Nametree (Nametree (..), traverseNametreeWithName, unflattenNametree, unflattenNametrees) import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation (Relation) @@ -56,21 +73,74 @@ import Unison.Util.Set qualified as Set import Unison.Var (Var) import Prelude hiding (unzip, zip, zipWith) +------------------------------------------------------------------------------------------------------------------------ +-- Loading definitions + +-- Load all "namespace definitions" of a branch, which are all terms and type declarations *except* those defined +-- in the "lib" namespace. +-- +-- Fails if there is a conflicted name. +loadNamespaceDefinitions :: + forall m. + (Monad m) => + (V2.Referent -> m Referent) -> + V2.Branch m -> + m (Either ConflictedName (Nametree (DefnsF (Map NameSegment) Referent TypeReference))) +loadNamespaceDefinitions referent2to1 = + fmap assertNamespaceHasNoConflictedNames . go (Map.delete NameSegment.libSegment) + where + go :: + (forall x. Map NameSegment x -> Map NameSegment x) -> + V2.Branch m -> + m (Nametree (DefnsF2 (Map NameSegment) NESet Referent TypeReference)) + go f branch = do + terms <- for branch.terms (fmap (Set.NonEmpty.fromList . List.NonEmpty.fromList) . traverse referent2to1 . Map.keys) + let types = Map.map (Set.NonEmpty.unsafeFromSet . Map.keysSet) branch.types + children <- + for (f branch.children) \childCausal -> do + child <- childCausal.value + go id child + pure Nametree {value = Defns {terms, types}, children} + +data ConflictedName + = ConflictedName'Term !Name !(NESet Referent) + | ConflictedName'Type !Name !(NESet TypeReference) + +-- | Assert that there are no unconflicted names in a namespace. +assertNamespaceHasNoConflictedNames :: + Nametree (DefnsF2 (Map NameSegment) NESet Referent TypeReference) -> + Either ConflictedName (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) +assertNamespaceHasNoConflictedNames = + traverseNametreeWithName \names defns -> do + terms <- + defns.terms & Map.traverseWithKey \name -> + assertUnconflicted (ConflictedName'Term (Name.fromReverseSegments (name List.NonEmpty.:| names))) + types <- + defns.types & Map.traverseWithKey \name -> + assertUnconflicted (ConflictedName'Type (Name.fromReverseSegments (name List.NonEmpty.:| names))) + pure Defns {terms, types} + where + assertUnconflicted :: (NESet ref -> ConflictedName) -> NESet ref -> Either ConflictedName ref + assertUnconflicted conflicted refs + | Set.NonEmpty.size refs == 1 = Right (Set.NonEmpty.findMin refs) + | otherwise = Left (conflicted refs) + ------------------------------------------------------------------------------------------------------------------------ -- Narrowing definitions -- | "Narrow" a namespace that may contain conflicted names, resulting in either a failure (if we find a conflicted --- name), or the narrowed left-unique relation namespace without conflicted names. +-- name), or the narrowed nametree without conflicted names. narrowDefns :: + forall term typ. (Ord term, Ord typ) => DefnsF (Relation Name) term typ -> - Either (Defn Name Name) (Defns (BiMultimap term Name) (BiMultimap typ Name)) + Either (Defn Name Name) (Nametree (DefnsF (Map NameSegment) term typ)) narrowDefns = - bitraverse (mapLeft TermDefn . go) (mapLeft TypeDefn . go) + fmap unflattenNametrees . bitraverse (mapLeft TermDefn . go) (mapLeft TypeDefn . go) where - go :: (Ord ref) => Relation Name ref -> Either Name (BiMultimap ref Name) + go :: (Ord ref) => Relation Name ref -> Either Name (Map Name ref) go = - fmap BiMultimap.fromRange . Map.traverseWithKey unconflicted . Relation.domain + Map.traverseWithKey unconflicted . Relation.domain where unconflicted :: Name -> Set ref -> Either Name ref unconflicted name refs = diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 85d10b7d74..83511008ea 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -20,13 +20,9 @@ import Data.Bifoldable (bifoldMap) import Data.Bitraversable (bitraverse) import Data.Foldable qualified as Foldable import Data.List qualified as List -import Data.List.NonEmpty (pattern (:|)) -import Data.List.NonEmpty qualified as List.NonEmpty import Data.Map.Strict qualified as Map import Data.Semialign (align, unzip) import Data.Set qualified as Set -import Data.Set.NonEmpty (NESet) -import Data.Set.NonEmpty qualified as Set.NonEmpty import Data.Text qualified as Text import Data.Text.IO qualified as Text import Data.These (These (..)) @@ -38,7 +34,6 @@ import U.Codebase.Branch qualified as V2.Branch import U.Codebase.Causal qualified as V2.Causal import U.Codebase.HashTags (CausalHash, unCausalHash) import U.Codebase.Reference (Reference, TermReferenceId, TypeReference, TypeReferenceId) -import U.Codebase.Referent qualified as V2 (Referent) import U.Codebase.Sqlite.DbId (ProjectId) import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Project (Project (..)) @@ -49,7 +44,7 @@ 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.UpdateUtils (hydrateDefns, renderDefnsForUnisonFile) +import Unison.Cli.UpdateUtils (hydrateDefns, renderDefnsForUnisonFile, ConflictedName (..), loadNamespaceDefinitions) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) @@ -97,7 +92,6 @@ import Unison.Merge.Unconflicts (Unconflicts (..)) import Unison.Merge.Unconflicts qualified as Unconflicts import Unison.Merge.Updated (Updated (..)) import Unison.Name (Name) -import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.NameSegment.Internal qualified as NameSegment @@ -119,7 +113,7 @@ import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3, alignDefnsWith, defnsAreEmpty, zipDefnsWith, zipDefnsWith3) import Unison.Util.Monoid qualified as Monoid -import Unison.Util.Nametree (Nametree (..), flattenNametree, traverseNametreeWithName, unflattenNametree) +import Unison.Util.Nametree (Nametree (..), flattenNametrees, unflattenNametree) import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation (Relation) @@ -265,8 +259,7 @@ doMerge info = do lcaDefns0 <- maybe (pure emptyNametree) loadDefns branches.lca lcaDeclNameLookup <- Cli.runTransaction (lenientCheckDeclCoherency db.loadDeclNumConstructors lcaDefns0) - let flatten defns = Defns (flattenNametree (view #terms) defns) (flattenNametree (view #types) defns) - let defns3 = flatten <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} + let defns3 = flattenNametrees <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} let declNameLookups = TwoWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup} pure (defns3, declNameLookups, lcaDeclNameLookup) @@ -773,55 +766,6 @@ findTemporaryBranchName projectId mergeSourceAndTarget = do <> Text.Builder.char '.' <> Text.Builder.decimal z --- Load all "namespace definitions" of a branch, which are all terms and type declarations *except* those defined --- in the "lib" namespace. --- --- Fails if there is a conflicted name. -loadNamespaceDefinitions :: - forall m. - (Monad m) => - (V2.Referent -> m Referent) -> - V2.Branch m -> - m (Either ConflictedName (Nametree (DefnsF (Map NameSegment) Referent TypeReference))) -loadNamespaceDefinitions referent2to1 = - fmap assertNamespaceHasNoConflictedNames . go (Map.delete NameSegment.libSegment) - where - go :: - (forall x. Map NameSegment x -> Map NameSegment x) -> - V2.Branch m -> - m (Nametree (DefnsF2 (Map NameSegment) NESet Referent TypeReference)) - go f branch = do - terms <- for branch.terms (fmap (Set.NonEmpty.fromList . List.NonEmpty.fromList) . traverse referent2to1 . Map.keys) - let types = Map.map (Set.NonEmpty.unsafeFromSet . Map.keysSet) branch.types - children <- - for (f branch.children) \childCausal -> do - child <- childCausal.value - go id child - pure Nametree {value = Defns {terms, types}, children} - -data ConflictedName - = ConflictedName'Term !Name !(NESet Referent) - | ConflictedName'Type !Name !(NESet TypeReference) - --- | Assert that there are no unconflicted names in a namespace. -assertNamespaceHasNoConflictedNames :: - Nametree (DefnsF2 (Map NameSegment) NESet Referent TypeReference) -> - Either ConflictedName (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -assertNamespaceHasNoConflictedNames = - traverseNametreeWithName \names defns -> do - terms <- - defns.terms & Map.traverseWithKey \name -> - assertUnconflicted (ConflictedName'Term (Name.fromReverseSegments (name :| names))) - types <- - defns.types & Map.traverseWithKey \name -> - assertUnconflicted (ConflictedName'Type (Name.fromReverseSegments (name :| names))) - pure Defns {terms, types} - where - assertUnconflicted :: (NESet ref -> ConflictedName) -> NESet ref -> Either ConflictedName ref - assertUnconflicted conflicted refs - | Set.NonEmpty.size refs == 1 = Right (Set.NonEmpty.findMin refs) - | otherwise = Left (conflicted refs) - -- @findConflictedAlias namespace diff@, given an old namespace and a diff to a new namespace, will return the first -- "conflicted alias" encountered (if any), where a "conflicted alias" is a pair of names that referred to the same -- thing in the old namespace, but different things in the new one. diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 9dae25fa1c..f9dac22ef2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -103,7 +103,7 @@ import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty) import Unison.Util.Monoid qualified as Monoid -import Unison.Util.Nametree (Nametree, unflattenNametree) +import Unison.Util.Nametree (Nametree, unflattenNametree, flattenNametrees) import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation (Relation) @@ -124,90 +124,43 @@ handleUpdate2 = do let namesExcludingLibdeps = Branch.toNames currentBranch0ExcludingLibdeps let ctorNames = forwardCtorNames namesExcludingLibdeps - Cli.respond Output.UpdateLookingForDependents + -- Assert that the namespace doesn't have any conflicted names + defns <- + narrowDefns + (Branch.deepDefns currentBranch0ExcludingLibdeps) + & onLeft \conflictedName -> wundefined - -- Get all namings of all dependents of the stuff we're considering updating. - dependentsAndConstructors <- do - dependents0 <- - Cli.runTransaction do - getNamespaceDependentsOf - namesExcludingLibdeps - (getExistingReferencesNamed termAndDeclNames namesExcludingLibdeps) - - -- Throw away the dependents that are shadowed by the file itself - let dependents1 :: DefnsF (Relation Name) TermReferenceId TypeReferenceId - dependents1 = - bimap - (Relation.subtractDom (Set.map Name.unsafeParseVar (UF.termNamespaceBindings tuf))) - (Relation.subtractDom (Set.map Name.unsafeParseVar (UF.typeNamespaceBindings tuf))) - dependents0 - - let dependentTypeRefs :: Set TypeReferenceId - dependentTypeRefs = - Relation.ran dependents1.types - - -- Add in constructors of dependent types. The constructors aren't "dependents" per se, but we need them for - -- computing the decl name lookup for all dependent types. - -- - -- Unlike top-level term and type definitions, these names aren't shadowed by the Unison file. For example, if some - -- "Foo.Bar = 5" term exists, we still want to fetch any "Foo.Bar" constructor here, too. The name collision will - -- manifest as a duplicate binding error later on. - let dependents2 :: DefnsF (Relation Name) Referent.Id TypeReferenceId - dependents2 = - dependents1 - & over #terms \terms -> - Relation.union - (Relation.mapRanMonotonic Referent.RefId terms) - ( foldr - ( \case - (Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) conTy, name) - | Set.member typeRef dependentTypeRefs -> - Relation.insert name (Referent.ConId (ConstructorReference typeRef conId) conTy) - _ -> id - ) - Relation.empty - (Relation.toList (Branch.deepTerms currentBranch0ExcludingLibdeps)) - ) - - -- Of the ones that remain, try to narrow to a left-unique relation (no conflicted names). - dependents3 <- - narrowDefns dependents2 & onLeft \conflictedName -> - wundefined conflictedName - - -- Throw away the ref->name direction because we don't need it - let dependents4 :: DefnsF (Map Name) Referent.Id TypeReferenceId - dependents4 = - bimap BiMultimap.range BiMultimap.range dependents3 - - pure dependents4 - - let dependents :: DefnsF (Map Name) TermReferenceId TypeReferenceId - dependents = - over #terms (Map.mapMaybe Referent.toTermReference) dependentsAndConstructors - - let dependentsNametree :: Nametree (DefnsF (Map NameSegment) Referent.Id TypeReferenceId) - dependentsNametree = - alignWith - ( \case - This terms -> Defns {terms, types = Map.empty} - That types -> Defns {terms = Map.empty, types} - These terms types -> Defns {terms, types} - ) - (unflattenNametree dependentsAndConstructors.terms) - (unflattenNametree dependentsAndConstructors.types) - - dependentsDeclNameLookup <- + -- Assert that the namespace doesn't have any incoherent decls + declNameLookup <- Cli.runTransaction ( checkDeclCoherency Operations.expectDeclNumConstructors - Referent.toConstructorReference - Just - dependentsNametree + Referent.toConstructorReferenceId + Reference.toId + defns ) - & onLeftM \err -> liftIO (print err) >> wundefined + & onLeftM \err -> wundefined + + let defns1 = flattenNametrees defns + + Cli.respond Output.UpdateLookingForDependents + + dependents0 <- + Cli.runTransaction do + getNamespaceDependentsOf2 + defns1 + (getExistingReferencesNamed termAndDeclNames namesExcludingLibdeps) + + -- Throw away the dependents that are shadowed by the file itself + let dependents1 :: DefnsF (Map Name) TermReferenceId TypeReferenceId + dependents1 = + bimap + (`Map.withoutKeys` (Set.map Name.unsafeParseVar (UF.termNamespaceBindings tuf))) + (`Map.withoutKeys` (Set.map Name.unsafeParseVar (UF.typeNamespaceBindings tuf))) + dependents0 secondTuf <- do - case defnsAreEmpty dependents of + case defnsAreEmpty dependents1 of -- If there are no dependents of the updates, then just use the already-typechecked file. True -> pure tuf False -> do @@ -216,21 +169,16 @@ handleUpdate2 = do hydrateDefns (Codebase.unsafeGetTermComponent codebase) Operations.expectDeclComponent - dependents + dependents1 - let ppe = makeComplicatedPPE2 10 namesIncludingLibdeps (UF.typecheckedToNames tuf) dependents + let ppe = makeComplicatedPPE2 10 namesIncludingLibdeps (UF.typecheckedToNames tuf) dependents1 let renderedDependents :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) renderedDependents = - renderDefnsForUnisonFile dependentsDeclNameLookup ppe hydratedDependents + renderDefnsForUnisonFile declNameLookup ppe hydratedDependents let prettyUnisonFile = - makePrettyUnisonFile - ( Pretty.prettyUnisonFile - (makeComplicatedPPE2 10 namesIncludingLibdeps (UF.typecheckedToNames tuf) dependents) - (UF.discardTypes tuf) - ) - renderedDependents + makePrettyUnisonFile (Pretty.prettyUnisonFile ppe (UF.discardTypes tuf)) renderedDependents Cli.respond Output.UpdateStartTypechecking @@ -246,7 +194,17 @@ handleUpdate2 = do pure secondTuf - saveTuf (findCtorNamesMaybe Output.UOUUpdate namesExcludingLibdeps ctorNames Nothing) secondTuf + env <- ask + path <- Cli.getCurrentProjectPath + branchUpdates <- + Cli.runTransactionWithRollback \abort -> do + Codebase.addDefsToCodebase env.codebase secondTuf + typecheckedUnisonFileToBranchUpdates + abort + (findCtorNamesMaybe Output.UOUUpdate namesExcludingLibdeps ctorNames Nothing) + secondTuf + Cli.stepAt "update" (path, Branch.batchUpdates branchUpdates) + Cli.respond Output.Success makePrettyUnisonFile :: Pretty ColorText -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) -> Pretty ColorText @@ -255,6 +213,7 @@ makePrettyUnisonFile originalFile dependents = <> Pretty.newline <> Pretty.newline <> "-- The definitions below are not compatible with the updated definitions above." + <> Pretty.newline <> "-- Please fix the errors and run `update` again." <> Pretty.newline <> Pretty.newline @@ -312,17 +271,6 @@ makeParsingEnv path names = do names } --- save definitions and namespace -saveTuf :: (Name -> Either Output (Maybe [Name])) -> TypecheckedUnisonFile Symbol Ann -> Cli () -saveTuf getConstructors tuf = do - Cli.Env {codebase} <- ask - pp <- Cli.getCurrentProjectPath - branchUpdates <- - Cli.runTransactionWithRollback \abort -> do - Codebase.addDefsToCodebase codebase tuf - typecheckedUnisonFileToBranchUpdates abort getConstructors tuf - Cli.stepAt "update" (pp, Branch.batchUpdates branchUpdates) - -- @typecheckedUnisonFileToBranchUpdates getConstructors file@ returns a list of branch updates (suitable for passing -- along to `batchUpdates` or some "step at" combinator) that corresponds to using all of the contents of @file@. -- `getConstructors` returns the full constructor names of a decl, e.g. "Maybe" -> ["Maybe.Nothing", "Maybe.Just"] diff --git a/unison-core/package.yaml b/unison-core/package.yaml index 2b8bea50bf..a65883296f 100644 --- a/unison-core/package.yaml +++ b/unison-core/package.yaml @@ -77,6 +77,7 @@ default-extensions: - LambdaCase - MultiParamTypeClasses - NamedFieldPuns + - OverloadedLabels - OverloadedStrings - OverloadedRecordDot - PatternSynonyms diff --git a/unison-core/src/Unison/Util/Nametree.hs b/unison-core/src/Unison/Util/Nametree.hs index e5d6c468ac..e87bdde344 100644 --- a/unison-core/src/Unison/Util/Nametree.hs +++ b/unison-core/src/Unison/Util/Nametree.hs @@ -6,7 +6,9 @@ module Unison.Util.Nametree -- ** Flattening and unflattening flattenNametree, + flattenNametrees, unflattenNametree, + unflattenNametrees, ) where @@ -21,6 +23,7 @@ import Unison.NameSegment (NameSegment) import Unison.Prelude import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defns (Defns (..), DefnsF) import Prelude hiding (zipWith) -- | A nametree has a value, and a collection of children nametrees keyed by name segment. @@ -49,7 +52,7 @@ instance Unzip Nametree where (ys, zs) = unzipWith (unzipWith f) xs -- | Traverse over a nametree, with access to the list of name segments (in reverse order) leading to each value. -traverseNametreeWithName :: Applicative f => ([NameSegment] -> a -> f b) -> Nametree a -> f (Nametree b) +traverseNametreeWithName :: (Applicative f) => ([NameSegment] -> a -> f b) -> Nametree a -> f (Nametree b) traverseNametreeWithName f = go [] where @@ -81,7 +84,7 @@ unfoldNametree f x = -- > } flattenNametree :: forall a b. - Ord b => + (Ord b) => (a -> Map NameSegment b) -> Nametree a -> BiMultimap b Name @@ -103,6 +106,17 @@ flattenNametree f = ) (Map.toList children) +-- | Like 'flattenNametree', but works on both the types and terms namespace at once. +flattenNametrees :: + (Ord term, Ord typ) => + Nametree (DefnsF (Map NameSegment) term typ) -> + Defns (BiMultimap term Name) (BiMultimap typ Name) +flattenNametrees defns = + Defns + { terms = flattenNametree (view #terms) defns, + types = flattenNametree (view #types) defns + } + -- | 'unflattenNametree' organizes an association between names and definitions like -- -- > { @@ -120,7 +134,7 @@ flattenNametree f = -- > "baz" = #baz -- > } -- > } -unflattenNametree :: Ord a => Map Name a -> Nametree (Map NameSegment a) +unflattenNametree :: (Ord a) => Map Name a -> Nametree (Map NameSegment a) unflattenNametree = unfoldNametree unflattenLevel . map (first Name.segments) . Map.toList where @@ -132,6 +146,18 @@ unflattenNametree = (NameHere n, v) -> (Map.insert n v accValue, accChildren) (NameThere n ns, v) -> (accValue, Map.insertWith (++) n [(ns, v)] accChildren) +-- | Like 'unflattenNametree', but works on both the types and terms namespace at once. +unflattenNametrees :: (Ord term, Ord typ) => DefnsF (Map Name) term typ -> Nametree (DefnsF (Map NameSegment) term typ) +unflattenNametrees defns = + alignWith + ( \case + This terms -> Defns {terms, types = Map.empty} + That types -> Defns {terms = Map.empty, types} + These terms types -> Defns {terms, types} + ) + (unflattenNametree defns.terms) + (unflattenNametree defns.types) + -- Helper patterns for switching on "name here" (1 name segment) or "name there" (2+ name segments) pattern NameHere :: a -> NonEmpty a diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal index d32e775306..31683e5530 100644 --- a/unison-core/unison-core1.cabal +++ b/unison-core/unison-core1.cabal @@ -84,6 +84,7 @@ library LambdaCase MultiParamTypeClasses NamedFieldPuns + OverloadedLabels OverloadedStrings OverloadedRecordDot PatternSynonyms @@ -153,6 +154,7 @@ test-suite tests LambdaCase MultiParamTypeClasses NamedFieldPuns + OverloadedLabels OverloadedStrings OverloadedRecordDot PatternSynonyms From 7506ae26b6cc05007a37ecabe0f998eec34d0cf5 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 23 Jul 2024 13:45:16 -0400 Subject: [PATCH 490/631] get transcripts passing --- .../src/Unison/PrettyPrintEnvDecl/Names.hs | 23 ++ unison-cli/src/Unison/Cli/UpdateUtils.hs | 116 +++------- .../Codebase/Editor/HandleInput/Merge2.hs | 19 +- .../Codebase/Editor/HandleInput/Update2.hs | 172 +++++--------- .../Codebase/Editor/HandleInput/Upgrade.hs | 6 +- .../src/Unison/Codebase/Editor/Output.hs | 38 ++-- .../src/Unison/CommandLine/OutputMessages.hs | 215 ++++++++++++------ unison-core/src/Unison/Names.hs | 22 +- unison-core/src/Unison/Util/Conflicted.hs | 10 + unison-core/unison-core1.cabal | 1 + unison-src/transcripts/diff-namespace.md | 4 + .../transcripts/diff-namespace.output.md | 24 +- unison-src/transcripts/update-on-conflict.md | 5 +- .../transcripts/update-on-conflict.output.md | 13 +- .../update-suffixifies-properly.output.md | 6 +- ...with-dependent-to-different-type.output.md | 8 +- .../update-test-watch-roundtrip.output.md | 6 +- .../update-type-constructor-alias.md | 5 +- .../update-type-constructor-alias.output.md | 27 +-- ...elete-constructor-with-dependent.output.md | 6 +- .../update-type-delete-record-field.output.md | 6 +- .../update-type-missing-constructor.output.md | 12 +- .../update-type-nested-decl-aliases.md | 4 - .../update-type-nested-decl-aliases.output.md | 24 +- .../update-type-stray-constructor-alias.md | 5 +- ...ate-type-stray-constructor-alias.output.md | 25 +- .../update-type-stray-constructor.output.md | 12 +- .../update-type-with-dependent-term.output.md | 6 +- ...dependent-type-to-different-kind.output.md | 6 +- 29 files changed, 406 insertions(+), 420 deletions(-) create mode 100644 unison-core/src/Unison/Util/Conflicted.hs diff --git a/parser-typechecker/src/Unison/PrettyPrintEnvDecl/Names.hs b/parser-typechecker/src/Unison/PrettyPrintEnvDecl/Names.hs index 274f418049..53e171eec1 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnvDecl/Names.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnvDecl/Names.hs @@ -1,8 +1,11 @@ module Unison.PrettyPrintEnvDecl.Names ( makePPED, + makeFilePPED, + makeCodebasePPED, ) where +import Unison.Names (Names) import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (PrettyPrintEnvDecl)) @@ -11,3 +14,23 @@ makePPED namer suffixifier = PrettyPrintEnvDecl (PPE.makePPE namer PPE.dontSuffixify) (PPE.makePPE namer suffixifier) + +-- | Make a PPED suitable for names in a Unison file. +-- +-- Such names have special suffixification rules: aliases may *not* be referred to by a common suffix. For example, if +-- a file contains +-- +-- one.foo = 6 +-- two.foo = 6 +-- +-- then the suffix `foo` will *not* be accepted (currently). So, this PPE uses the "suffixify by name" strategy. +makeFilePPED :: Names -> PrettyPrintEnvDecl +makeFilePPED names = + makePPED (PPE.namer names) (PPE.suffixifyByName names) + +-- | Make a PPED suitable for names in the codebase. These names are hash qualified and suffixified by hash. +makeCodebasePPED :: Names -> PrettyPrintEnvDecl +makeCodebasePPED names = + makePPED + (PPE.hqNamer 10 names) + (PPE.suffixifyByHash names) diff --git a/unison-cli/src/Unison/Cli/UpdateUtils.hs b/unison-cli/src/Unison/Cli/UpdateUtils.hs index 5fda1f3ab6..4a1ceb90f0 100644 --- a/unison-cli/src/Unison/Cli/UpdateUtils.hs +++ b/unison-cli/src/Unison/Cli/UpdateUtils.hs @@ -5,14 +5,12 @@ module Unison.Cli.UpdateUtils ( -- * Loading definitions loadNamespaceDefinitions, - ConflictedName (..), -- * Narrowing definitions narrowDefns, -- * Hydrating definitions hydrateDefns, - hydrateDefnsRel, -- * Rendering definitions renderDefnsForUnisonFile, @@ -27,11 +25,9 @@ import Data.Foldable qualified as Foldable import Data.List qualified as List import Data.List.NonEmpty qualified as List.NonEmpty import Data.Map.Strict qualified as Map -import Data.Semialign (alignWith) import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) import Data.Set.NonEmpty qualified as Set.NonEmpty -import Data.These (These (..)) import U.Codebase.Branch qualified as V2 import U.Codebase.Causal qualified import U.Codebase.Reference (TermReferenceId, TypeReferenceId) @@ -61,15 +57,14 @@ import Unison.Type (Type) import Unison.Typechecker qualified as Typechecker import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Conflicted (Conflicted (..)) import Unison.Util.Defn (Defn (..)) import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2) -import Unison.Util.Monoid qualified as Monoid -import Unison.Util.Nametree (Nametree (..), traverseNametreeWithName, unflattenNametree, unflattenNametrees) +import Unison.Util.Nametree (Nametree (..), traverseNametreeWithName, unflattenNametrees) import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Relation -import Unison.Util.Set qualified as Set import Unison.Var (Var) import Prelude hiding (unzip, zip, zipWith) @@ -85,7 +80,11 @@ loadNamespaceDefinitions :: (Monad m) => (V2.Referent -> m Referent) -> V2.Branch m -> - m (Either ConflictedName (Nametree (DefnsF (Map NameSegment) Referent TypeReference))) + m + ( Either + (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)) + (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) + ) loadNamespaceDefinitions referent2to1 = fmap assertNamespaceHasNoConflictedNames . go (Map.delete NameSegment.libSegment) where @@ -102,25 +101,25 @@ loadNamespaceDefinitions referent2to1 = go id child pure Nametree {value = Defns {terms, types}, children} -data ConflictedName - = ConflictedName'Term !Name !(NESet Referent) - | ConflictedName'Type !Name !(NESet TypeReference) - -- | Assert that there are no unconflicted names in a namespace. assertNamespaceHasNoConflictedNames :: Nametree (DefnsF2 (Map NameSegment) NESet Referent TypeReference) -> - Either ConflictedName (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) + Either + (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)) + (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) assertNamespaceHasNoConflictedNames = - traverseNametreeWithName \names defns -> do + traverseNametreeWithName \segments defns -> do + let toName segment = + Name.fromReverseSegments (segment List.NonEmpty.:| segments) terms <- - defns.terms & Map.traverseWithKey \name -> - assertUnconflicted (ConflictedName'Term (Name.fromReverseSegments (name List.NonEmpty.:| names))) + defns.terms & Map.traverseWithKey \segment -> + assertUnconflicted (TermDefn . Conflicted (toName segment)) types <- - defns.types & Map.traverseWithKey \name -> - assertUnconflicted (ConflictedName'Type (Name.fromReverseSegments (name List.NonEmpty.:| names))) + defns.types & Map.traverseWithKey \segment -> + assertUnconflicted (TypeDefn . Conflicted (toName segment)) pure Defns {terms, types} where - assertUnconflicted :: (NESet ref -> ConflictedName) -> NESet ref -> Either ConflictedName ref + assertUnconflicted :: (NESet ref -> x) -> NESet ref -> Either x ref assertUnconflicted conflicted refs | Set.NonEmpty.size refs == 1 = Right (Set.NonEmpty.findMin refs) | otherwise = Left (conflicted refs) @@ -134,19 +133,28 @@ narrowDefns :: forall term typ. (Ord term, Ord typ) => DefnsF (Relation Name) term typ -> - Either (Defn Name Name) (Nametree (DefnsF (Map NameSegment) term typ)) + Either + ( Defn + (Conflicted Name term) + (Conflicted Name typ) + ) + (Nametree (DefnsF (Map NameSegment) term typ)) narrowDefns = - fmap unflattenNametrees . bitraverse (mapLeft TermDefn . go) (mapLeft TypeDefn . go) + fmap unflattenNametrees + . bitraverse + (go (\name -> TermDefn . Conflicted name)) + (go (\name -> TypeDefn . Conflicted name)) where - go :: (Ord ref) => Relation Name ref -> Either Name (Map Name ref) - go = + go :: forall ref x. (Ord ref) => (Name -> NESet ref -> x) -> Relation Name ref -> Either x (Map Name ref) + go conflicted = Map.traverseWithKey unconflicted . Relation.domain where - unconflicted :: Name -> Set ref -> Either Name ref - unconflicted name refs = - case Set.asSingleton refs of - Nothing -> Left name - Just ref -> Right ref + unconflicted :: Name -> Set ref -> Either x ref + unconflicted name refs0 + | Set.NonEmpty.size refs == 1 = Right (Set.NonEmpty.findMin refs) + | otherwise = Left (conflicted name refs) + where + refs = Set.NonEmpty.unsafeFromSet refs0 ------------------------------------------------------------------------------------------------------------------------ -- Hydrating definitions @@ -196,58 +204,6 @@ hydrateDefns_ getComponent defns modify = defns2 = BiMultimap.fromRange defns --- | Like 'hydrateDefns', but when you have a relation (i.e. names can be conflicted). Maybe this code should be deleted --- in favor of just asserting that names can't be conflicted before doing something (since it's easy to resolve: just --- rename one). But, for now, this exists. -hydrateDefnsRel :: - forall m name term typ. - (Monad m, Ord name, Ord term, Ord typ) => - (Hash -> m [term]) -> - (Hash -> m [typ]) -> - DefnsF (Relation name) TermReferenceId TypeReferenceId -> - m (DefnsF (Relation name) term (TypeReferenceId, typ)) -hydrateDefnsRel getTermComponent getTypeComponent = do - bitraverse hydrateTerms hydrateTypes - where - hydrateTerms :: Relation name TermReferenceId -> m (Relation name term) - hydrateTerms terms = - hydrateDefnsRel_ getTermComponent terms \_ _ -> id - - hydrateTypes :: Relation name TypeReferenceId -> m (Relation name (TypeReferenceId, typ)) - hydrateTypes types = - hydrateDefnsRel_ getTypeComponent types \_ -> (,) - -hydrateDefnsRel_ :: - forall a b name m. - (Ord b, Monad m, Ord name) => - (Hash -> m [a]) -> - Relation name Reference.Id -> - (name -> Reference.Id -> a -> b) -> - m (Relation name b) -hydrateDefnsRel_ getComponent defns modify = - let hashes :: [Hash] - hashes = - defns - & Relation.toList - & List.foldl' (\acc (_, ref) -> Set.insert (Reference.idToHash ref) acc) Set.empty - & Set.toList - in hashes & Monoid.foldMapM \hash -> do - component <- getComponent hash - pure - ( List.foldl' - f - Relation.empty - (Reference.componentFor hash component) - ) - where - f :: Relation name b -> (Reference.Id, a) -> Relation name b - f acc (ref, x) = - List.foldl' (g ref x) acc (Set.toList (Relation.lookupRan ref defns)) - - g :: Reference.Id -> a -> Relation name b -> name -> Relation name b - g ref x acc2 name = - Relation.insert name (modify name ref x) acc2 - ------------------------------------------------------------------------------------------------------------------------ -- Rendering definitions diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 83511008ea..45c7b3834e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -44,7 +44,7 @@ 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.UpdateUtils (hydrateDefns, renderDefnsForUnisonFile, ConflictedName (..), loadNamespaceDefinitions) +import Unison.Cli.UpdateUtils (hydrateDefns, loadNamespaceDefinitions, renderDefnsForUnisonFile) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) @@ -70,7 +70,7 @@ import Unison.Debug qualified as Debug import Unison.Hash qualified as Hash import Unison.Merge.CombineDiffs (CombinedDiffOp (..), combineDiffs) import Unison.Merge.Database (MergeDatabase (..), makeMergeDatabase, referent2to1) -import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason (..), checkDeclCoherency, lenientCheckDeclCoherency) +import Unison.Merge.DeclCoherencyCheck (checkDeclCoherency, lenientCheckDeclCoherency) import Unison.Merge.DeclNameLookup (DeclNameLookup (..), expectConstructorNames) import Unison.Merge.Diff qualified as Merge import Unison.Merge.DiffOp (DiffOp (..)) @@ -228,10 +228,8 @@ doMerge info = do (defns3, declNameLookups, lcaDeclNameLookup) <- do let emptyNametree = Nametree {value = Defns Map.empty Map.empty, children = Map.empty} let loadDefns branch = - Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) & onLeftM \conflictedName -> - done case conflictedName of - ConflictedName'Term name refs -> Output.MergeConflictedTermName name refs - ConflictedName'Type name refs -> Output.MergeConflictedTypeName name refs + Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) + & onLeftM (done . Output.ConflictedDefn "merge") let load = \case Nothing -> pure (emptyNametree, DeclNameLookup Map.empty Map.empty) Just (who, branch) -> do @@ -244,14 +242,7 @@ doMerge info = do Reference.toId defns ) - & onLeftM \err -> - done case err of - IncoherentDeclReason'ConstructorAlias typeName conName1 conName2 -> - Output.MergeConstructorAlias who typeName conName1 conName2 - IncoherentDeclReason'MissingConstructorName name -> Output.MergeMissingConstructorName who name - IncoherentDeclReason'NestedDeclAlias shorterName longerName -> - Output.MergeNestedDeclAlias who shorterName longerName - IncoherentDeclReason'StrayConstructor _typeRef name -> Output.MergeStrayConstructor who name + & onLeftM (done . Output.IncoherentDeclDuringMerge who) pure (defns, declNameLookup) (aliceDefns0, aliceDeclNameLookup) <- load (Just (mergeTarget, branches.alice)) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index f9dac22ef2..d62b9b1dd7 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.Update2 -- * Misc helpers to be organized later addDefinitionsToUnisonFile, - makeUnisonFile, findCtorNames, findCtorNamesMaybe, forwardCtorNames, @@ -15,7 +14,6 @@ module Unison.Codebase.Editor.HandleInput.Update2 typecheckedUnisonFileToBranchAdds, getNamespaceDependentsOf, getNamespaceDependentsOf2, - makeComplicatedPPE, ) where @@ -28,24 +26,22 @@ import Data.List.NonEmpty qualified as NonEmpty import Data.List.NonEmpty.Extra ((|>)) import Data.Map qualified as Map import Data.Maybe (fromJust) -import Data.Semialign (alignWith) import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.Lazy qualified as Lazy.Text -import Data.These (These (..)) import Text.Pretty.Simple (pShow) import U.Codebase.Reference (Reference, TermReferenceId) import U.Codebase.Reference qualified as Reference import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Operations qualified as Ops import Unison.Builtin.Decls qualified as Decls -import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad (Cli, Env (..)) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.Pretty qualified as Pretty import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) import Unison.Cli.UniqueTypeGuidLookup qualified as Cli -import Unison.Cli.UpdateUtils (hydrateDefns, hydrateDefnsRel, narrowDefns, renderDefnsForUnisonFile) +import Unison.Cli.UpdateUtils (hydrateDefns, narrowDefns, renderDefnsForUnisonFile) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch @@ -67,13 +63,13 @@ import Unison.Debug qualified as Debug import Unison.FileParsers qualified as FileParsers import Unison.Hash (Hash) import Unison.Merge.DeclCoherencyCheck (checkDeclCoherency) +import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Name.Forward (ForwardName (..)) import Unison.Name.Forward qualified as ForwardName -import Unison.NameSegment qualified as NameSegment import Unison.NameSegment.Internal (NameSegment (NameSegment)) -import Unison.Names (Names (Names)) +import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Ann @@ -83,7 +79,7 @@ import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl) import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.PrettyPrintEnvDecl.Names qualified as PPED -import Unison.Reference (Reference' (..), TypeReference, TypeReferenceId) +import Unison.Reference (TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference (fromId) import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -103,7 +99,7 @@ import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty) import Unison.Util.Monoid qualified as Monoid -import Unison.Util.Nametree (Nametree, unflattenNametree, flattenNametrees) +import Unison.Util.Nametree (flattenNametrees) import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation (Relation) @@ -114,7 +110,7 @@ import Unison.WatchKind qualified as WK handleUpdate2 :: Cli () handleUpdate2 = do - Cli.Env {codebase, writeSource} <- ask + env <- ask tuf <- Cli.expectLatestTypecheckedFile let termAndDeclNames = getTermAndDeclNames tuf pp <- Cli.getCurrentProjectPath @@ -122,13 +118,11 @@ handleUpdate2 = do let currentBranch0ExcludingLibdeps = Branch.deleteLibdeps currentBranch0 let namesIncludingLibdeps = Branch.toNames currentBranch0 let namesExcludingLibdeps = Branch.toNames currentBranch0ExcludingLibdeps - let ctorNames = forwardCtorNames namesExcludingLibdeps -- Assert that the namespace doesn't have any conflicted names defns <- - narrowDefns - (Branch.deepDefns currentBranch0ExcludingLibdeps) - & onLeft \conflictedName -> wundefined + narrowDefns (Branch.deepDefns currentBranch0ExcludingLibdeps) + & onLeft (Cli.returnEarly . Output.ConflictedDefn "update") -- Assert that the namespace doesn't have any incoherent decls declNameLookup <- @@ -139,55 +133,54 @@ handleUpdate2 = do Reference.toId defns ) - & onLeftM \err -> wundefined - - let defns1 = flattenNametrees defns + & onLeftM (Cli.returnEarly . Output.IncoherentDeclDuringUpdate) Cli.respond Output.UpdateLookingForDependents - dependents0 <- + (dependents, hydratedDependents) <- Cli.runTransaction do - getNamespaceDependentsOf2 - defns1 - (getExistingReferencesNamed termAndDeclNames namesExcludingLibdeps) - - -- Throw away the dependents that are shadowed by the file itself - let dependents1 :: DefnsF (Map Name) TermReferenceId TypeReferenceId - dependents1 = - bimap - (`Map.withoutKeys` (Set.map Name.unsafeParseVar (UF.termNamespaceBindings tuf))) - (`Map.withoutKeys` (Set.map Name.unsafeParseVar (UF.typeNamespaceBindings tuf))) - dependents0 + -- Get all dependents of things being updated + dependents0 <- + getNamespaceDependentsOf2 + (flattenNametrees defns) + (getExistingReferencesNamed termAndDeclNames namesExcludingLibdeps) + + -- Throw away the dependents that are shadowed by the file itself + let dependents1 :: DefnsF (Map Name) TermReferenceId TypeReferenceId + dependents1 = + bimap + (`Map.withoutKeys` (Set.map Name.unsafeParseVar (UF.termNamespaceBindings tuf))) + (`Map.withoutKeys` (Set.map Name.unsafeParseVar (UF.typeNamespaceBindings tuf))) + dependents0 + + -- Hydrate the dependents for rendering + hydratedDependents <- + hydrateDefns + (Codebase.unsafeGetTermComponent env.codebase) + Operations.expectDeclComponent + dependents1 + + pure (dependents1, hydratedDependents) secondTuf <- do - case defnsAreEmpty dependents1 of + case defnsAreEmpty dependents of -- If there are no dependents of the updates, then just use the already-typechecked file. True -> pure tuf False -> do - hydratedDependents <- - Cli.runTransaction do - hydrateDefns - (Codebase.unsafeGetTermComponent codebase) - Operations.expectDeclComponent - dependents1 - - let ppe = makeComplicatedPPE2 10 namesIncludingLibdeps (UF.typecheckedToNames tuf) dependents1 - - let renderedDependents :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) - renderedDependents = - renderDefnsForUnisonFile declNameLookup ppe hydratedDependents + Cli.respond Output.UpdateStartTypechecking let prettyUnisonFile = - makePrettyUnisonFile (Pretty.prettyUnisonFile ppe (UF.discardTypes tuf)) renderedDependents - - Cli.respond Output.UpdateStartTypechecking + let ppe = makePPE 10 namesIncludingLibdeps (UF.typecheckedToNames tuf) dependents + in makePrettyUnisonFile + (Pretty.prettyUnisonFile ppe (UF.discardTypes tuf)) + (renderDefnsForUnisonFile declNameLookup ppe hydratedDependents) parsingEnv <- makeParsingEnv pp namesIncludingLibdeps secondTuf <- prettyParseTypecheck2 prettyUnisonFile parsingEnv & onLeftM \prettyUf -> do scratchFilePath <- fst <$> Cli.expectLatestFile - liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUf) + liftIO $ env.writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUf) Cli.returnEarly Output.UpdateTypecheckingFailure Cli.respond Output.UpdateTypecheckingSuccess @@ -201,7 +194,7 @@ handleUpdate2 = do Codebase.addDefsToCodebase env.codebase secondTuf typecheckedUnisonFileToBranchUpdates abort - (findCtorNamesMaybe Output.UOUUpdate namesExcludingLibdeps ctorNames Nothing) + (\typeName -> Right (Map.lookup typeName declNameLookup.declToConstructors)) secondTuf Cli.stepAt "update" (path, Branch.batchUpdates branchUpdates) @@ -219,7 +212,7 @@ makePrettyUnisonFile originalFile dependents = <> Pretty.newline <> ( dependents & inAlphabeticalOrder - & let f = foldMap (<> "\n") in bifoldMap f f + & let f = foldMap (\defn -> defn <> Pretty.newline <> Pretty.newline) in bifoldMap f f ) where inAlphabeticalOrder :: DefnsF (Map Name) a b -> DefnsF [] a b @@ -308,7 +301,10 @@ typecheckedUnisonFileToBranchUpdates abort getConstructors tuf = do -- some decls will be deleted, we want to delete their -- constructors as well deleteConstructorActions <- - (maybe [] (map (BranchUtil.makeAnnihilateTermName . Path.splitFromName)) <$> getConstructors (Name.unsafeParseVar symbol)) & onLeft abort + ( maybe [] (map (BranchUtil.makeAnnihilateTermName . Path.splitFromName)) + <$> getConstructors (Name.unsafeParseVar symbol) + ) + & onLeft abort let deleteTypeAction = BranchUtil.makeAnnihilateTypeName split split = splitVar symbol insertTypeAction = BranchUtil.makeAddTypeName split (Reference.fromId typeRefId) @@ -635,72 +631,16 @@ getNamespaceDependentsOf2 defns dependencies = do -- However, the following file will not fail to parse, if `one.foo` and `two.foo` are aliases in the codebase: -- -- hey = foo + foo -makeComplicatedPPE :: - Int -> - Names -> - Names -> - DefnsF (Relation Name) TermReferenceId TypeReferenceId -> - PrettyPrintEnvDecl -makeComplicatedPPE hashLen names initialFileNames dependents = - primaryPPE `PPED.addFallback` secondaryPPE - where - primaryPPE = - PPED.makePPED (PPE.namer namesInTheFile) (PPE.suffixifyByName namesInTheFile) - - secondaryPPE = - PPED.makePPED - (PPE.hqNamer hashLen names) - -- We don't want to over-suffixify for a reference in the namespace. For example, say we have "foo.bar" in the - -- namespace and "oink.bar" in the file. "bar" may be a unique suffix among the namespace names, but would be - -- ambiguous in the context of namespace + file names. - -- - -- So, we use `unionLeftName`, which starts with the LHS names (the namespace), and adds to it names from the - -- RHS (the initial file names, i.e. what was originally saved) that don't already exist in the LHS. - (PPE.suffixifyByHash (Names.unionLeftName names initialFileNames)) - - namesInTheFile = - initialFileNames <> dependentsNames - - dependentsNames = - Names - { terms = Relation.mapRan Referent.fromTermReferenceId dependents.terms, - types = Relation.mapRan Reference.fromId dependents.types - } - --- The big picture behind PPE building, though there are many details: --- --- * We are updating old references to new references by rendering old references as names that are then parsed --- back to resolve to new references (the world's weirdest implementation of AST substitution). --- --- * We have to render names that refer to definitions in the file with a different suffixification strategy --- (namely, "suffixify by name") than names that refer to things in the codebase. --- --- This is because you *may* refer to aliases that share a suffix by that suffix for definitions in the --- codebase, but not in the file. --- --- For example, the following file will fail to parse: --- --- one.foo = 10 --- two.foo = 10 --- hey = foo + foo -- "Which foo do you mean? There are two." --- --- However, the following file will not fail to parse, if `one.foo` and `two.foo` are aliases in the codebase: --- --- hey = foo + foo -makeComplicatedPPE2 :: +makePPE :: Int -> Names -> Names -> DefnsF (Map Name) TermReferenceId TypeReferenceId -> PrettyPrintEnvDecl -makeComplicatedPPE2 hashLen names initialFileNames dependents = - primaryPPE `PPED.addFallback` secondaryPPE - where - primaryPPE = - PPED.makePPED (PPE.namer namesInTheFile) (PPE.suffixifyByName namesInTheFile) - - secondaryPPE = - PPED.makePPED +makePPE hashLen names initialFileNames dependents = + PPED.addFallback + (PPED.makeFilePPED (initialFileNames <> Names.fromUnconflictedReferenceIds dependents)) + ( PPED.makePPED (PPE.hqNamer hashLen names) -- We don't want to over-suffixify for a reference in the namespace. For example, say we have "foo.bar" in the -- namespace and "oink.bar" in the file. "bar" may be a unique suffix among the namespace names, but would be @@ -709,12 +649,4 @@ makeComplicatedPPE2 hashLen names initialFileNames dependents = -- So, we use `unionLeftName`, which starts with the LHS names (the namespace), and adds to it names from the -- RHS (the initial file names, i.e. what was originally saved) that don't already exist in the LHS. (PPE.suffixifyByHash (Names.unionLeftName names initialFileNames)) - - namesInTheFile = - initialFileNames <> dependentsNames - - dependentsNames = - Names - { terms = Relation.fromMap (Map.map Referent.fromTermReferenceId dependents.terms), - types = Relation.fromMap (Map.map Reference.fromId dependents.types) - } + ) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index af57ea6fab..7d2f1aa003 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -27,7 +27,6 @@ import Unison.Codebase.Editor.HandleInput.Update2 findCtorNamesMaybe, forwardCtorNames, getNamespaceDependentsOf, - makeComplicatedPPE, makeParsingEnv, prettyParseTypecheck, typecheckedUnisonFileToBranchUpdates, @@ -47,6 +46,7 @@ import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.PrettyPrintEnvDecl qualified as PPED (addFallback) +import Unison.PrettyPrintEnvDecl.Names qualified as PPED (makeCodebasePPED, makeFilePPED) import Unison.Project (ProjectBranchName) import Unison.Reference (TermReference, TypeReference) import Unison.Referent (Referent) @@ -138,7 +138,6 @@ handleUpgrade oldName newName = do (findCtorNames Output.UOUUpgrade currentLocalNames currentLocalConstructorNames) dependents UnisonFile.emptyUnisonFile - hashLength <- Codebase.hashLength pure ( unisonFile, makeOldDepPPE @@ -148,7 +147,8 @@ handleUpgrade oldName newName = do (Branch.toNames oldNamespace) (Branch.toNames oldLocalNamespace) (Branch.toNames newLocalNamespace) - `PPED.addFallback` makeComplicatedPPE hashLength currentDeepNamesSansOld mempty dependents + `PPED.addFallback` PPED.makeFilePPED (Names.fromReferenceIds dependents) + `PPED.addFallback` PPED.makeCodebasePPED currentDeepNamesSansOld ) pp@(PP.ProjectPath project projectBranch _path) <- Cli.getCurrentProjectPath diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index c4358247e5..0f0b9dac3c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -57,7 +57,7 @@ import Unison.Hash (Hash) import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency (LabeledDependency) -import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..)) +import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason, IncoherentDeclReasons (..)) import Unison.Name (Name) import Unison.NameSegment (NameSegment) import Unison.Names (Names) @@ -84,6 +84,8 @@ import Unison.Term (Term) import Unison.Type (Type) import Unison.Typechecker.Context qualified as Context import Unison.UnisonFile qualified as UF +import Unison.Util.Conflicted (Conflicted) +import Unison.Util.Defn (Defn) import Unison.Util.Defns (DefnsF, defnsAreEmpty) import Unison.Util.Pretty qualified as P import Unison.Util.Relation (Relation) @@ -199,15 +201,15 @@ data Output | -- | Function found, but has improper type -- Note: the constructor name is misleading here; we weren't necessarily looking for a "main". BadMainFunction + -- | what we were trying to do (e.g. "run", "io.test") Text - -- ^ what we were trying to do (e.g. "run", "io.test") + -- | name of function (HQ.HashQualified Name) - -- ^ name of function + -- | bad type of function (Type Symbol Ann) - -- ^ bad type of function PPE.PrettyPrintEnv + -- | acceptable type(s) of function [Type Symbol Ann] - -- ^ acceptable type(s) of function | BranchEmpty WhichBranchEmpty | LoadPullRequest (ReadRemoteNamespace Void) (ReadRemoteNamespace Void) Path' Path' Path' Path' | CreatedNewBranch Path.Absolute @@ -244,12 +246,12 @@ data Output -- for terms. This additional info is used to provide an enhanced -- error message. SearchTermsNotFoundDetailed + -- | @True@ if we are searching for a term, @False@ if we are searching for a type Bool - -- ^ @True@ if we are searching for a term, @False@ if we are searching for a type + -- | Misses (search terms that returned no hits for terms or types) [HQ.HashQualified Name] - -- ^ Misses (search terms that returned no hits for terms or types) + -- | Hits for types if we are searching for terms or terms if we are searching for types [HQ.HashQualified Name] - -- ^ Hits for types if we are searching for terms or terms if we are searching for types | -- ask confirmation before deleting the last branch that contains some defns -- `Path` is one of the paths the user has requested to delete, and is paired -- with whatever named definitions would not have any remaining names if @@ -392,8 +394,8 @@ data Output | CalculatingDiff | -- | The `local` in a `clone remote local` is ambiguous AmbiguousCloneLocal + -- | Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) - -- ^ Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) | -- | The `remote` in a `clone remote local` is ambiguous AmbiguousCloneRemote ProjectName (ProjectAndBranch ProjectName ProjectBranchName) @@ -419,20 +421,17 @@ data Output | MergeSuccess !MergeSourceAndTarget | MergeSuccessFastForward !MergeSourceAndTarget | MergeConflictedAliases !MergeSourceOrTarget !Name !Name - | MergeConflictedTermName !Name !(NESet Referent) - | MergeConflictedTypeName !Name !(NESet TypeReference) | MergeConflictInvolvingBuiltin !Name - | MergeConstructorAlias !MergeSourceOrTarget !Name !Name !Name | MergeDefnsInLib !MergeSourceOrTarget - | MergeMissingConstructorName !MergeSourceOrTarget !Name - | MergeNestedDeclAlias !MergeSourceOrTarget !Name !Name - | MergeStrayConstructor !MergeSourceOrTarget !Name | InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment | NoUpgradeInProgress | UseLibInstallNotPull !(ProjectAndBranch ProjectName ProjectBranchName) | PullIntoMissingBranch !(ReadRemoteNamespace Share.RemoteProjectBranch) !(ProjectAndBranch (Maybe ProjectName) ProjectBranchName) | NoMergeInProgress | Output'DebugSynhashTerm !TermReference !Hash !Text + | ConflictedDefn !Text {- what operation? -} !(Defn (Conflicted Name Referent) (Conflicted Name TypeReference)) + | IncoherentDeclDuringMerge !MergeSourceOrTarget !IncoherentDeclReason + | IncoherentDeclDuringUpdate !IncoherentDeclReason data MoreEntriesThanShown = MoreEntriesThanShown | AllEntriesShown deriving (Eq, Show) @@ -658,20 +657,17 @@ isFailure o = case o of MergeSuccess {} -> False MergeSuccessFastForward {} -> False MergeConflictedAliases {} -> True - MergeConflictedTermName {} -> True - MergeConflictedTypeName {} -> True MergeConflictInvolvingBuiltin {} -> True - MergeConstructorAlias {} -> True MergeDefnsInLib {} -> True - MergeMissingConstructorName {} -> True - MergeNestedDeclAlias {} -> True - MergeStrayConstructor {} -> True InstalledLibdep {} -> False NoUpgradeInProgress {} -> True UseLibInstallNotPull {} -> False PullIntoMissingBranch {} -> True NoMergeInProgress {} -> True Output'DebugSynhashTerm {} -> False + ConflictedDefn {} -> True + IncoherentDeclDuringMerge {} -> True + IncoherentDeclDuringUpdate {} -> True isNumberedFailure :: NumberedOutput -> Bool isNumberedFailure = \case diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 861b339eb3..178c4aa4ea 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -85,7 +85,7 @@ import Unison.Hash32 (Hash32) import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency as LD -import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..)) +import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason (..), IncoherentDeclReasons (..)) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment @@ -141,6 +141,8 @@ import Unison.Term (Term) import Unison.Term qualified as Term import Unison.Type (Type) import Unison.UnisonFile qualified as UF +import Unison.Util.Conflicted (Conflicted (..)) +import Unison.Util.Defn (Defn (..)) import Unison.Util.Defns (Defns (..)) import Unison.Util.List qualified as List import Unison.Util.Monoid (intercalateMap) @@ -1384,12 +1386,6 @@ notifyUser dir = \case <> P.newline <> P.newline <> P.wrap "and then try merging again." - MergeConflictedTermName name _refs -> - pure . P.wrap $ - "The term name" <> prettyName name <> "is ambiguous. Please resolve the ambiguity before merging." - MergeConflictedTypeName name _refs -> - pure . P.wrap $ - "The type name" <> prettyName name <> "is ambiguous. Please resolve the ambiguity before merging." MergeConflictInvolvingBuiltin name -> pure . P.lines $ [ P.wrap "Sorry, I wasn't able to perform the merge:", @@ -1406,22 +1402,6 @@ notifyUser dir = \case <> "the same on both branches, or making neither of them a builtin, and then try the merge again." ) ] - -- Note [ConstructorAliasMessage] If you change this, also change the other similar one - MergeConstructorAlias aliceOrBob typeName conName1 conName2 -> - pure . P.lines $ - [ P.wrap "Sorry, I wasn't able to perform the merge:", - "", - P.wrap $ - "On" - <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") - <> "the type" - <> prettyName typeName - <> "has a constructor with multiple names, and I can't perform a merge in this situation:", - "", - P.indentN 2 (P.bulleted [prettyName conName1, prettyName conName2]), - "", - P.wrap "Please delete all but one name for each constructor, and then try merging again." - ] -- Note [DefnsInLibMessage] If you change this, also change the other similar one MergeDefnsInLib aliceOrBob -> pure . P.lines $ @@ -1435,54 +1415,6 @@ notifyUser dir = \case "", P.wrap "Please move or remove it and then try merging again." ] - -- Note [MissingConstructorNameMessage] If you change this, also change the other similar one - MergeMissingConstructorName aliceOrBob name -> - pure . P.lines $ - [ P.wrap "Sorry, I wasn't able to perform the merge:", - "", - P.wrap $ - "On" - <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") - <> "the type" - <> prettyName name - <> "has some constructors with missing names, and I can't perform a merge in this situation.", - "", - P.wrap $ - "You can use" - <> IP.makeExample IP.view [prettyName name] - <> "and" - <> IP.makeExample IP.aliasTerm ["", prettyName name <> "."] - <> "to give names to each unnamed constructor, and then try the merge again." - ] - -- Note [NestedDeclAliasMessage] If you change this, also change the other similar one - MergeNestedDeclAlias aliceOrBob shorterName longerName -> - pure . P.wrap $ - "On" - <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") - <> "the type" - <> prettyName longerName - <> "is an alias of" - <> P.group (prettyName shorterName <> ".") - <> "I'm not able to perform a merge when a type exists nested under an alias of itself. Please separate them or" - <> "delete one copy, and then try merging again." - -- Note [StrayConstructorMessage] If you change this, also change the other similar one - MergeStrayConstructor aliceOrBob name -> - pure . P.lines $ - [ P.wrap $ - "Sorry, I wasn't able to perform the merge, because I need all constructor names to be nested somewhere" - <> "beneath the corresponding type name.", - "", - P.wrap $ - "On" - <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") - <> "the constructor" - <> prettyName name - <> "is not nested beneath the corresponding type name. Please either use" - <> IP.makeExample' IP.moveAll - <> "to move it, or if it's an extra copy, you can simply" - <> IP.makeExample' IP.delete - <> "it. Then try the merge again." - ] PreviewMergeAlreadyUpToDate src dest -> pure . P.callout "😶" $ P.wrap $ @@ -2161,6 +2093,139 @@ notifyUser dir = \case <> P.newline <> "Synhash tokens: " <> P.text filename + ConflictedDefn operation defn -> + pure . P.wrap $ + ( case defn of + TermDefn (Conflicted name _refs) -> "The term name" <> prettyName name <> "is ambiguous." + TypeDefn (Conflicted name _refs) -> "The type name" <> prettyName name <> "is ambiguous." + ) + <> "Please resolve the ambiguity, then try to" + <> P.text operation + <> "again." + IncoherentDeclDuringMerge aliceOrBob reason -> + case reason of + -- Note [ConstructorAliasMessage] If you change this, also change the other similar ones + IncoherentDeclReason'ConstructorAlias typeName conName1 conName2 -> + pure . P.lines $ + [ P.wrap "Sorry, I wasn't able to perform the merge:", + "", + P.wrap $ + "On" + <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + <> "the type" + <> prettyName typeName + <> "has a constructor with multiple names, and I can't perform a merge in this situation:", + "", + P.indentN 2 (P.bulleted [prettyName conName1, prettyName conName2]), + "", + P.wrap "Please delete all but one name for each constructor, and then try merging again." + ] + -- Note [MissingConstructorNameMessage] If you change this, also change the other similar ones + IncoherentDeclReason'MissingConstructorName name -> + pure . P.lines $ + [ P.wrap "Sorry, I wasn't able to perform the merge:", + "", + P.wrap $ + "On" + <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + <> "the type" + <> prettyName name + <> "has some constructors with missing names, and I can't perform a merge in this situation.", + "", + P.wrap $ + "You can use" + <> IP.makeExample IP.view [prettyName name] + <> "and" + <> IP.makeExample IP.aliasTerm ["", prettyName name <> "."] + <> "to give names to each unnamed constructor, and then try the merge again." + ] + -- Note [NestedDeclAliasMessage] If you change this, also change the other similar ones + IncoherentDeclReason'NestedDeclAlias shorterName longerName -> + pure . P.wrap $ + "On" + <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + <> "the type" + <> prettyName longerName + <> "is an alias of" + <> P.group (prettyName shorterName <> ".") + <> "I'm not able to perform a merge when a type exists nested under an alias of itself. Please separate them or" + <> "delete one copy, and then try merging again." + -- Note [StrayConstructorMessage] If you change this, also change the other similar ones + IncoherentDeclReason'StrayConstructor _typeRef name -> + pure . P.lines $ + [ P.wrap $ + "Sorry, I wasn't able to perform the merge, because I need all constructor names to be nested somewhere" + <> "beneath the corresponding type name.", + "", + P.wrap $ + "On" + <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",") + <> "the constructor" + <> prettyName name + <> "is not nested beneath the corresponding type name. Please either use" + <> IP.makeExample' IP.moveAll + <> "to move it, or if it's an extra copy, you can simply" + <> IP.makeExample' IP.delete + <> "it. Then try the merge again." + ] + IncoherentDeclDuringUpdate reason -> + case reason of + -- Note [ConstructorAliasMessage] If you change this, also change the other similar ones + IncoherentDeclReason'ConstructorAlias typeName conName1 conName2 -> + pure . P.lines $ + [ P.wrap "Sorry, I wasn't able to perform the update:", + "", + P.wrap $ + "The type" + <> prettyName typeName + <> "has a constructor with multiple names, and I can't perform an update in this situation:", + "", + P.indentN 2 (P.bulleted [prettyName conName1, prettyName conName2]), + "", + P.wrap "Please delete all but one name for each constructor, and then try updating again." + ] + -- Note [MissingConstructorNameMessage] If you change this, also change the other similar ones + IncoherentDeclReason'MissingConstructorName name -> + pure . P.lines $ + [ P.wrap "Sorry, I wasn't able to perform the update:", + "", + P.wrap $ + "The type" + <> prettyName name + <> "has some constructors with missing names, and I can't perform an update in this situation.", + "", + P.wrap $ + "You can use" + <> IP.makeExample IP.view [prettyName name] + <> "and" + <> IP.makeExample IP.aliasTerm ["", prettyName name <> "."] + <> "to give names to each unnamed constructor, and then try the update again." + ] + -- Note [NestedDeclAliasMessage] If you change this, also change the other similar ones + IncoherentDeclReason'NestedDeclAlias shorterName longerName -> + pure . P.wrap $ + "The type" + <> prettyName longerName + <> "is an alias of" + <> P.group (prettyName shorterName <> ".") + <> "I'm not able to perform an update when a type exists nested under an alias of itself. Please separate" + <> "them or delete one copy, and then try updating again." + -- Note [StrayConstructorMessage] If you change this, also change the other similar ones + IncoherentDeclReason'StrayConstructor _typeRef name -> + pure . P.lines $ + [ P.wrap $ + "Sorry, I wasn't able to perform the update, because I need all constructor names to be nested somewhere" + <> "beneath the corresponding type name.", + "", + P.wrap $ + "The constructor" + <> prettyName name + <> "is not nested beneath the corresponding type name. Please either use" + <> IP.makeExample' IP.moveAll + <> "to move it, or if it's an extra copy, you can simply" + <> IP.makeExample' IP.delete + <> "it. Then try the update again." + ] prettyShareError :: ShareError -> Pretty prettyShareError = @@ -2701,7 +2766,7 @@ handleTodoOutput todo things & map ( \(typeName, prettyCon1, prettyCon2) -> - -- Note [ConstructorAliasMessage] If you change this, also change the other similar one + -- Note [ConstructorAliasMessage] If you change this, also change the other similar ones P.wrap ("The type" <> prettyName typeName <> "has a constructor with multiple names.") <> P.newline <> P.newline @@ -2720,7 +2785,7 @@ handleTodoOutput todo for types0 \typ -> do n <- addNumberedArg (SA.Name typ) pure (n, typ) - -- Note [MissingConstructorNameMessage] If you change this, also change the other similar one + -- Note [MissingConstructorNameMessage] If you change this, also change the other similar ones pure $ P.wrap "These types have some constructors with missing names." @@ -2753,7 +2818,7 @@ handleTodoOutput todo n1 <- addNumberedArg (SA.Name short) n2 <- addNumberedArg (SA.Name long) pure (formatNum n1 <> prettyName short, formatNum n2 <> prettyName long) - -- Note [NestedDeclAliasMessage] If you change this, also change the other similar one + -- Note [NestedDeclAliasMessage] If you change this, also change the other similar ones pure $ aliases1 & map @@ -2775,7 +2840,7 @@ handleTodoOutput todo nums <- for constructors \(_typeRef, constructor) -> do addNumberedArg (SA.Name constructor) - -- Note [StrayConstructorMessage] If you change this, also change the other similar one + -- Note [StrayConstructorMessage] If you change this, also change the other similar ones pure $ P.wrap "These constructors are not nested beneath their corresponding type names:" <> P.newline diff --git a/unison-core/src/Unison/Names.hs b/unison-core/src/Unison/Names.hs index 8cef280107..b85454f956 100644 --- a/unison-core/src/Unison/Names.hs +++ b/unison-core/src/Unison/Names.hs @@ -12,6 +12,8 @@ module Unison.Names filterByHQs, filterBySHs, filterTypes, + fromReferenceIds, + fromUnconflictedReferenceIds, map, makeAbsolute, makeRelative, @@ -69,7 +71,7 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.Prelude -import Unison.Reference (Reference, TermReference, TypeReference) +import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -105,6 +107,22 @@ instance Monoid (Names) where isEmpty :: Names -> Bool isEmpty n = R.null n.terms && R.null n.types +-- | Construct a 'Names' from unconflicted reference ids. +fromReferenceIds :: DefnsF (Relation Name) TermReferenceId TypeReferenceId -> Names +fromReferenceIds defns = + Names + { terms = Relation.mapRan Referent.fromTermReferenceId defns.terms, + types = Relation.mapRan Reference.fromId defns.types + } + +-- | Construct a 'Names' from unconflicted reference ids. +fromUnconflictedReferenceIds :: DefnsF (Map Name) TermReferenceId TypeReferenceId -> Names +fromUnconflictedReferenceIds defns = + Names + { terms = Relation.fromMap (Map.map Referent.fromTermReferenceId defns.terms), + types = Relation.fromMap (Map.map Reference.fromId defns.types) + } + map :: (Name -> Name) -> Names -> Names map f (Names {terms, types}) = Names terms' types' where @@ -542,7 +560,7 @@ lenientToNametree names = (lenientRelationToNametree names.terms) (lenientRelationToNametree names.types) where - lenientRelationToNametree :: Ord a => Relation Name a -> Nametree (Map NameSegment a) + lenientRelationToNametree :: (Ord a) => Relation Name a -> Nametree (Map NameSegment a) lenientRelationToNametree = -- The partial `Set.findMin` is fine here because Relation.domain only has non-empty Set values. A NESet would be -- better. diff --git a/unison-core/src/Unison/Util/Conflicted.hs b/unison-core/src/Unison/Util/Conflicted.hs new file mode 100644 index 0000000000..2d90f4318c --- /dev/null +++ b/unison-core/src/Unison/Util/Conflicted.hs @@ -0,0 +1,10 @@ +module Unison.Util.Conflicted + ( Conflicted (..), + ) +where + +import Data.Set.NonEmpty (NESet) + +-- | A conflicted thing. +data Conflicted n a + = Conflicted !n !(NESet a) diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal index 31683e5530..aff6128306 100644 --- a/unison-core/unison-core1.cabal +++ b/unison-core/unison-core1.cabal @@ -55,6 +55,7 @@ library Unison.Type Unison.Type.Names Unison.Util.Components + Unison.Util.Conflicted Unison.Util.Defn Unison.Util.Defns Unison.Util.Nametree diff --git a/unison-src/transcripts/diff-namespace.md b/unison-src/transcripts/diff-namespace.md index f2312268a8..bdffd37231 100644 --- a/unison-src/transcripts/diff-namespace.md +++ b/unison-src/transcripts/diff-namespace.md @@ -92,10 +92,14 @@ scratch/ns2> update scratch/main> diff.namespace /ns1: /ns2: scratch/ns2> alias.term d d' scratch/ns2> alias.type A A' +scratch/ns2> alias.term A.A A'.A scratch/ns2> alias.type X X' +scratch/ns2> alias.term X.x X'.x scratch/main> diff.namespace /ns1: /ns2: scratch/ns1> alias.type X X2 +scratch/ns1> alias.term X.x X2.x scratch/ns2> alias.type A' A'' +scratch/ns2> alias.term A'.A A''.A scratch/ns2> branch /ns3 scratch/ns2> alias.term fromJust' yoohoo scratch/ns2> delete.term.verbose fromJust' diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md index d54ff32e00..d496873895 100644 --- a/unison-src/transcripts/diff-namespace.output.md +++ b/unison-src/transcripts/diff-namespace.output.md @@ -199,10 +199,18 @@ scratch/ns2> alias.type A A' Done. +scratch/ns2> alias.term A.A A'.A + + Done. + scratch/ns2> alias.type X X' Done. +scratch/ns2> alias.term X.x X'.x + + Done. + scratch/main> diff.namespace /ns1: /ns2: Resolved name conflicts: @@ -238,17 +246,29 @@ scratch/main> diff.namespace /ns1: /ns2: 16. X 17. X' (added) - 18. fromJust' ┐ 19. fromJust#gjmq673r1v (removed) - 20. fromJust#gjmq673r1v ┘ + 18. A.A 19. A'.A (added) + + 20. fromJust' ┐ 21. fromJust#gjmq673r1v (removed) + 22. fromJust#gjmq673r1v ┘ + + 23. X.x 24. X'.x (added) scratch/ns1> alias.type X X2 Done. +scratch/ns1> alias.term X.x X2.x + + Done. + scratch/ns2> alias.type A' A'' Done. +scratch/ns2> alias.term A'.A A''.A + + Done. + scratch/ns2> branch /ns3 Done. I've created the ns3 branch based off of ns2. diff --git a/unison-src/transcripts/update-on-conflict.md b/unison-src/transcripts/update-on-conflict.md index e36c20fdff..8239a4689b 100644 --- a/unison-src/transcripts/update-on-conflict.md +++ b/unison-src/transcripts/update-on-conflict.md @@ -1,6 +1,6 @@ # Update on conflict -Updating conflicted definitions works fine. +Conflicted definitions prevent `update` from succeeding. ```ucm:hide scratch/main> builtins.merge lib.builtins @@ -21,7 +21,6 @@ scratch/main> delete.term temp x = 3 ``` -```ucm +```ucm:error scratch/main> update -scratch/main> view x ``` diff --git a/unison-src/transcripts/update-on-conflict.output.md b/unison-src/transcripts/update-on-conflict.output.md index 373d3ac22d..d2a5f2de22 100644 --- a/unison-src/transcripts/update-on-conflict.output.md +++ b/unison-src/transcripts/update-on-conflict.output.md @@ -1,6 +1,6 @@ # Update on conflict -Updating conflicted definitions works fine. +Conflicted definitions prevent `update` from succeeding. ``` unison x = 1 @@ -59,14 +59,7 @@ x = 3 ``` ucm scratch/main> update - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> view x - - x : Nat - x = 3 + The term name x is ambiguous. Please resolve the ambiguity, + then try to update again. ``` diff --git a/unison-src/transcripts/update-suffixifies-properly.output.md b/unison-src/transcripts/update-suffixifies-properly.output.md index b76176388b..8e71e3a904 100644 --- a/unison-src/transcripts/update-suffixifies-properly.output.md +++ b/unison-src/transcripts/update-suffixifies-properly.output.md @@ -70,6 +70,11 @@ myproject/main> update ``` ``` unison:added-by-ucm scratch.u +foo = +30 + +-- The definitions below are not compatible with the updated definitions above. +-- Please fix the errors and run `update` again. + bar : Nat bar = use Nat + @@ -85,6 +90,5 @@ d.y.y.y.y = use Nat + foo + 10 -foo = +30 ``` diff --git a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md index 02eeabcfc2..646d559fbd 100644 --- a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md +++ b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md @@ -68,12 +68,16 @@ scratch/main> update ``` ``` unison:added-by-ucm scratch.u +foo : Int +foo = +5 + +-- The definitions below are not compatible with the updated definitions above. +-- Please fix the errors and run `update` again. + bar : Nat bar = use Nat + foo + 10 -foo : Int -foo = +5 ``` diff --git a/unison-src/transcripts/update-test-watch-roundtrip.output.md b/unison-src/transcripts/update-test-watch-roundtrip.output.md index 31aa18ea23..9caf54c2f3 100644 --- a/unison-src/transcripts/update-test-watch-roundtrip.output.md +++ b/unison-src/transcripts/update-test-watch-roundtrip.output.md @@ -51,10 +51,14 @@ scratch/main> update ``` ``` unison:added-by-ucm scratch.u +foo n = "hello, world!" + +-- The definitions below are not compatible with the updated definitions above. +-- Please fix the errors and run `update` again. + test> mynamespace.foo.test = n = 2 if foo n == 2 then [Ok "passed"] else [Fail "wat"] -foo n = "hello, world!" ``` diff --git a/unison-src/transcripts/update-type-constructor-alias.md b/unison-src/transcripts/update-type-constructor-alias.md index 50d55af066..4e946d635b 100644 --- a/unison-src/transcripts/update-type-constructor-alias.md +++ b/unison-src/transcripts/update-type-constructor-alias.md @@ -15,9 +15,6 @@ scratch/main> alias.term Foo.Bar Foo.BarAlias unique type Foo = Bar Nat Nat ``` -Bug: we leave `Foo.BarAlias` in the namespace with a nameless decl. - -```ucm +```ucm:error scratch/main> update -scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-constructor-alias.output.md b/unison-src/transcripts/update-type-constructor-alias.output.md index e8d95fafe0..5dfa27c938 100644 --- a/unison-src/transcripts/update-type-constructor-alias.output.md +++ b/unison-src/transcripts/update-type-constructor-alias.output.md @@ -45,27 +45,18 @@ unique type Foo = Bar Nat Nat type Foo ``` -Bug: we leave `Foo.BarAlias` in the namespace with a nameless decl. - ``` ucm scratch/main> update - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> find.verbose - - 1. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g - type Foo - - 2. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g#0 - Foo.Bar : Nat -> Nat -> Foo - - 3. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60#0 - Foo.BarAlias : Nat -> #b509v3eg4k - + Sorry, I wasn't able to perform the update: + + The type Foo has a constructor with multiple names, and I + can't perform an update in this situation: + + * Foo.Bar + * Foo.BarAlias + Please delete all but one name for each constructor, and then + try updating again. ``` diff --git a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md index 977866e321..eee51c7060 100644 --- a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md +++ b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md @@ -65,11 +65,15 @@ scratch/main> update ``` ``` unison:added-by-ucm scratch.u +type Foo = Bar Nat + +-- The definitions below are not compatible with the updated definitions above. +-- Please fix the errors and run `update` again. + foo : Foo -> Nat foo = cases Bar n -> n Baz n m -> n Nat.+ m -type Foo = Bar Nat ``` diff --git a/unison-src/transcripts/update-type-delete-record-field.output.md b/unison-src/transcripts/update-type-delete-record-field.output.md index 876edca300..fe6038c1c3 100644 --- a/unison-src/transcripts/update-type-delete-record-field.output.md +++ b/unison-src/transcripts/update-type-delete-record-field.output.md @@ -104,6 +104,11 @@ scratch/main> find.verbose ``` ``` unison:added-by-ucm scratch.u +type Foo = { bar : Nat } + +-- The definitions below are not compatible with the updated definitions above. +-- Please fix the errors and run `update` again. + Foo.baz : Foo -> Int Foo.baz = cases Foo _ baz -> baz @@ -113,6 +118,5 @@ Foo.baz.modify f = cases Foo bar baz -> Foo bar (f baz) Foo.baz.set : Int -> Foo -> Foo Foo.baz.set baz1 = cases Foo bar _ -> Foo bar baz1 -type Foo = { bar : Nat } ``` diff --git a/unison-src/transcripts/update-type-missing-constructor.output.md b/unison-src/transcripts/update-type-missing-constructor.output.md index c9c8bc2eca..bd92140cdd 100644 --- a/unison-src/transcripts/update-type-missing-constructor.output.md +++ b/unison-src/transcripts/update-type-missing-constructor.output.md @@ -54,15 +54,13 @@ scratch/main> view Foo scratch/main> update - Okay, I'm searching the branch for code that needs to be - updated... - - I couldn't complete the update because the type Foo has - unnamed constructors. (I currently need each constructor to - have a name somewhere under the type name.) + Sorry, I wasn't able to perform the update: + + The type Foo has some constructors with missing names, and I + can't perform an update in this situation. You can use `view Foo` and `alias.term Foo.` to give names to - each constructor, and then try the update again. + each unnamed constructor, and then try the update again. ``` diff --git a/unison-src/transcripts/update-type-nested-decl-aliases.md b/unison-src/transcripts/update-type-nested-decl-aliases.md index 03b20f6fd7..c04f01b5fe 100644 --- a/unison-src/transcripts/update-type-nested-decl-aliases.md +++ b/unison-src/transcripts/update-type-nested-decl-aliases.md @@ -17,10 +17,6 @@ scratch/main> add unique type Foo = Bar Nat Nat ``` -Bug: we want this update to be rejected earlier, because it violates the "decl coherency" precondition that there's -only one name for each constructor. We instead get too far in the update process, and are delivered a bogus scratch.u -file to stare at. - ```ucm:error scratch/main> update ``` diff --git a/unison-src/transcripts/update-type-nested-decl-aliases.output.md b/unison-src/transcripts/update-type-nested-decl-aliases.output.md index 706efd6414..96325c6404 100644 --- a/unison-src/transcripts/update-type-nested-decl-aliases.output.md +++ b/unison-src/transcripts/update-type-nested-decl-aliases.output.md @@ -48,28 +48,12 @@ unique type Foo = Bar Nat Nat type Foo ``` -Bug: we want this update to be rejected earlier, because it violates the "decl coherency" precondition that there's -only one name for each constructor. We instead get too far in the update process, and are delivered a bogus scratch.u -file to stare at. - ``` ucm scratch/main> update - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Typechecking failed. I've updated your scratch file with the - definitions that need fixing. Once the file is compiling, try - `update` again. - -``` -``` unison:added-by-ucm scratch.u -structural type A = B.OneAlias Foo - -structural type A.B = OneAlias Foo + The type A.B is an alias of A. I'm not able to perform an + update when a type exists nested under an alias of itself. + Please separate them or delete one copy, and then try updating + again. -type Foo = Bar Nat Nat ``` - diff --git a/unison-src/transcripts/update-type-stray-constructor-alias.md b/unison-src/transcripts/update-type-stray-constructor-alias.md index 8bd4ba3625..86e8a663ca 100644 --- a/unison-src/transcripts/update-type-stray-constructor-alias.md +++ b/unison-src/transcripts/update-type-stray-constructor-alias.md @@ -15,9 +15,6 @@ scratch/main> alias.term Foo.Bar Stray.BarAlias unique type Foo = Bar Nat Nat ``` -Bug: we leave `Stray.BarAlias` in the namespace with a nameless decl. - -```ucm +```ucm:error scratch/main> update -scratch/main> find.verbose ``` diff --git a/unison-src/transcripts/update-type-stray-constructor-alias.output.md b/unison-src/transcripts/update-type-stray-constructor-alias.output.md index c6f65667bf..78574abe55 100644 --- a/unison-src/transcripts/update-type-stray-constructor-alias.output.md +++ b/unison-src/transcripts/update-type-stray-constructor-alias.output.md @@ -45,27 +45,16 @@ unique type Foo = Bar Nat Nat type Foo ``` -Bug: we leave `Stray.BarAlias` in the namespace with a nameless decl. - ``` ucm scratch/main> update - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> find.verbose - - 1. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g - type Foo - - 2. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g#0 - Foo.Bar : Nat -> Nat -> Foo - - 3. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60#0 - Stray.BarAlias : Nat -> #b509v3eg4k - + Sorry, I wasn't able to perform the update, because I need all + constructor names to be nested somewhere beneath the + corresponding type name. + The constructor Stray.BarAlias is not nested beneath the + corresponding type name. Please either use `move` to move it, + or if it's an extra copy, you can simply `delete` it. Then try + the update again. ``` diff --git a/unison-src/transcripts/update-type-stray-constructor.output.md b/unison-src/transcripts/update-type-stray-constructor.output.md index 4554fd53d3..f188fb9252 100644 --- a/unison-src/transcripts/update-type-stray-constructor.output.md +++ b/unison-src/transcripts/update-type-stray-constructor.output.md @@ -56,15 +56,13 @@ scratch/main> view Foo scratch/main> update - Okay, I'm searching the branch for code that needs to be - updated... - - I couldn't complete the update because the type Foo has - unnamed constructors. (I currently need each constructor to - have a name somewhere under the type name.) + Sorry, I wasn't able to perform the update: + + The type Foo has some constructors with missing names, and I + can't perform an update in this situation. You can use `view Foo` and `alias.term Foo.` to give names to - each constructor, and then try the update again. + each unnamed constructor, and then try the update again. ``` diff --git a/unison-src/transcripts/update-type-with-dependent-term.output.md b/unison-src/transcripts/update-type-with-dependent-term.output.md index b5db3f2646..e200341bb1 100644 --- a/unison-src/transcripts/update-type-with-dependent-term.output.md +++ b/unison-src/transcripts/update-type-with-dependent-term.output.md @@ -60,9 +60,13 @@ scratch/main> update ``` ``` unison:added-by-ucm scratch.u +type Foo = Bar Nat Nat + +-- The definitions below are not compatible with the updated definitions above. +-- Please fix the errors and run `update` again. + incrFoo : Foo -> Foo incrFoo = cases Bar n -> Bar (n Nat.+ 1) -type Foo = Bar Nat Nat ``` diff --git a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md index 8ffbf3b88f..dcb3c96d24 100644 --- a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md +++ b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md @@ -58,8 +58,12 @@ scratch/main> update ``` ``` unison:added-by-ucm scratch.u +type Foo a = Bar Nat a + +-- The definitions below are not compatible with the updated definitions above. +-- Please fix the errors and run `update` again. + type Baz = Qux Foo -type Foo a = Bar Nat a ``` From 7c307e61ea43ddd9f3d970b0bc6c7b2970e31e24 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 24 Jul 2024 02:14:38 -0400 Subject: [PATCH 491/631] move some code around --- unison-cli/src/Unison/Cli/MonadUtils.hs | 18 + unison-cli/src/Unison/Cli/UpdateUtils.hs | 94 ++++- .../Codebase/Editor/HandleInput/Merge2.hs | 71 +++- .../Codebase/Editor/HandleInput/Update2.hs | 349 +----------------- .../Codebase/Editor/HandleInput/Upgrade.hs | 214 ++++++++++- 5 files changed, 383 insertions(+), 363 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index f9aaf22237..8ea64f0694 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -79,6 +79,9 @@ module Unison.Cli.MonadUtils expectLatestParsedFile, getLatestTypecheckedFile, expectLatestTypecheckedFile, + + -- * Parsing env + makeParsingEnv, ) where @@ -98,6 +101,7 @@ import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli +import Unison.Cli.UniqueTypeGuidLookup (loadUniqueTypeGuid) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch (..), Branch0) import Unison.Codebase.Branch qualified as Branch @@ -122,9 +126,11 @@ import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Reference (TypeReference) import Unison.Referent (Referent) +import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name (toText) +import Unison.Syntax.Parser (ParsingEnv (..)) import Unison.Term qualified as Term import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile) import Unison.UnisonFile qualified as UF @@ -554,3 +560,15 @@ getNamesFromLatestFile = do expectLatestTypecheckedFile :: Cli (TypecheckedUnisonFile Symbol Ann) expectLatestTypecheckedFile = getLatestTypecheckedFile & onNothingM (Cli.returnEarly Output.NoUnisonFile) + +-- @makeParsingEnv path names@ makes a parsing environment with @names@ in scope, which are all relative to @path@. +makeParsingEnv :: ProjectPath -> Names -> Cli (ParsingEnv Transaction) +makeParsingEnv path names = do + Cli.Env {generateUniqueName} <- ask + uniqueName <- liftIO generateUniqueName + pure do + ParsingEnv + { uniqueNames = uniqueName, + uniqueTypeGuid = loadUniqueTypeGuid path, + names + } diff --git a/unison-cli/src/Unison/Cli/UpdateUtils.hs b/unison-cli/src/Unison/Cli/UpdateUtils.hs index 4a1ceb90f0..25284c28fd 100644 --- a/unison-cli/src/Unison/Cli/UpdateUtils.hs +++ b/unison-cli/src/Unison/Cli/UpdateUtils.hs @@ -6,6 +6,10 @@ module Unison.Cli.UpdateUtils ( -- * Loading definitions loadNamespaceDefinitions, + -- * Getting dependents in a namespace + getNamespaceDependentsOf, + getNamespaceDependentsOf2, + -- * Narrowing definitions narrowDefns, @@ -14,12 +18,17 @@ module Unison.Cli.UpdateUtils -- * Rendering definitions renderDefnsForUnisonFile, + + -- * Parsing and typechecking + parseAndTypecheck, ) where import Control.Lens (mapped, _1) +import Control.Monad.Reader (ask) import Control.Monad.Writer (Writer) import Control.Monad.Writer qualified as Writer +import Data.Bifoldable (bifoldMap) import Data.Bitraversable (bitraverse) import Data.Foldable qualified as Foldable import Data.List qualified as List @@ -32,9 +41,15 @@ import U.Codebase.Branch qualified as V2 import U.Codebase.Causal qualified import U.Codebase.Reference (TermReferenceId, TypeReferenceId) import U.Codebase.Referent qualified as V2 +import U.Codebase.Sqlite.Operations qualified as Operations import Unison.Builtin.Decls qualified as Builtin.Decls +import Unison.Cli.Monad (Cli, Env (..)) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) import Unison.DataDeclaration (Decl) +import Unison.Debug qualified as Debug +import Unison.FileParsers qualified as FileParsers import Unison.Hash (Hash) import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' @@ -43,18 +58,25 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment +import Unison.Parser.Ann (Ann) +import Unison.Parsers qualified as Parsers import Unison.Prelude import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) -import Unison.Reference (TypeReference) +import Unison.Reference (Reference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent +import Unison.Result qualified as Result +import Unison.Sqlite (Transaction) +import Unison.Symbol (Symbol) import Unison.Syntax.DeclPrinter (AccessorName) import Unison.Syntax.DeclPrinter qualified as DeclPrinter +import Unison.Syntax.Parser qualified as Parser import Unison.Syntax.TermPrinter qualified as TermPrinter import Unison.Term (Term) import Unison.Type (Type) import Unison.Typechecker qualified as Typechecker +import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Conflicted (Conflicted (..)) @@ -65,8 +87,11 @@ import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Relation +import Unison.Util.Set qualified as Set import Unison.Var (Var) import Prelude hiding (unzip, zip, zipWith) +import Unison.Names (Names) +import qualified Unison.Names as Names ------------------------------------------------------------------------------------------------------------------------ -- Loading definitions @@ -124,6 +149,50 @@ assertNamespaceHasNoConflictedNames = | Set.NonEmpty.size refs == 1 = Right (Set.NonEmpty.findMin refs) | otherwise = Left (conflicted refs) +------------------------------------------------------------------------------------------------------------------------ +-- Getting dependents in a namespace + +-- | Given a namespace and a set of dependencies, return the subset of the namespace that consists of only the +-- (transitive) dependents of the dependencies. +getNamespaceDependentsOf :: + Names -> + Set Reference -> + Transaction (DefnsF (Relation Name) TermReferenceId TypeReferenceId) +getNamespaceDependentsOf names dependencies = do + dependents <- Operations.transitiveDependentsWithinScope (Names.referenceIds names) dependencies + pure (bimap (foldMap nameTerm) (foldMap nameType) dependents) + where + nameTerm :: TermReferenceId -> Relation Name TermReferenceId + nameTerm ref = + Relation.fromManyDom (Relation.lookupRan (Referent.fromTermReferenceId ref) (Names.terms names)) ref + + nameType :: TypeReferenceId -> Relation Name TypeReferenceId + nameType ref = + Relation.fromManyDom (Relation.lookupRan (Reference.fromId ref) (Names.types names)) ref + +-- | Given a namespace and a set of dependencies, return the subset of the namespace that consists of only the +-- (transitive) dependents of the dependencies. +getNamespaceDependentsOf2 :: + Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> + Set Reference -> + Transaction (DefnsF (Map Name) TermReferenceId TypeReferenceId) +getNamespaceDependentsOf2 defns dependencies = do + let toTermScope = Set.mapMaybe Referent.toReferenceId . BiMultimap.dom + let toTypeScope = Set.mapMaybe Reference.toId . BiMultimap.dom + let scope = bifoldMap toTermScope toTypeScope defns + Operations.transitiveDependentsWithinScope scope dependencies + <&> bimap (Set.foldl' addTerms Map.empty) (Set.foldl' addTypes Map.empty) + where + addTerms :: Map Name TermReferenceId -> TermReferenceId -> Map Name TermReferenceId + addTerms acc0 ref = + let names = BiMultimap.lookupDom (Referent.fromTermReferenceId ref) defns.terms + in Set.foldl' (\acc name -> Map.insert name ref acc) acc0 names + + addTypes :: Map Name TypeReferenceId -> TypeReferenceId -> Map Name TypeReferenceId + addTypes acc0 ref = + let names = BiMultimap.lookupDom (Reference.fromId ref) defns.types + in Set.foldl' (\acc name -> Map.insert name ref acc) acc0 names + ------------------------------------------------------------------------------------------------------------------------ -- Narrowing definitions @@ -269,3 +338,26 @@ setPpedToConstructorNames declNameLookup name ref = Nothing -> [] Just conName -> let hqConName = HQ'.NameOnly conName in [(hqConName, hqConName)] Referent.Ref _ -> [] + +------------------------------------------------------------------------------------------------------------------------ +-- Parsing and typechecking + +-- TODO: find a better module for this function, as it's used in a couple places +parseAndTypecheck :: + Pretty Pretty.ColorText -> + Parser.ParsingEnv Transaction -> + Cli (Maybe (TypecheckedUnisonFile Symbol Ann)) +parseAndTypecheck prettyUf parsingEnv = do + env <- ask + let stringUf = Pretty.toPlain 80 prettyUf + Debug.whenDebug Debug.Update do + liftIO do + putStrLn "--- Scratch ---" + putStrLn stringUf + Cli.runTransaction do + Parsers.parseFile "" stringUf parsingEnv >>= \case + Left _ -> pure Nothing + Right uf -> do + typecheckingEnv <- + computeTypecheckingEnvironment (FileParsers.ShouldUseTndr'Yes parsingEnv) env.codebase [] uf + pure (Result.result (FileParsers.synthesizeFile typecheckingEnv uf)) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 45c7b3834e..19dae57b86 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -21,7 +21,7 @@ import Data.Bitraversable (bitraverse) import Data.Foldable qualified as Foldable import Data.List qualified as List import Data.Map.Strict qualified as Map -import Data.Semialign (align, unzip) +import Data.Semialign (align, unzip, zipWith) import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.IO qualified as Text @@ -44,19 +44,20 @@ 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.UpdateUtils (hydrateDefns, loadNamespaceDefinitions, renderDefnsForUnisonFile) +import Unison.Cli.UpdateUtils + ( getNamespaceDependentsOf2, + hydrateDefns, + loadNamespaceDefinitions, + parseAndTypecheck, + renderDefnsForUnisonFile, + ) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.BranchUtil qualified as BranchUtil import Unison.Codebase.Editor.HandleInput.Branch qualified as HandleInput.Branch -import Unison.Codebase.Editor.HandleInput.Update2 - ( getNamespaceDependentsOf2, - makeParsingEnv, - prettyParseTypecheck2, - typecheckedUnisonFileToBranchAdds, - ) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Editor.RemoteRepo (ReadShareLooseCode (..)) import Unison.Codebase.Path (Path) @@ -66,6 +67,8 @@ import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache) import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions import Unison.Codebase.SqliteCodebase.Operations qualified as Operations +import Unison.DataDeclaration (Decl) +import Unison.DataDeclaration qualified as DataDeclaration import Unison.Debug qualified as Debug import Unison.Hash qualified as Hash import Unison.Merge.CombineDiffs (CombinedDiffOp (..), combineDiffs) @@ -97,18 +100,29 @@ import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.NameSegment.Internal qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names +import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.PrettyPrintEnvDecl.Names qualified as PPED -import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectBranchNameKind (..), ProjectName, Semver (..), classifyProjectBranchName) +import Unison.Project + ( ProjectAndBranch (..), + ProjectBranchName, + ProjectBranchNameKind (..), + ProjectName, + Semver (..), + classifyProjectBranchName, + ) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.ReferentPrime qualified as Referent' import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite +import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name +import Unison.UnisonFile (TypecheckedUnisonFile) +import Unison.UnisonFile qualified as UnisonFile import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3, alignDefnsWith, defnsAreEmpty, zipDefnsWith, zipDefnsWith3) @@ -120,6 +134,7 @@ import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Relation import Unison.Util.Star2 (Star2) import Unison.Util.Star2 qualified as Star2 +import Unison.WatchKind qualified as WatchKind import Witch (unsafeFrom) import Prelude hiding (unzip, zip, zipWith) @@ -356,8 +371,8 @@ doMerge info = do then pure Nothing else do currentPath <- Cli.getCurrentProjectPath - parsingEnv <- makeParsingEnv currentPath (Branch.toNames stageOneBranch) - prettyParseTypecheck2 prettyUnisonFile parsingEnv <&> eitherToMaybe + parsingEnv <- Cli.makeParsingEnv currentPath (Branch.toNames stageOneBranch) + parseAndTypecheck prettyUnisonFile parsingEnv let parents = (\causal -> (causal.causalHash, Codebase.expectBranchForHash codebase causal.causalHash)) <$> causals @@ -857,6 +872,40 @@ libdepsToBranch0 db libdeps = do branchCache <- Sqlite.unsafeIO newBranchCache Conversions.branch2to1 branchCache db.loadDeclType branch +typecheckedUnisonFileToBranchAdds :: TypecheckedUnisonFile Symbol Ann -> [(Path, Branch0 m -> Branch0 m)] +typecheckedUnisonFileToBranchAdds tuf = do + declAdds ++ termAdds + where + declAdds :: [(Path, Branch0 m -> Branch0 m)] + declAdds = do + foldMap makeDataDeclAdds (Map.toList (UnisonFile.dataDeclarationsId' tuf)) + ++ foldMap makeEffectDeclUpdates (Map.toList (UnisonFile.effectDeclarationsId' tuf)) + where + makeDataDeclAdds (symbol, (typeRefId, dataDecl)) = makeDeclAdds (symbol, (typeRefId, Right dataDecl)) + makeEffectDeclUpdates (symbol, (typeRefId, effectDecl)) = makeDeclAdds (symbol, (typeRefId, Left effectDecl)) + + makeDeclAdds :: (Symbol, (TypeReferenceId, Decl Symbol Ann)) -> [(Path, Branch0 m -> Branch0 m)] + makeDeclAdds (symbol, (typeRefId, decl)) = + let insertTypeAction = BranchUtil.makeAddTypeName (splitVar symbol) (Reference.fromId typeRefId) + insertTypeConstructorActions = + zipWith + (\sym rid -> BranchUtil.makeAddTermName (splitVar sym) (Reference.fromId <$> rid)) + (DataDeclaration.constructorVars (DataDeclaration.asDataDecl decl)) + (DataDeclaration.declConstructorReferents typeRefId decl) + in insertTypeAction : insertTypeConstructorActions + + termAdds :: [(Path, Branch0 m -> Branch0 m)] + termAdds = + tuf + & UnisonFile.hashTermsId + & Map.toList + & mapMaybe \(var, (_, ref, wk, _, _)) -> do + guard (WatchKind.watchKindShouldBeStoredInDatabase wk) + Just (BranchUtil.makeAddTermName (splitVar var) (Referent.fromTermReferenceId ref)) + + splitVar :: Symbol -> Path.Split + splitVar = Path.splitFromName . Name.unsafeParseVar + ------------------------------------------------------------------------------------------------------------------------ -- Debugging by printing a bunch of stuff out diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index d62b9b1dd7..4268e5e616 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -3,45 +3,30 @@ module Unison.Codebase.Editor.HandleInput.Update2 ( handleUpdate2, -- * Misc helpers to be organized later - addDefinitionsToUnisonFile, - findCtorNames, - findCtorNamesMaybe, - forwardCtorNames, - makeParsingEnv, - prettyParseTypecheck, - prettyParseTypecheck2, typecheckedUnisonFileToBranchUpdates, - typecheckedUnisonFileToBranchAdds, - getNamespaceDependentsOf, - getNamespaceDependentsOf2, ) where -import Control.Lens qualified as Lens import Control.Monad.RWS (ask) import Data.Bifoldable (bifoldMap) -import Data.Foldable qualified as Foldable import Data.List qualified as List -import Data.List.NonEmpty qualified as NonEmpty -import Data.List.NonEmpty.Extra ((|>)) import Data.Map qualified as Map -import Data.Maybe (fromJust) import Data.Set qualified as Set import Data.Text qualified as Text -import Data.Text.Lazy qualified as Lazy.Text -import Text.Pretty.Simple (pShow) import U.Codebase.Reference (Reference, TermReferenceId) import U.Codebase.Reference qualified as Reference import U.Codebase.Sqlite.Operations qualified as Operations -import U.Codebase.Sqlite.Operations qualified as Ops -import Unison.Builtin.Decls qualified as Decls import Unison.Cli.Monad (Cli, Env (..)) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.Pretty qualified as Pretty -import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) -import Unison.Cli.UniqueTypeGuidLookup qualified as Cli -import Unison.Cli.UpdateUtils (hydrateDefns, narrowDefns, renderDefnsForUnisonFile) +import Unison.Cli.UpdateUtils + ( getNamespaceDependentsOf2, + hydrateDefns, + narrowDefns, + parseAndTypecheck, + renderDefnsForUnisonFile, + ) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch @@ -51,29 +36,15 @@ import Unison.Codebase.Editor.Output (Output) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path -import Unison.Codebase.ProjectPath (ProjectPath) import Unison.Codebase.SqliteCodebase.Operations qualified as Operations -import Unison.Codebase.Type (Codebase) -import Unison.ConstructorReference (GConstructorReference (ConstructorReference)) -import Unison.DataDeclaration (DataDeclaration, Decl) -import Unison.DataDeclaration qualified as DataDeclaration +import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as Decl -import Unison.DataDeclaration.ConstructorId (ConstructorId) -import Unison.Debug qualified as Debug -import Unison.FileParsers qualified as FileParsers -import Unison.Hash (Hash) import Unison.Merge.DeclCoherencyCheck (checkDeclCoherency) import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) import Unison.Name (Name) -import Unison.Name qualified as Name -import Unison.Name.Forward (ForwardName (..)) -import Unison.Name.Forward qualified as ForwardName -import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) -import Unison.Parser.Ann qualified as Ann -import Unison.Parsers qualified as Parsers import Unison.Prelude import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl) @@ -81,30 +52,19 @@ import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference (TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference (fromId) -import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Unison.Result qualified as Result import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name -import Unison.Syntax.Parser qualified as Parser -import Unison.Term (Term) -import Unison.Type (Type) -import Unison.Typechecker qualified as Typechecker -import Unison.UnisonFile (UnisonFile) import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF import Unison.UnisonFile.Type (TypecheckedUnisonFile) -import Unison.Util.BiMultimap (BiMultimap) -import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty) import Unison.Util.Monoid qualified as Monoid import Unison.Util.Nametree (flattenNametrees) import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pretty -import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Relation -import Unison.Util.Set qualified as Set import Unison.Var (Var) import Unison.WatchKind qualified as WK @@ -117,7 +77,6 @@ handleUpdate2 = do currentBranch0 <- Cli.getCurrentBranch0 let currentBranch0ExcludingLibdeps = Branch.deleteLibdeps currentBranch0 let namesIncludingLibdeps = Branch.toNames currentBranch0 - let namesExcludingLibdeps = Branch.toNames currentBranch0ExcludingLibdeps -- Assert that the namespace doesn't have any conflicted names defns <- @@ -143,7 +102,7 @@ handleUpdate2 = do dependents0 <- getNamespaceDependentsOf2 (flattenNametrees defns) - (getExistingReferencesNamed termAndDeclNames namesExcludingLibdeps) + (getExistingReferencesNamed termAndDeclNames (Branch.toNames currentBranch0ExcludingLibdeps)) -- Throw away the dependents that are shadowed by the file itself let dependents1 :: DefnsF (Map Name) TermReferenceId TypeReferenceId @@ -175,19 +134,18 @@ handleUpdate2 = do (Pretty.prettyUnisonFile ppe (UF.discardTypes tuf)) (renderDefnsForUnisonFile declNameLookup ppe hydratedDependents) - parsingEnv <- makeParsingEnv pp namesIncludingLibdeps + parsingEnv <- Cli.makeParsingEnv pp namesIncludingLibdeps secondTuf <- - prettyParseTypecheck2 prettyUnisonFile parsingEnv & onLeftM \prettyUf -> do + parseAndTypecheck prettyUnisonFile parsingEnv & onNothingM do scratchFilePath <- fst <$> Cli.expectLatestFile - liftIO $ env.writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUf) + liftIO $ env.writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) Cli.returnEarly Output.UpdateTypecheckingFailure Cli.respond Output.UpdateTypecheckingSuccess pure secondTuf - env <- ask path <- Cli.getCurrentProjectPath branchUpdates <- Cli.runTransactionWithRollback \abort -> do @@ -221,49 +179,6 @@ makePrettyUnisonFile originalFile dependents = where f = map snd . List.sortOn (Name.toText . fst) . Map.toList --- TODO: find a better module for this function, as it's used in a couple places -prettyParseTypecheck :: - UnisonFile Symbol Ann -> - PrettyPrintEnvDecl -> - Parser.ParsingEnv Transaction -> - Cli (Either (Pretty Pretty.ColorText) (TypecheckedUnisonFile Symbol Ann)) -prettyParseTypecheck bigUf pped = - prettyParseTypecheck2 (Pretty.prettyUnisonFile pped bigUf) - --- TODO: find a better module for this function, as it's used in a couple places -prettyParseTypecheck2 :: - Pretty Pretty.ColorText -> - Parser.ParsingEnv Transaction -> - Cli (Either (Pretty Pretty.ColorText) (TypecheckedUnisonFile Symbol Ann)) -prettyParseTypecheck2 prettyUf parsingEnv = do - Cli.Env {codebase} <- ask - let stringUf = Pretty.toPlain 80 prettyUf - Debug.whenDebug Debug.Update do - liftIO do - putStrLn "--- Scratch ---" - putStrLn stringUf - Cli.runTransaction do - Parsers.parseFile "" stringUf parsingEnv >>= \case - Left {} -> pure $ Left prettyUf - Right reparsedUf -> do - typecheckingEnv <- - computeTypecheckingEnvironment (FileParsers.ShouldUseTndr'Yes parsingEnv) codebase [] reparsedUf - pure case FileParsers.synthesizeFile typecheckingEnv reparsedUf of - Result.Result _notes (Just reparsedTuf) -> Right reparsedTuf - Result.Result _notes Nothing -> Left prettyUf - --- @makeParsingEnv path names@ makes a parsing environment with @names@ in scope, which are all relative to @path@. -makeParsingEnv :: ProjectPath -> Names -> Cli (Parser.ParsingEnv Transaction) -makeParsingEnv path names = do - Cli.Env {generateUniqueName} <- ask - uniqueName <- liftIO generateUniqueName - pure do - Parser.ParsingEnv - { uniqueNames = uniqueName, - uniqueTypeGuid = Cli.loadUniqueTypeGuid path, - names - } - -- @typecheckedUnisonFileToBranchUpdates getConstructors file@ returns a list of branch updates (suitable for passing -- along to `batchUpdates` or some "step at" combinator) that corresponds to using all of the contents of @file@. -- `getConstructors` returns the full constructor names of a decl, e.g. "Maybe" -> ["Maybe.Nothing", "Maybe.Just"] @@ -337,40 +252,6 @@ typecheckedUnisonFileToBranchUpdates abort getConstructors tuf = do splitVar :: Symbol -> Path.Split splitVar = Path.splitFromName . Name.unsafeParseVar -typecheckedUnisonFileToBranchAdds :: TypecheckedUnisonFile Symbol Ann -> [(Path, Branch0 m -> Branch0 m)] -typecheckedUnisonFileToBranchAdds tuf = do - declAdds ++ termAdds - where - declAdds :: [(Path, Branch0 m -> Branch0 m)] - declAdds = do - foldMap makeDataDeclAdds (Map.toList $ UF.dataDeclarationsId' tuf) - ++ foldMap makeEffectDeclUpdates (Map.toList $ UF.effectDeclarationsId' tuf) - where - makeDataDeclAdds (symbol, (typeRefId, dataDecl)) = makeDeclAdds (symbol, (typeRefId, Right dataDecl)) - makeEffectDeclUpdates (symbol, (typeRefId, effectDecl)) = makeDeclAdds (symbol, (typeRefId, Left effectDecl)) - - makeDeclAdds :: (Symbol, (TypeReferenceId, Decl Symbol Ann)) -> [(Path, Branch0 m -> Branch0 m)] - makeDeclAdds (symbol, (typeRefId, decl)) = - let insertTypeAction = BranchUtil.makeAddTypeName (splitVar symbol) (Reference.fromId typeRefId) - insertTypeConstructorActions = - zipWith - (\sym rid -> BranchUtil.makeAddTermName (splitVar sym) (Reference.fromId <$> rid)) - (Decl.constructorVars (Decl.asDataDecl decl)) - (Decl.declConstructorReferents typeRefId decl) - in insertTypeAction : insertTypeConstructorActions - - termAdds :: [(Path, Branch0 m -> Branch0 m)] - termAdds = - tuf - & UF.hashTermsId - & Map.toList - & mapMaybe \(var, (_, ref, wk, _, _)) -> do - guard (WK.watchKindShouldBeStoredInDatabase wk) - Just (BranchUtil.makeAddTermName (splitVar var) (Referent.fromTermReferenceId ref)) - - splitVar :: Symbol -> Path.Split - splitVar = Path.splitFromName . Name.unsafeParseVar - -- | get references from `names` that have the same names as in `defns` -- For constructors, we get the type reference. getExistingReferencesNamed :: DefnsF Set Name Name -> Names -> Set Reference @@ -387,165 +268,6 @@ getExistingReferencesNamed defns names = foldMap \name -> Relation.lookupDom name (Names.types names) -makeUnisonFile :: - (forall void. Output -> Transaction void) -> - Codebase IO Symbol Ann -> - (Maybe Int -> Name -> Either Output.Output [Name]) -> - DefnsF (Relation Name) TermReferenceId TypeReferenceId -> - Transaction (UnisonFile Symbol Ann) -makeUnisonFile abort codebase doFindCtorNames defns = do - file <- foldM addTermComponent UF.emptyUnisonFile (Set.map Reference.idToHash (Relation.ran defns.terms)) - foldM addDeclComponent file (Set.map Reference.idToHash (Relation.ran defns.types)) - where - addTermComponent :: UnisonFile Symbol Ann -> Hash -> Transaction (UnisonFile Symbol Ann) - addTermComponent uf h = do - termComponent <- Codebase.unsafeGetTermComponent codebase h - pure $ foldl' addTermElement uf (zip termComponent [0 ..]) - where - addTermElement :: UnisonFile Symbol Ann -> ((Term Symbol Ann, Type Symbol Ann), Reference.Pos) -> UnisonFile Symbol Ann - addTermElement uf ((tm, tp), i) = do - let termNames = Relation.lookupRan (Reference.Id h i) defns.terms - foldl' (addDefinition tm tp) uf termNames - addDefinition :: Term Symbol Ann -> Type Symbol Ann -> UnisonFile Symbol Ann -> Name -> UnisonFile Symbol Ann - addDefinition tm tp uf (Name.toVar -> v) = - let prependTerm to = (v, Ann.External, tm) : to - in if isTest tp - then uf & #watches . Lens.at WK.TestWatch . Lens.non [] Lens.%~ prependTerm - else uf & #terms Lens.%~ Map.insert v (Ann.External, tm) - - isTest = Typechecker.isEqual (Decls.testResultListType mempty) - - -- given a dependent hash, include that component in the scratch file - -- todo: wundefined: cut off constructor name prefixes - addDeclComponent :: UnisonFile Symbol Ann -> Hash -> Transaction (UnisonFile Symbol Ann) - addDeclComponent uf h = do - declComponent <- fromJust <$> Codebase.getDeclComponent h - foldM addDeclElement uf (zip declComponent [0 ..]) - where - -- for each name a decl has, update its constructor names according to what exists in the namespace - addDeclElement :: UnisonFile Symbol Ann -> (Decl Symbol Ann, Reference.Pos) -> Transaction (UnisonFile Symbol Ann) - addDeclElement uf (decl, i) = do - let declNames = Relation.lookupRan (Reference.Id h i) defns.types - -- look up names for this decl's constructor based on the decl's name, and embed them in the decl definition. - foldM (addRebuiltDefinition decl) uf declNames - where - -- skip any definitions that already have names, we don't want to overwrite what the user has supplied - addRebuiltDefinition :: Decl Symbol Ann -> UnisonFile Symbol Ann -> Name -> Transaction (UnisonFile Symbol Ann) - addRebuiltDefinition decl uf name = case decl of - Left ed -> - overwriteConstructorNames name ed.toDataDecl <&> \ed' -> - uf - & #effectDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') - Right dd -> - overwriteConstructorNames name dd <&> \dd' -> - uf - & #dataDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') - - -- Constructor names are bogus when pulled from the database, so we set them to what they should be here - overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann) - overwriteConstructorNames name dd = - let constructorNames :: Transaction [Symbol] - constructorNames = - case doFindCtorNames (Just $ Decl.constructorCount dd) name of - Left err -> abort err - Right array | all (isJust . Name.stripNamePrefix name) array -> pure (map Name.toVar array) - Right array -> do - traceM "I ran into a situation where a type's constructors didn't match its name," - traceM "in a spot where I didn't expect to be discovering that.\n\n" - traceM "Type Name:" - traceM . Lazy.Text.unpack $ pShow name - traceM "Constructor Names:" - traceM . Lazy.Text.unpack $ pShow array - error "Sorry for crashing." - - swapConstructorNames oldCtors = - let (annotations, _vars, types) = unzip3 oldCtors - in zip3 annotations <$> constructorNames <*> pure types - in Lens.traverseOf Decl.constructors_ swapConstructorNames dd - --- | @addDefinitionsToUnisonFile abort codebase doFindCtorNames definitions file@ adds all @definitions@ to @file@, --- avoiding overwriting anything already in @file@. Every definition is put into the file with every naming it has in --- @names@ "on the left-hand-side of the equals" (but yes type decls don't really have a LHS). --- --- TODO: find a better module for this function, as it's used in a couple places -addDefinitionsToUnisonFile :: - (forall void. Output -> Transaction void) -> - Codebase IO Symbol Ann -> - (Maybe Int -> Name -> Either Output.Output [Name]) -> - DefnsF (Relation Name) TermReferenceId TypeReferenceId -> - UnisonFile Symbol Ann -> - Transaction (UnisonFile Symbol Ann) -addDefinitionsToUnisonFile abort codebase doFindCtorNames newDefns oldUF = do - newUF <- makeUnisonFile abort codebase doFindCtorNames newDefns - pure (oldUF `UF.leftBiasedMerge` newUF) - --- | O(r + c * d) touches all the referents (r), and all the NameSegments (d) of all of the Con referents (c) -forwardCtorNames :: Names -> Map ForwardName (Referent, Name) -forwardCtorNames names = - Map.fromList $ - [ (ForwardName.fromName name, (r, name)) - | (r@Referent.Con {}, rNames) <- Map.toList $ Relation.range names.terms, - name <- Foldable.toList rNames - ] - --- | given a decl name, find names for all of its constructors, in order. --- --- Precondition: 'n' is an element of 'names' -findCtorNames :: Output.UpdateOrUpgrade -> Names -> Map ForwardName (Referent, Name) -> Maybe Int -> Name -> Either Output.Output [Name] -findCtorNames operation names forwardCtorNames ctorCount n = - let declRef = case Set.lookupMin (Relation.lookupDom n names.types) of - Nothing -> error "[findCtorNames] precondition violation: n is not an element of names" - Just x -> x - f = ForwardName.fromName n - (_, centerRight) = Map.split f forwardCtorNames - (center, _) = Map.split (incrementLastSegmentChar f) centerRight - - insertShortest :: Map ConstructorId Name -> (Referent, Name) -> Map ConstructorId Name - insertShortest m (Referent.Con (ConstructorReference r cid) _ct, newName) | r == declRef = - case Map.lookup cid m of - Just existingName - | length (Name.segments existingName) > length (Name.segments newName) -> - Map.insert cid newName m - Just {} -> m - Nothing -> Map.insert cid newName m - insertShortest m _ = m - m = foldl' insertShortest mempty (Foldable.toList center) - ctorCountGuess = fromMaybe (Map.size m) ctorCount - in if Map.size m == ctorCountGuess && all (isJust . flip Map.lookup m . fromIntegral) [0 .. ctorCountGuess - 1] - then Right $ Map.elems m - else Left $ Output.UpdateIncompleteConstructorSet operation n m ctorCount - -findCtorNamesMaybe :: - Output.UpdateOrUpgrade -> - Names -> - Map ForwardName (Referent, Name) -> - Maybe Int -> - Name -> - Either Output.Output (Maybe [Name]) -findCtorNamesMaybe operation names forwardCtorNames ctorCount name = - case Relation.memberDom name (Names.types names) of - True -> Just <$> findCtorNames operation names forwardCtorNames ctorCount name - False -> Right Nothing - --- Used by `findCtorNames` to filter `forwardCtorNames` to a narrow range which will be searched linearly. --- >>> incrementLastSegmentChar $ ForwardName.fromName $ Name.unsafeFromText "foo.bar.quux" --- ForwardName {toList = "foo" :| ["bar","quuy"]} -incrementLastSegmentChar :: ForwardName -> ForwardName -incrementLastSegmentChar (ForwardName segments) = - let (initSegments, lastSegment) = (NonEmpty.init segments, NonEmpty.last segments) - incrementedLastSegment = incrementLastCharInSegment lastSegment - in ForwardName $ maybe (NonEmpty.singleton incrementedLastSegment) (|> incrementedLastSegment) (NonEmpty.nonEmpty initSegments) - where - incrementLastCharInSegment :: NameSegment -> NameSegment - incrementLastCharInSegment (NameSegment text) = - let incrementedText = - if Text.null text - then text - else Text.init text `Text.append` Text.singleton (succ $ Text.last text) - in NameSegment incrementedText - -- @getTermAndDeclNames file@ returns the names of the terms and decls defined in a typechecked Unison file. getTermAndDeclNames :: (Var v) => TypecheckedUnisonFile v a -> DefnsF Set Name Name getTermAndDeclNames tuf = @@ -564,53 +286,6 @@ getTermAndDeclNames tuf = keysToNames = Set.map Name.unsafeParseVar . Map.keysSet ctorsToNames = Set.fromList . map Name.unsafeParseVar . Decl.constructorVars --- | Given a namespace and a set of dependencies, return the subset of the namespace that consists of only the --- (transitive) dependents of the dependencies. -getNamespaceDependentsOf :: - Names -> - Set Reference -> - Transaction (DefnsF (Relation Name) TermReferenceId TypeReferenceId) -getNamespaceDependentsOf names dependencies = do - dependents <- Ops.transitiveDependentsWithinScope (Names.referenceIds names) dependencies - pure (bimap (foldMap nameTerm) (foldMap nameType) dependents) - where - nameTerm :: TermReferenceId -> Relation Name TermReferenceId - nameTerm ref = - Relation.fromManyDom (Relation.lookupRan (Referent.fromTermReferenceId ref) (Names.terms names)) ref - - nameType :: TypeReferenceId -> Relation Name TypeReferenceId - nameType ref = - Relation.fromManyDom (Relation.lookupRan (Reference.fromId ref) (Names.types names)) ref - --- | A better version of the above that operates on BiMultimaps rather than Relations. -getNamespaceDependentsOf2 :: - Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> - Set Reference -> - Transaction (DefnsF (Map Name) TermReferenceId TypeReferenceId) -getNamespaceDependentsOf2 defns dependencies = do - let toTermScope = Set.mapMaybe Referent.toReferenceId . BiMultimap.dom - let toTypeScope = Set.mapMaybe Reference.toId . BiMultimap.dom - let scope = bifoldMap toTermScope toTypeScope defns - - dependents <- - Ops.transitiveDependentsWithinScope scope dependencies - - pure - Defns - { terms = Set.foldl' addTerms Map.empty dependents.terms, - types = Set.foldl' addTypes Map.empty dependents.types - } - where - addTerms :: Map Name TermReferenceId -> TermReferenceId -> Map Name TermReferenceId - addTerms acc0 ref = - let names = BiMultimap.lookupDom (Referent.fromTermReferenceId ref) defns.terms - in Set.foldl' (\acc name -> Map.insert name ref acc) acc0 names - - addTypes :: Map Name TypeReferenceId -> TypeReferenceId -> Map Name TypeReferenceId - addTypes acc0 ref = - let names = BiMultimap.lookupDom (Reference.fromId ref) defns.types - in Set.foldl' (\acc name -> Map.insert name ref acc) acc0 names - -- The big picture behind PPE building, though there are many details: -- -- * We are updating old references to new references by rendering old references as names that are then parsed diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index 7d2f1aa003..7a391c99f7 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -4,43 +4,56 @@ module Unison.Codebase.Editor.HandleInput.Upgrade ) where +import Control.Lens qualified as Lens import Control.Monad.Reader (ask) import Data.Char qualified as Char +import Data.Foldable qualified as Foldable import Data.List.NonEmpty (pattern (:|)) +import Data.List.NonEmpty qualified as List.NonEmpty +import Data.List.NonEmpty.Extra ((|>)) import Data.Map.Strict qualified as Map +import Data.Maybe (fromJust) import Data.Set qualified as Set import Data.Text qualified as Text +import Data.Text.Lazy qualified as Text.Lazy import Text.Builder qualified +import Text.Pretty.Simple (pShow) import U.Codebase.Sqlite.DbId (ProjectId) +import Unison.Builtin.Decls qualified as Decls import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.Pretty qualified as Pretty import Unison.Cli.ProjectUtils qualified as Cli +import Unison.Cli.UpdateUtils (getNamespaceDependentsOf, parseAndTypecheck) +import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.HandleInput.Branch (CreateFrom (..)) import Unison.Codebase.Editor.HandleInput.Branch qualified as HandleInput.Branch -import Unison.Codebase.Editor.HandleInput.Update2 - ( addDefinitionsToUnisonFile, - findCtorNames, - findCtorNamesMaybe, - forwardCtorNames, - getNamespaceDependentsOf, - makeParsingEnv, - prettyParseTypecheck, - typecheckedUnisonFileToBranchUpdates, - ) +import Unison.Codebase.Editor.HandleInput.Update2 (typecheckedUnisonFileToBranchUpdates) +import Unison.Codebase.Editor.Output (Output) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP +import Unison.ConstructorReference (GConstructorReference (..)) +import Unison.DataDeclaration (DataDeclaration, Decl) +import Unison.DataDeclaration qualified as Decl +import Unison.DataDeclaration.ConstructorId (ConstructorId) +import Unison.Hash (Hash) import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name +import Unison.Name.Forward (ForwardName (..)) +import Unison.Name.Forward qualified as ForwardName import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment +import Unison.NameSegment.Internal (NameSegment (NameSegment)) import Unison.Names (Names (..)) import Unison.Names qualified as Names +import Unison.Parser.Ann (Ann) +import Unison.Parser.Ann qualified as Ann import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnv.Names qualified as PPE @@ -48,16 +61,25 @@ import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.PrettyPrintEnvDecl qualified as PPED (addFallback) import Unison.PrettyPrintEnvDecl.Names qualified as PPED (makeCodebasePPED, makeFilePPED) import Unison.Project (ProjectBranchName) -import Unison.Reference (TermReference, TypeReference) +import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId) +import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Sqlite (Transaction) +import Unison.Symbol (Symbol) +import Unison.Syntax.Name qualified as Name import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText) +import Unison.Term (Term) +import Unison.Type (Type) +import Unison.Typechecker qualified as Typechecker +import Unison.UnisonFile (UnisonFile) import Unison.UnisonFile qualified as UnisonFile +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Relation import Unison.Util.Set qualified as Set +import Unison.WatchKind qualified as WK import Witch (unsafeFrom) handleUpgrade :: NameSegment -> NameSegment -> Cli () @@ -152,9 +174,10 @@ handleUpgrade oldName newName = do ) pp@(PP.ProjectPath project projectBranch _path) <- Cli.getCurrentProjectPath - parsingEnv <- makeParsingEnv pp currentDeepNamesSansOld - typecheckedUnisonFile <- - prettyParseTypecheck unisonFile printPPE parsingEnv & onLeftM \prettyUnisonFile -> do + parsingEnv <- Cli.makeParsingEnv pp currentDeepNamesSansOld + typecheckedUnisonFile <- do + let prettyUnisonFile = Pretty.prettyUnisonFile printPPE unisonFile + parseAndTypecheck prettyUnisonFile parsingEnv & onNothingM do let getTemporaryBranchName = findTemporaryBranchName (project ^. #projectId) oldName newName (_temporaryBranchId, temporaryBranchName) <- HandleInput.Branch.createBranch @@ -212,6 +235,100 @@ keepOldDeepTypesStillInUse oldDeepMinusLocalTypes currentDeepTypesSansOld = Relation.dom oldDeepMinusLocalTypes & Set.filter \typ -> not (Relation.memberDom typ currentDeepTypesSansOld) +-- | @addDefinitionsToUnisonFile abort codebase doFindCtorNames definitions file@ adds all @definitions@ to @file@, +-- avoiding overwriting anything already in @file@. Every definition is put into the file with every naming it has in +-- @names@ "on the left-hand-side of the equals" (but yes type decls don't really have a LHS). +-- +-- TODO: find a better module for this function, as it's used in a couple places +addDefinitionsToUnisonFile :: + (forall void. Output -> Transaction void) -> + Codebase IO Symbol Ann -> + (Maybe Int -> Name -> Either Output.Output [Name]) -> + DefnsF (Relation Name) TermReferenceId TypeReferenceId -> + UnisonFile Symbol Ann -> + Transaction (UnisonFile Symbol Ann) +addDefinitionsToUnisonFile abort codebase doFindCtorNames newDefns oldUF = do + newUF <- makeUnisonFile abort codebase doFindCtorNames newDefns + pure (oldUF `UnisonFile.leftBiasedMerge` newUF) + +makeUnisonFile :: + (forall void. Output -> Transaction void) -> + Codebase IO Symbol Ann -> + (Maybe Int -> Name -> Either Output.Output [Name]) -> + DefnsF (Relation Name) TermReferenceId TypeReferenceId -> + Transaction (UnisonFile Symbol Ann) +makeUnisonFile abort codebase doFindCtorNames defns = do + file <- foldM addTermComponent UnisonFile.emptyUnisonFile (Set.map Reference.idToHash (Relation.ran defns.terms)) + foldM addDeclComponent file (Set.map Reference.idToHash (Relation.ran defns.types)) + where + addTermComponent :: UnisonFile Symbol Ann -> Hash -> Transaction (UnisonFile Symbol Ann) + addTermComponent uf h = do + termComponent <- Codebase.unsafeGetTermComponent codebase h + pure $ foldl' addTermElement uf (zip termComponent [0 ..]) + where + addTermElement :: UnisonFile Symbol Ann -> ((Term Symbol Ann, Type Symbol Ann), Reference.Pos) -> UnisonFile Symbol Ann + addTermElement uf ((tm, tp), i) = do + let termNames = Relation.lookupRan (Reference.Id h i) defns.terms + foldl' (addDefinition tm tp) uf termNames + addDefinition :: Term Symbol Ann -> Type Symbol Ann -> UnisonFile Symbol Ann -> Name -> UnisonFile Symbol Ann + addDefinition tm tp uf (Name.toVar -> v) = + let prependTerm to = (v, Ann.External, tm) : to + in if isTest tp + then uf & #watches . Lens.at WK.TestWatch . Lens.non [] Lens.%~ prependTerm + else uf & #terms Lens.%~ Map.insert v (Ann.External, tm) + + isTest = Typechecker.isEqual (Decls.testResultListType mempty) + + -- given a dependent hash, include that component in the scratch file + -- todo: wundefined: cut off constructor name prefixes + addDeclComponent :: UnisonFile Symbol Ann -> Hash -> Transaction (UnisonFile Symbol Ann) + addDeclComponent uf h = do + declComponent <- fromJust <$> Codebase.getDeclComponent h + foldM addDeclElement uf (zip declComponent [0 ..]) + where + -- for each name a decl has, update its constructor names according to what exists in the namespace + addDeclElement :: UnisonFile Symbol Ann -> (Decl Symbol Ann, Reference.Pos) -> Transaction (UnisonFile Symbol Ann) + addDeclElement uf (decl, i) = do + let declNames = Relation.lookupRan (Reference.Id h i) defns.types + -- look up names for this decl's constructor based on the decl's name, and embed them in the decl definition. + foldM (addRebuiltDefinition decl) uf declNames + where + -- skip any definitions that already have names, we don't want to overwrite what the user has supplied + addRebuiltDefinition :: Decl Symbol Ann -> UnisonFile Symbol Ann -> Name -> Transaction (UnisonFile Symbol Ann) + addRebuiltDefinition decl uf name = case decl of + Left ed -> + overwriteConstructorNames name ed.toDataDecl <&> \ed' -> + uf + & #effectDeclarationsId + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') + Right dd -> + overwriteConstructorNames name dd <&> \dd' -> + uf + & #dataDeclarationsId + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') + + -- Constructor names are bogus when pulled from the database, so we set them to what they should be here + overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann) + overwriteConstructorNames name dd = + let constructorNames :: Transaction [Symbol] + constructorNames = + case doFindCtorNames (Just $ Decl.constructorCount dd) name of + Left err -> abort err + Right array | all (isJust . Name.stripNamePrefix name) array -> pure (map Name.toVar array) + Right array -> do + traceM "I ran into a situation where a type's constructors didn't match its name," + traceM "in a spot where I didn't expect to be discovering that.\n\n" + traceM "Type Name:" + traceM . Text.Lazy.unpack $ pShow name + traceM "Constructor Names:" + traceM . Text.Lazy.unpack $ pShow array + error "Sorry for crashing." + + swapConstructorNames oldCtors = + let (annotations, _vars, types) = unzip3 oldCtors + in zip3 annotations <$> constructorNames <*> pure types + in Lens.traverseOf Decl.constructors_ swapConstructorNames dd + makeOldDepPPE :: NameSegment -> NameSegment -> @@ -287,3 +404,72 @@ findTemporaryBranchName projectId oldDepName newDepName = do oldDepText = NameSegment.toEscapedText oldDepName newDepText = NameSegment.toEscapedText newDepName + +-- | O(r + c * d) touches all the referents (r), and all the NameSegments (d) of all of the Con referents (c) +forwardCtorNames :: Names -> Map ForwardName (Referent, Name) +forwardCtorNames names = + Map.fromList $ + [ (ForwardName.fromName name, (r, name)) + | (r@Referent.Con {}, rNames) <- Map.toList $ Relation.range names.terms, + name <- Foldable.toList rNames + ] + +-- | given a decl name, find names for all of its constructors, in order. +-- +-- Precondition: 'n' is an element of 'names' +findCtorNames :: Output.UpdateOrUpgrade -> Names -> Map ForwardName (Referent, Name) -> Maybe Int -> Name -> Either Output.Output [Name] +findCtorNames operation names forwardCtorNames ctorCount n = + let declRef = case Set.lookupMin (Relation.lookupDom n names.types) of + Nothing -> error "[findCtorNames] precondition violation: n is not an element of names" + Just x -> x + f = ForwardName.fromName n + (_, centerRight) = Map.split f forwardCtorNames + (center, _) = Map.split (incrementLastSegmentChar f) centerRight + + insertShortest :: Map ConstructorId Name -> (Referent, Name) -> Map ConstructorId Name + insertShortest m (Referent.Con (ConstructorReference r cid) _ct, newName) | r == declRef = + case Map.lookup cid m of + Just existingName + | length (Name.segments existingName) > length (Name.segments newName) -> + Map.insert cid newName m + Just {} -> m + Nothing -> Map.insert cid newName m + insertShortest m _ = m + m = foldl' insertShortest mempty (Foldable.toList center) + ctorCountGuess = fromMaybe (Map.size m) ctorCount + in if Map.size m == ctorCountGuess && all (isJust . flip Map.lookup m . fromIntegral) [0 .. ctorCountGuess - 1] + then Right $ Map.elems m + else Left $ Output.UpdateIncompleteConstructorSet operation n m ctorCount + +findCtorNamesMaybe :: + Output.UpdateOrUpgrade -> + Names -> + Map ForwardName (Referent, Name) -> + Maybe Int -> + Name -> + Either Output.Output (Maybe [Name]) +findCtorNamesMaybe operation names forwardCtorNames ctorCount name = + case Relation.memberDom name (Names.types names) of + True -> Just <$> findCtorNames operation names forwardCtorNames ctorCount name + False -> Right Nothing + +-- Used by `findCtorNames` to filter `forwardCtorNames` to a narrow range which will be searched linearly. +-- >>> incrementLastSegmentChar $ ForwardName.fromName $ Name.unsafeFromText "foo.bar.quux" +-- ForwardName {toList = "foo" :| ["bar","quuy"]} +incrementLastSegmentChar :: ForwardName -> ForwardName +incrementLastSegmentChar (ForwardName segments) = + let (initSegments, lastSegment) = (List.NonEmpty.init segments, List.NonEmpty.last segments) + incrementedLastSegment = incrementLastCharInSegment lastSegment + in ForwardName $ + maybe + (List.NonEmpty.singleton incrementedLastSegment) + (|> incrementedLastSegment) + (List.NonEmpty.nonEmpty initSegments) + where + incrementLastCharInSegment :: NameSegment -> NameSegment + incrementLastCharInSegment (NameSegment text) = + let incrementedText = + if Text.null text + then text + else Text.init text `Text.append` Text.singleton (succ $ Text.last text) + in NameSegment incrementedText From aea1660a07d330d0039ef1fab37e63bc67e1f81d Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 24 Jul 2024 02:58:07 -0400 Subject: [PATCH 492/631] simplify checkDeclCoherency again --- .../Codebase/Editor/HandleInput/Merge2.hs | 8 +-- .../Codebase/Editor/HandleInput/Todo.hs | 4 -- .../Codebase/Editor/HandleInput/Update2.hs | 8 +-- .../src/Unison/Merge/DeclCoherencyCheck.hs | 63 ++++++++----------- 4 files changed, 27 insertions(+), 56 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 19dae57b86..6696c21831 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -250,13 +250,7 @@ doMerge info = do Just (who, branch) -> do defns <- loadDefns branch declNameLookup <- - Cli.runTransaction - ( checkDeclCoherency - db.loadDeclNumConstructors - Referent.toConstructorReferenceId - Reference.toId - defns - ) + Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) & onLeftM (done . Output.IncoherentDeclDuringMerge who) pure (defns, declNameLookup) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index 3771eeb224..108ceee2a4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -27,8 +27,6 @@ import Unison.Reference (TermReference) import Unison.Syntax.Name qualified as Name import Unison.Util.Defns (Defns (..)) import Unison.Util.Set qualified as Set -import qualified Unison.Referent as Referent -import qualified Unison.Reference as Reference handleTodo :: Cli () handleTodo = do @@ -74,8 +72,6 @@ handleTodo = do fmap (Either.fromLeft (IncoherentDeclReasons [] [] [] [])) $ checkAllDeclCoherency Operations.expectDeclNumConstructors - Referent.toConstructorReferenceId - Reference.toId (Names.lenientToNametree (Branch.toNames currentNamespaceWithoutLibdeps)) pure (defnsInLib, dependentsOfTodo.terms, directDependencies, hashLen, incoherentDeclReasons) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 4268e5e616..1073a416e4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -85,13 +85,7 @@ handleUpdate2 = do -- Assert that the namespace doesn't have any incoherent decls declNameLookup <- - Cli.runTransaction - ( checkDeclCoherency - Operations.expectDeclNumConstructors - Referent.toConstructorReferenceId - Reference.toId - defns - ) + Cli.runTransaction (checkDeclCoherency Operations.expectDeclNumConstructors defns) & onLeftM (Cli.returnEarly . Output.IncoherentDeclDuringUpdate) Cli.respond Output.UpdateLookingForDependents diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 465b08ff5f..882695231e 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -103,7 +103,7 @@ import Data.Map.Strict qualified as Map import Data.Maybe (fromJust) import Data.Set qualified as Set import U.Codebase.Reference (Reference' (..), TypeReference, TypeReferenceId) -import Unison.ConstructorReference (ConstructorReferenceId, GConstructorReference (..)) +import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) @@ -111,6 +111,7 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.Prelude +import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Util.Defns (Defns (..), DefnsF) @@ -134,14 +135,11 @@ data IncoherentDeclReason deriving stock (Show) checkDeclCoherency :: - forall m tm ty. (Monad m) => (TypeReferenceId -> m Int) -> - (tm -> Maybe ConstructorReferenceId) -> - (ty -> Maybe TypeReferenceId) -> - Nametree (DefnsF (Map NameSegment) tm ty) -> + Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m (Either IncoherentDeclReason DeclNameLookup) -checkDeclCoherency loadDeclNumConstructors toConRefId toTypeRefId nametree = +checkDeclCoherency loadDeclNumConstructors nametree = Except.runExceptT $ checkDeclCoherencyWith (lift . loadDeclNumConstructors) @@ -151,8 +149,6 @@ checkDeclCoherency loadDeclNumConstructors toConRefId toTypeRefId nametree = onNestedDeclAlias = \x y -> Except.throwError (IncoherentDeclReason'NestedDeclAlias x y), onStrayConstructor = \x y -> Except.throwError (IncoherentDeclReason'StrayConstructor x y) } - toConRefId - toTypeRefId nametree data IncoherentDeclReasons = IncoherentDeclReasons @@ -165,14 +161,12 @@ data IncoherentDeclReasons = IncoherentDeclReasons -- | Like 'checkDeclCoherency', but returns info about all of the incoherent decls found, not just the first. checkAllDeclCoherency :: - forall m tm ty. + forall m. (Monad m) => (TypeReferenceId -> m Int) -> - (tm -> Maybe ConstructorReferenceId) -> - (ty -> Maybe TypeReferenceId) -> - Nametree (DefnsF (Map NameSegment) tm ty) -> + Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m (Either IncoherentDeclReasons DeclNameLookup) -checkAllDeclCoherency loadDeclNumConstructors toConRefId toTypeRefId nametree = do +checkAllDeclCoherency loadDeclNumConstructors nametree = do State.runStateT doCheck emptyReasons <&> \(declNameLookup, reasons) -> if reasons == emptyReasons then Right declNameLookup @@ -189,8 +183,6 @@ checkAllDeclCoherency loadDeclNumConstructors toConRefId toTypeRefId nametree = onStrayConstructor = \x y -> #strayConstructors %= ((x, y) :) } ) - toConRefId - toTypeRefId nametree emptyReasons :: IncoherentDeclReasons @@ -214,48 +206,44 @@ data OnIncoherentDeclReasons m = OnIncoherentDeclReasons } checkDeclCoherencyWith :: - forall m tm ty. + forall m. (Monad m) => (TypeReferenceId -> m Int) -> OnIncoherentDeclReasons m -> - (tm -> Maybe ConstructorReferenceId) -> - (ty -> Maybe TypeReferenceId) -> - Nametree (DefnsF (Map NameSegment) tm ty) -> + Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m DeclNameLookup -checkDeclCoherencyWith loadDeclNumConstructors callbacks toConRefId toTypeRefId = +checkDeclCoherencyWith loadDeclNumConstructors callbacks = fmap (view #declNameLookup) . (`State.execStateT` DeclCoherencyCheckState Map.empty (DeclNameLookup Map.empty Map.empty)) . go [] where go :: [NameSegment] -> - (Nametree (DefnsF (Map NameSegment) tm ty)) -> + (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> StateT DeclCoherencyCheckState m () go prefix (Nametree defns children) = do for_ (Map.toList defns.terms) ( checkDeclCoherencyWith_DoTerms callbacks - toConRefId prefix ) childrenWeWentInto <- forMaybe (Map.toList defns.types) - (checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks toTypeRefId go prefix children) + (checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix children) let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child checkDeclCoherencyWith_DoTerms :: - forall m ref. + forall m. (Monad m) => OnIncoherentDeclReasons m -> - (ref -> Maybe ConstructorReferenceId) -> [NameSegment] -> - (NameSegment, ref) -> + (NameSegment, Referent) -> StateT DeclCoherencyCheckState m () -checkDeclCoherencyWith_DoTerms callbacks toConRefId prefix (segment, ref) = - whenJust (toConRefId ref) \(ConstructorReference typeRef conId) -> do +checkDeclCoherencyWith_DoTerms callbacks prefix (segment, ref) = + whenJust (Referent.toConstructorReferenceId ref) \(ConstructorReference typeRef conId) -> do let f :: Maybe (Name, ConstructorNames) -> MaybeT m (Name, ConstructorNames) f = \case Nothing -> do @@ -275,36 +263,35 @@ checkDeclCoherencyWith_DoTerms callbacks toConRefId prefix (segment, ref) = #expectedConstructors .= expectedConstructors1 checkDeclCoherencyWith_DoTypes :: - forall m tm ty. + forall m. (Monad m) => (TypeReferenceId -> m Int) -> OnIncoherentDeclReasons m -> - (ty -> Maybe TypeReferenceId) -> ( [NameSegment] -> - (Nametree (DefnsF (Map NameSegment) tm ty)) -> + (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> StateT DeclCoherencyCheckState m () ) -> [NameSegment] -> - Map NameSegment (Nametree (DefnsF (Map NameSegment) tm ty)) -> - (NameSegment, ty) -> + Map NameSegment (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + (NameSegment, TypeReference) -> StateT DeclCoherencyCheckState m (Maybe NameSegment) -checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks toTypeRefId go prefix children (name, ref) = - case toTypeRefId ref of +checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix children (name, ref) = + case Reference.toId ref of Nothing -> pure Nothing Just refId -> checkDeclCoherencyWith_DoTypes2 loadDeclNumConstructors callbacks go prefix children name refId checkDeclCoherencyWith_DoTypes2 :: - forall m tm ty. + forall m. (Monad m) => (TypeReferenceId -> m Int) -> OnIncoherentDeclReasons m -> ( [NameSegment] -> - (Nametree (DefnsF (Map NameSegment) tm ty)) -> + (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> StateT DeclCoherencyCheckState m () ) -> [NameSegment] -> - Map NameSegment (Nametree (DefnsF (Map NameSegment) tm ty)) -> + Map NameSegment (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> NameSegment -> TypeReferenceId -> StateT DeclCoherencyCheckState m (Maybe NameSegment) From 032e3609a0426cd97be13df16b82d721913f3287 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 24 Jul 2024 12:41:55 -0600 Subject: [PATCH 493/631] =?UTF-8?q?Add=20some=20transcripts=20that=20shoul?= =?UTF-8?q?d=20error,=20but=20don=E2=80=99t?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- unison-src/transcripts/errors/invalid-api-requests.md | 3 +++ unison-src/transcripts/errors/no-abspath-in-ucm.md | 5 +++++ 2 files changed, 8 insertions(+) create mode 100644 unison-src/transcripts/errors/invalid-api-requests.md create mode 100644 unison-src/transcripts/errors/no-abspath-in-ucm.md diff --git a/unison-src/transcripts/errors/invalid-api-requests.md b/unison-src/transcripts/errors/invalid-api-requests.md new file mode 100644 index 0000000000..12cfe78660 --- /dev/null +++ b/unison-src/transcripts/errors/invalid-api-requests.md @@ -0,0 +1,3 @@ +``` api:error +DELETE /something/important +``` diff --git a/unison-src/transcripts/errors/no-abspath-in-ucm.md b/unison-src/transcripts/errors/no-abspath-in-ucm.md new file mode 100644 index 0000000000..a982bb9855 --- /dev/null +++ b/unison-src/transcripts/errors/no-abspath-in-ucm.md @@ -0,0 +1,5 @@ +``` ucm:error +scratch/main> builtins.merge +-- As of 0.5.25, we no longer allow loose code paths for UCM commands. +.> ls +``` From bd4c2044ec770e82623104ac6690c3ffde911101 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 24 Jul 2024 12:42:57 -0600 Subject: [PATCH 494/631] Ensure transcript parser consumes entire stanzas MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit With the switch to `cmark`, the “second phase” parsing of individual stanzas omitted an EOF check to ensure that the entire stanza had been parsed. This resulted in parses where we end up with truncated sets of UCM commands or API requests, which could either result in premature success or failures occurring later in the transcript, where they’d complain about the wrong thing. --- .../src/Unison/Codebase/Transcript/Parser.hs | 31 +++++++------------ 1 file changed, 11 insertions(+), 20 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Transcript/Parser.hs b/unison-cli/src/Unison/Codebase/Transcript/Parser.hs index 8bbd8be622..47f7965240 100644 --- a/unison-cli/src/Unison/Codebase/Transcript/Parser.hs +++ b/unison-cli/src/Unison/Codebase/Transcript/Parser.hs @@ -24,11 +24,10 @@ where import CMark qualified import Data.Char qualified as Char import Data.Text qualified as Text -import Data.These (These (..)) import Text.Megaparsec qualified as P import Unison.Codebase.Transcript import Unison.Prelude -import Unison.Project (ProjectAndBranch (ProjectAndBranch)) +import Unison.Project (fullyQualifiedProjectAndBranchNamesParser) formatAPIRequest :: APIRequest -> Text formatAPIRequest = \case @@ -72,24 +71,16 @@ ucmLine :: P UcmLine ucmLine = ucmCommand <|> ucmComment where ucmCommand :: P UcmLine - ucmCommand = do - context <- - P.try do - contextString <- P.takeWhile1P Nothing (/= '>') - context <- - case (tryFrom @Text contextString) of - (Right (These project branch)) -> pure (UcmContextProject (ProjectAndBranch project branch)) - _ -> fail "expected project/branch or absolute path" - void $ lineToken $ word ">" - pure context - line <- P.takeWhileP Nothing (/= '\n') <* spaces - pure $ UcmCommand context line + ucmCommand = + UcmCommand + <$> fmap UcmContextProject (P.try $ fullyQualifiedProjectAndBranchNamesParser <* lineToken (word ">")) + <*> P.takeWhileP Nothing (/= '\n') + <* spaces ucmComment :: P UcmLine - ucmComment = do - word "--" - line <- P.takeWhileP Nothing (/= '\n') <* spaces - pure $ UcmComment line + ucmComment = + P.label "comment (delimited with “--”)" $ + UcmComment <$> (word "--" *> P.takeWhileP Nothing (/= '\n')) <* spaces apiRequest :: P APIRequest apiRequest = do @@ -118,7 +109,7 @@ fenced info = do hide <- hidden err <- expectingError P.setInput body - pure . Ucm hide err <$> (spaces *> many ucmLine) + pure . Ucm hide err <$> (spaces *> P.manyTill ucmLine P.eof) "unison" -> do -- todo: this has to be more interesting @@ -132,7 +123,7 @@ fenced info = do pure . Unison hide err fileName <$> (spaces *> P.getInput) "api" -> do P.setInput body - pure . API <$> (spaces *> many apiRequest) + pure . API <$> (spaces *> P.manyTill apiRequest P.eof) _ -> pure Nothing word :: Text -> P Text From 80143eb9a289710e72f520065b7d88b766da78d1 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 24 Jul 2024 12:58:15 -0600 Subject: [PATCH 495/631] Add transcripts for some already-fixed issues This fixes #1327 (which was actually fixed by #5056 or #5061) and #3977 was already closed, but without the transcript to avoid regression. --- unison-src/transcripts/fix1327.md | 11 ++++++ unison-src/transcripts/fix1327.output.md | 46 ++++++++++++++++++++++++ unison-src/transcripts/fix3977.md | 15 ++++++++ unison-src/transcripts/fix3977.output.md | 42 ++++++++++++++++++++++ 4 files changed, 114 insertions(+) create mode 100644 unison-src/transcripts/fix1327.md create mode 100644 unison-src/transcripts/fix1327.output.md create mode 100644 unison-src/transcripts/fix3977.md create mode 100644 unison-src/transcripts/fix3977.output.md diff --git a/unison-src/transcripts/fix1327.md b/unison-src/transcripts/fix1327.md new file mode 100644 index 0000000000..764d0f3ac5 --- /dev/null +++ b/unison-src/transcripts/fix1327.md @@ -0,0 +1,11 @@ +```unison +foo = 4 + +bar = 5 +``` + +```ucm +scratch/main> add +scratch/main> ls +scratch/main> alias.many 1-2 .ns1_nohistory +``` diff --git a/unison-src/transcripts/fix1327.output.md b/unison-src/transcripts/fix1327.output.md new file mode 100644 index 0000000000..fa542e6ed2 --- /dev/null +++ b/unison-src/transcripts/fix1327.output.md @@ -0,0 +1,46 @@ +``` unison +foo = 4 + +bar = 5 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bar : ##Nat + foo : ##Nat + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : ##Nat + foo : ##Nat + +scratch/main> ls + + 1. bar (##Nat) + 2. foo (##Nat) + +scratch/main> alias.many 1-2 .ns1_nohistory + + Here's what changed in .ns1_nohistory : + + Added definitions: + + 1. bar : ##Nat + 2. foo : ##Nat + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. + +``` diff --git a/unison-src/transcripts/fix3977.md b/unison-src/transcripts/fix3977.md new file mode 100644 index 0000000000..8ad82cbce9 --- /dev/null +++ b/unison-src/transcripts/fix3977.md @@ -0,0 +1,15 @@ +```ucm:hide +scratch/main> builtins.merge +``` + +```unison:hide +failure msg context = Failure (typeLink Unit) msg (Any context) + +foo = Left (failure ("a loooooooooooooooooooooooooooooooooong" ++ "message with concatenation") ()) +``` + +```ucm +scratch/main> add +scratch/main> edit foo +scratch/main> load scratch.u +``` diff --git a/unison-src/transcripts/fix3977.output.md b/unison-src/transcripts/fix3977.output.md new file mode 100644 index 0000000000..79a68eedc4 --- /dev/null +++ b/unison-src/transcripts/fix3977.output.md @@ -0,0 +1,42 @@ +``` unison +failure msg context = Failure (typeLink Unit) msg (Any context) + +foo = Left (failure ("a loooooooooooooooooooooooooooooooooong" ++ "message with concatenation") ()) +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + failure : Text -> context -> Failure + foo : Either Failure b + +scratch/main> edit foo + + ☝️ + + I added 1 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. + +scratch/main> load scratch.u + + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. + +``` +``` unison:added-by-ucm scratch.u +foo : Either Failure b +foo = + use Text ++ + Left + (failure + ("a loooooooooooooooooooooooooooooooooong" + ++ "message with concatenation") + ()) +``` + From c4c23273f918a48b5b877397c37b472983029700 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 24 Jul 2024 14:35:24 -0400 Subject: [PATCH 496/631] delete unused imports --- unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs | 1 - unison-core/src/Unison/Names.hs | 2 -- 2 files changed, 3 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 1073a416e4..858003c431 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -14,7 +14,6 @@ import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text import U.Codebase.Reference (Reference, TermReferenceId) -import U.Codebase.Reference qualified as Reference import U.Codebase.Sqlite.Operations qualified as Operations import Unison.Cli.Monad (Cli, Env (..)) import Unison.Cli.Monad qualified as Cli diff --git a/unison-core/src/Unison/Names.hs b/unison-core/src/Unison/Names.hs index b85454f956..d9d222b9c8 100644 --- a/unison-core/src/Unison/Names.hs +++ b/unison-core/src/Unison/Names.hs @@ -77,8 +77,6 @@ import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH -import Unison.Util.BiMultimap (BiMultimap) -import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.Nametree (Nametree, unflattenNametree) import Unison.Util.Relation (Relation) From 04c659de5df22f4302d0534c3b0e6cb5ce2586dc Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 25 Jul 2024 14:27:24 -0400 Subject: [PATCH 497/631] write pure version of synhashLcaDefns --- unison-merge/src/Unison/Merge/Diff.hs | 61 +++++++++++++++++++++++- unison-merge/src/Unison/Merge/Synhash.hs | 18 +++---- 2 files changed, 70 insertions(+), 9 deletions(-) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index ca57953a2c..76a1d1fe2f 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -30,12 +30,13 @@ import Unison.Parser.Ann (Ann) import Unison.Prelude hiding (catMaybes) import Unison.PrettyPrintEnv (PrettyPrintEnv (..)) import Unison.PrettyPrintEnv qualified as Ppe -import Unison.Reference (Reference' (..), TypeReferenceId) +import Unison.Reference (Reference' (..), TermReferenceId, TypeReferenceId) import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name +import Unison.Term (Term) import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith) @@ -100,6 +101,48 @@ synhashLcaDefns db ppe declNameLookup = decl <- loadDeclWithGoodConstructorNames db names ref pure (synhashDerivedDecl ppe name decl) +synhashLcaDefns2 :: + PrettyPrintEnv -> + Map TermReferenceId (Term Symbol Ann) -> + Map TypeReferenceId (Decl Symbol Ann) -> + PartialDeclNameLookup -> + Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> + DefnsF2 (Map Name) Synhashed Referent TypeReference +synhashLcaDefns2 ppe termsById declsById declNameLookup = + synhashDefnsWith2 hashReferent hashType + where + -- For the LCA only, if we don't have a name for every constructor, or we don't have a name for a decl, that's okay, + -- just use a dummy syntactic hash (e.g. where we return `Hash mempty` below in two places). + -- + -- This is safe and correct; Alice/Bob can't have such a decl (it violates a merge precondition), so there's no risk + -- that we accidentally get an equal hash and classify a real update as unchanged. + + hashReferent :: Name -> Referent -> Hash + hashReferent name = \case + Referent.Con (ConstructorReference ref _) _ -> + case Map.lookup name declNameLookup.constructorToDecl of + Nothing -> Hash mempty -- see note above + Just declName -> hashType declName ref + Referent.Ref (ReferenceBuiltin builtin) -> synhashBuiltinTerm builtin + Referent.Ref (ReferenceDerived ref) -> + synhashDerivedTerm ppe case Map.lookup ref termsById of + Nothing -> error (reportBug "E488229" ("term ref " ++ show ref ++ " not found in map " ++ show termsById)) + Just term -> term + + hashType :: Name -> TypeReference -> Hash + hashType name = \case + ReferenceBuiltin builtin -> synhashBuiltinDecl builtin + ReferenceDerived ref -> + case sequence (declNameLookup.declToConstructors Map.! name) of + Nothing -> Hash mempty -- see note above + Just names -> + synhashDerivedDecl + ppe + name + case Map.lookup ref declsById of + Nothing -> error (reportBug "E663160" ("type ref " ++ show ref ++ " not found in map " ++ show declsById)) + Just decl -> DataDeclaration.setConstructorNames (map Name.toVar names) decl + synhashDefns :: MergeDatabase -> PrettyPrintEnv -> @@ -185,3 +228,19 @@ synhashDefnsWith hashTerm hashType = do hashType1 name typ = do hash <- hashType name typ pure (Synhashed hash typ) + +synhashDefnsWith2 :: + (Name -> term -> Hash) -> + (Name -> typ -> Hash) -> + Defns (BiMultimap term Name) (BiMultimap typ Name) -> + DefnsF2 (Map Name) Synhashed term typ +synhashDefnsWith2 hashTerm hashType = do + bimap + (Map.mapWithKey hashTerm1 . BiMultimap.range) + (Map.mapWithKey hashType1 . BiMultimap.range) + where + hashTerm1 name term = + Synhashed (hashTerm name term) term + + hashType1 name typ = + Synhashed (hashType name typ) typ diff --git a/unison-merge/src/Unison/Merge/Synhash.hs b/unison-merge/src/Unison/Merge/Synhash.hs index ec28369bfc..c281f0b6a2 100644 --- a/unison-merge/src/Unison/Merge/Synhash.hs +++ b/unison-merge/src/Unison/Merge/Synhash.hs @@ -28,6 +28,8 @@ module Unison.Merge.Synhash ( synhashType, synhashTerm, + synhashBuiltinTerm, + synhashDerivedTerm, synhashBuiltinDecl, synhashDerivedDecl, @@ -56,7 +58,7 @@ import Unison.Pattern qualified as Pattern import Unison.Prelude import Unison.PrettyPrintEnv (PrettyPrintEnv) import Unison.PrettyPrintEnv qualified as PPE -import Unison.Reference (Reference' (..), TypeReferenceId) +import Unison.Reference (Reference' (..), TermReferenceId) import Unison.Reference qualified as V1 import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -84,8 +86,8 @@ synhashBuiltinDecl :: Text -> Hash synhashBuiltinDecl name = H.accumulate [isBuiltinTag, isDeclTag, H.Text name] -hashBuiltinTerm :: Text -> Hash -hashBuiltinTerm = +synhashBuiltinTerm :: Text -> Hash +synhashBuiltinTerm = H.accumulate . hashBuiltinTermTokens hashBuiltinTermTokens :: Text -> [Token] @@ -116,8 +118,8 @@ hashConstructorNameToken declName conName = ) in H.Text (Name.toText strippedConName) -hashDerivedTerm :: (Var v) => PrettyPrintEnv -> Term v a -> Hash -hashDerivedTerm ppe term = +synhashDerivedTerm :: (Var v) => PrettyPrintEnv -> Term v a -> Hash +synhashDerivedTerm ppe term = H.accumulate (hashDerivedTermTokens ppe term) hashDerivedTermTokens :: forall a v. (Var v) => PrettyPrintEnv -> Term v a -> [Token] @@ -216,13 +218,13 @@ hashReferentToken ppe = synhashTerm :: forall m v a. (Monad m, Var v) => - (TypeReferenceId -> m (Term v a)) -> + (TermReferenceId -> m (Term v a)) -> PrettyPrintEnv -> V1.TermReference -> m Hash synhashTerm loadTerm ppe = \case - ReferenceBuiltin builtin -> pure (hashBuiltinTerm builtin) - ReferenceDerived ref -> hashDerivedTerm ppe <$> loadTerm ref + ReferenceBuiltin builtin -> pure (synhashBuiltinTerm builtin) + ReferenceDerived ref -> synhashDerivedTerm ppe <$> loadTerm ref hashTermFTokens :: (Var v) => PrettyPrintEnv -> Term.F v a a () -> [Token] hashTermFTokens ppe = \case From f59c428b3568aeb0419336361e477e89442f3107 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 25 Jul 2024 14:42:45 -0400 Subject: [PATCH 498/631] write pure version of synhashDefns --- unison-merge/src/Unison/Merge/Diff.hs | 72 ++++++++++++++++++++++----- 1 file changed, 59 insertions(+), 13 deletions(-) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index 76a1d1fe2f..9088e9fa33 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -1,5 +1,7 @@ module Unison.Merge.Diff ( nameBasedNamespaceDiff, + synhashLcaDefns2, + synhashDefns2, ) where @@ -30,7 +32,7 @@ import Unison.Parser.Ann (Ann) import Unison.Prelude hiding (catMaybes) import Unison.PrettyPrintEnv (PrettyPrintEnv (..)) import Unison.PrettyPrintEnv qualified as Ppe -import Unison.Reference (Reference' (..), TermReferenceId, TypeReferenceId) +import Unison.Reference (Reference' (..), TermReference, TermReferenceId, TypeReferenceId) import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Sqlite (Transaction) @@ -123,11 +125,7 @@ synhashLcaDefns2 ppe termsById declsById declNameLookup = case Map.lookup name declNameLookup.constructorToDecl of Nothing -> Hash mempty -- see note above Just declName -> hashType declName ref - Referent.Ref (ReferenceBuiltin builtin) -> synhashBuiltinTerm builtin - Referent.Ref (ReferenceDerived ref) -> - synhashDerivedTerm ppe case Map.lookup ref termsById of - Nothing -> error (reportBug "E488229" ("term ref " ++ show ref ++ " not found in map " ++ show termsById)) - Just term -> term + Referent.Ref ref -> hashTermReference ppe termsById ref hashType :: Name -> TypeReference -> Hash hashType name = \case @@ -135,13 +133,46 @@ synhashLcaDefns2 ppe termsById declsById declNameLookup = ReferenceDerived ref -> case sequence (declNameLookup.declToConstructors Map.! name) of Nothing -> Hash mempty -- see note above - Just names -> - synhashDerivedDecl - ppe - name - case Map.lookup ref declsById of - Nothing -> error (reportBug "E663160" ("type ref " ++ show ref ++ " not found in map " ++ show declsById)) - Just decl -> DataDeclaration.setConstructorNames (map Name.toVar names) decl + Just names -> hashDerivedDecl ppe declsById names name ref + +synhashDefns2 :: + PrettyPrintEnv -> + Map TermReferenceId (Term Symbol Ann) -> + Map TypeReferenceId (Decl Symbol Ann) -> + DeclNameLookup -> + Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> + DefnsF2 (Map Name) Synhashed Referent TypeReference +synhashDefns2 ppe termsById declsById declNameLookup = + synhashDefnsWith2 hashReferent hashType + where + hashReferent :: Name -> Referent -> Hash + hashReferent name = \case + -- We say that a referent constructor *in the namespace* (distinct from a referent that is in a term body) has a + -- synhash that is simply equal to the synhash of its type declaration. This is because the type declaration and + -- constructors are changed in lock-step: it is not possible to change one, but not the other. + -- + -- For example, if Alice updates `type Foo = Bar Nat` to `type Foo = Bar Nat Nat`, we want different synhashes on + -- both the type (Foo) and the constructor (Foo.Bar). + Referent.Con (ConstructorReference ref _) _ -> hashType (DeclNameLookup.expectDeclName declNameLookup name) ref + Referent.Ref ref -> hashTermReference ppe termsById ref + + hashType :: Name -> TypeReference -> Hash + hashType name = \case + ReferenceBuiltin builtin -> synhashBuiltinDecl builtin + ReferenceDerived ref -> + hashDerivedDecl ppe declsById (DeclNameLookup.expectConstructorNames declNameLookup name) name ref + +hashDerivedDecl :: PrettyPrintEnv -> Map TypeReferenceId (Decl Symbol Ann) -> [Name] -> Name -> TypeReferenceId -> Hash +hashDerivedDecl ppe declsById names name ref = + declsById + & expectDecl ref + & DataDeclaration.setConstructorNames (map Name.toVar names) + & synhashDerivedDecl ppe name + +hashTermReference :: PrettyPrintEnv -> Map TermReferenceId (Term Symbol Ann) -> TermReference -> Hash +hashTermReference ppe termsById = \case + ReferenceBuiltin builtin -> synhashBuiltinTerm builtin + ReferenceDerived ref -> synhashDerivedTerm ppe (expectTerm ref termsById) synhashDefns :: MergeDatabase -> @@ -244,3 +275,18 @@ synhashDefnsWith2 hashTerm hashType = do hashType1 name typ = Synhashed (hashType name typ) typ + +------------------------------------------------------------------------------------------------------------------------ +-- Looking up terms and decls that we expect to be there + +expectTerm :: TermReferenceId -> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann +expectTerm ref termsById = + case Map.lookup ref termsById of + Nothing -> error (reportBug "E488229" ("term ref " ++ show ref ++ " not found in map " ++ show termsById)) + Just term -> term + +expectDecl :: TypeReferenceId -> Map TypeReferenceId (Decl Symbol Ann) -> Decl Symbol Ann +expectDecl ref declsById = + case Map.lookup ref declsById of + Nothing -> error (reportBug "E663160" ("type ref " ++ show ref ++ " not found in map " ++ show declsById)) + Just decl -> decl From 0079f2a0dd2e8901659927149b56278126940806 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 25 Jul 2024 15:41:06 -0400 Subject: [PATCH 499/631] write pure version of nameBasedNamespaceDiff --- unison-merge/src/Unison/Merge/Diff.hs | 50 ++++++++++++++++++++------- 1 file changed, 37 insertions(+), 13 deletions(-) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index 9088e9fa33..196a1d7e49 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -1,7 +1,6 @@ module Unison.Merge.Diff ( nameBasedNamespaceDiff, - synhashLcaDefns2, - synhashDefns2, + nameBasedNamespaceDiff2, ) where @@ -70,6 +69,33 @@ nameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns = do `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.bob `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.lca +-- | @nameBasedNamespaceDiff db declNameLookups defns@ returns Alice's and Bob's name-based namespace diffs, each in the +-- form: +-- +-- > terms :: Map Name (DiffOp (Synhashed Referent)) +-- > types :: Map Name (DiffOp (Synhashed TypeReference)) +-- +-- where each name is paired with its diff-op (added, deleted, or updated), relative to the LCA between Alice and Bob's +-- branches. If the hash of a name did not change, it will not appear in the map. +nameBasedNamespaceDiff2 :: + TwoWay DeclNameLookup -> + PartialDeclNameLookup -> + ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> + Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) -> + TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) +nameBasedNamespaceDiff2 declNameLookups lcaDeclNameLookup defns hydratedDefns = + let lcaHashes = synhashLcaDefns2 ppe lcaDeclNameLookup defns.lca hydratedDefns + hashes = synhashDefns2 ppe hydratedDefns <$> declNameLookups <*> ThreeWay.forgetLca defns + in diffNamespaceDefns lcaHashes <$> hashes + where + ppe :: PrettyPrintEnv + ppe = + -- The order between Alice and Bob isn't important here for syntactic hashing; not sure right now if it matters + -- that the LCA is added last + deepNamespaceDefinitionsToPpe defns.alice + `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.bob + `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.lca + synhashLcaDefns :: MergeDatabase -> PrettyPrintEnv -> @@ -105,13 +131,12 @@ synhashLcaDefns db ppe declNameLookup = synhashLcaDefns2 :: PrettyPrintEnv -> - Map TermReferenceId (Term Symbol Ann) -> - Map TypeReferenceId (Decl Symbol Ann) -> PartialDeclNameLookup -> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> + Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) -> DefnsF2 (Map Name) Synhashed Referent TypeReference -synhashLcaDefns2 ppe termsById declsById declNameLookup = - synhashDefnsWith2 hashReferent hashType +synhashLcaDefns2 ppe declNameLookup defns hydratedDefns = + synhashDefnsWith2 hashReferent hashType defns where -- For the LCA only, if we don't have a name for every constructor, or we don't have a name for a decl, that's okay, -- just use a dummy syntactic hash (e.g. where we return `Hash mempty` below in two places). @@ -125,7 +150,7 @@ synhashLcaDefns2 ppe termsById declsById declNameLookup = case Map.lookup name declNameLookup.constructorToDecl of Nothing -> Hash mempty -- see note above Just declName -> hashType declName ref - Referent.Ref ref -> hashTermReference ppe termsById ref + Referent.Ref ref -> hashTermReference ppe hydratedDefns.terms ref hashType :: Name -> TypeReference -> Hash hashType name = \case @@ -133,16 +158,15 @@ synhashLcaDefns2 ppe termsById declsById declNameLookup = ReferenceDerived ref -> case sequence (declNameLookup.declToConstructors Map.! name) of Nothing -> Hash mempty -- see note above - Just names -> hashDerivedDecl ppe declsById names name ref + Just names -> hashDerivedDecl ppe hydratedDefns.types names name ref synhashDefns2 :: PrettyPrintEnv -> - Map TermReferenceId (Term Symbol Ann) -> - Map TypeReferenceId (Decl Symbol Ann) -> + Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) -> DeclNameLookup -> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> DefnsF2 (Map Name) Synhashed Referent TypeReference -synhashDefns2 ppe termsById declsById declNameLookup = +synhashDefns2 ppe hydratedDefns declNameLookup = synhashDefnsWith2 hashReferent hashType where hashReferent :: Name -> Referent -> Hash @@ -154,13 +178,13 @@ synhashDefns2 ppe termsById declsById declNameLookup = -- For example, if Alice updates `type Foo = Bar Nat` to `type Foo = Bar Nat Nat`, we want different synhashes on -- both the type (Foo) and the constructor (Foo.Bar). Referent.Con (ConstructorReference ref _) _ -> hashType (DeclNameLookup.expectDeclName declNameLookup name) ref - Referent.Ref ref -> hashTermReference ppe termsById ref + Referent.Ref ref -> hashTermReference ppe hydratedDefns.terms ref hashType :: Name -> TypeReference -> Hash hashType name = \case ReferenceBuiltin builtin -> synhashBuiltinDecl builtin ReferenceDerived ref -> - hashDerivedDecl ppe declsById (DeclNameLookup.expectConstructorNames declNameLookup name) name ref + hashDerivedDecl ppe hydratedDefns.types (DeclNameLookup.expectConstructorNames declNameLookup name) name ref hashDerivedDecl :: PrettyPrintEnv -> Map TypeReferenceId (Decl Symbol Ann) -> [Name] -> Name -> TypeReferenceId -> Hash hashDerivedDecl ppe declsById names name ref = From daa97fd2cfe3373987952eb9d1e1c7ae6b3641ec Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 25 Jul 2024 16:00:29 -0400 Subject: [PATCH 500/631] write pure version of checkDeclCoherency --- .../src/Unison/Merge/DeclCoherencyCheck.hs | 30 ++++++++++++++++--- 1 file changed, 26 insertions(+), 4 deletions(-) diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 34e3139f4d..ae2a0c462e 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -82,6 +82,7 @@ module Unison.Merge.DeclCoherencyCheck ( IncoherentDeclReason (..), checkDeclCoherency, + checkDeclCoherency2, lenientCheckDeclCoherency, -- * Getting all failures rather than just the first @@ -143,14 +144,35 @@ checkDeclCoherency loadDeclNumConstructors nametree = ( checkDeclCoherencyWith (lift . loadDeclNumConstructors) OnIncoherentDeclReasons - { onConstructorAlias = \x y z -> Except.throwError (IncoherentDeclReason'ConstructorAlias x y z), -- :: Name -> Name -> Name -> m (), - onMissingConstructorName = \x -> Except.throwError (IncoherentDeclReason'MissingConstructorName x), -- :: Name -> m (), - onNestedDeclAlias = \x y -> Except.throwError (IncoherentDeclReason'NestedDeclAlias x y), -- :: Name -> Name -> m (), - onStrayConstructor = \x -> Except.throwError (IncoherentDeclReason'StrayConstructor x) -- :: Name -> m () + { onConstructorAlias = \x y z -> Except.throwError (IncoherentDeclReason'ConstructorAlias x y z), + onMissingConstructorName = \x -> Except.throwError (IncoherentDeclReason'MissingConstructorName x), + onNestedDeclAlias = \x y -> Except.throwError (IncoherentDeclReason'NestedDeclAlias x y), + onStrayConstructor = \x -> Except.throwError (IncoherentDeclReason'StrayConstructor x) } nametree ) +checkDeclCoherency2 :: + Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> + Map TypeReferenceId Int -> + Either IncoherentDeclReason DeclNameLookup +checkDeclCoherency2 nametree numConstructorsById = + checkDeclCoherencyWith + ( \refId -> + case Map.lookup refId numConstructorsById of + Just numConstructors -> Right numConstructors + Nothing -> + error $ + reportBug "E061715" ("type ref " ++ show refId ++ " not found in map " ++ show numConstructorsById) + ) + OnIncoherentDeclReasons + { onConstructorAlias = \x y z -> Left (IncoherentDeclReason'ConstructorAlias x y z), + onMissingConstructorName = \x -> Left (IncoherentDeclReason'MissingConstructorName x), + onNestedDeclAlias = \x y -> Left (IncoherentDeclReason'NestedDeclAlias x y), + onStrayConstructor = \x -> Left (IncoherentDeclReason'StrayConstructor x) + } + nametree + data IncoherentDeclReasons = IncoherentDeclReasons { constructorAliases :: ![(Name, Name, Name)], missingConstructorNames :: ![Name], From 17c6c8e7c895ff8274165c58a15eba52b07dc003 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 25 Jul 2024 16:17:03 -0400 Subject: [PATCH 501/631] write pure version of lenientCheckDeclCoherency --- .../src/Unison/Merge/DeclCoherencyCheck.hs | 104 ++++++++++++++++-- 1 file changed, 97 insertions(+), 7 deletions(-) diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index ae2a0c462e..13d24416b5 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -84,6 +84,7 @@ module Unison.Merge.DeclCoherencyCheck checkDeclCoherency, checkDeclCoherency2, lenientCheckDeclCoherency, + lenientCheckDeclCoherency2, -- * Getting all failures rather than just the first IncoherentDeclReasons (..), @@ -95,6 +96,7 @@ import Control.Lens ((%=), (.=), _2) import Control.Monad.Except qualified as Except import Control.Monad.State.Strict (StateT) import Control.Monad.State.Strict qualified as State +import Control.Monad.Trans.State.Strict (State) import Data.Functor.Compose (Compose (..)) import Data.IntMap.Strict (IntMap) import Data.IntMap.Strict qualified as IntMap @@ -153,18 +155,13 @@ checkDeclCoherency loadDeclNumConstructors nametree = ) checkDeclCoherency2 :: + (HasCallStack) => Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> Map TypeReferenceId Int -> Either IncoherentDeclReason DeclNameLookup checkDeclCoherency2 nametree numConstructorsById = checkDeclCoherencyWith - ( \refId -> - case Map.lookup refId numConstructorsById of - Just numConstructors -> Right numConstructors - Nothing -> - error $ - reportBug "E061715" ("type ref " ++ show refId ++ " not found in map " ++ show numConstructorsById) - ) + (\refId -> Right (expectNumConstructors refId numConstructorsById)) OnIncoherentDeclReasons { onConstructorAlias = \x y z -> Left (IncoherentDeclReason'ConstructorAlias x y z), onMissingConstructorName = \x -> Left (IncoherentDeclReason'MissingConstructorName x), @@ -431,6 +428,91 @@ lenientCheckDeclCoherency loadDeclNumConstructors = fullName name = Name.fromReverseSegments (name :| prefix) +-- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns partial decl name lookup, +-- which doesn't require a name for every constructor, and allows a constructor with a nameless decl. +-- +-- This function exists merely to extract a best-effort name mapping for the LCA of a merge. We require Alice and Bob to +-- have coherent decls, but their LCA is out of the user's control and may have incoherent decls, and whether or not it +-- does, we still need to compute *some* syntactic hash for its decls. +lenientCheckDeclCoherency2 :: + Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> + Map TypeReferenceId Int -> + PartialDeclNameLookup +lenientCheckDeclCoherency2 nametree numConstructorsById = + nametree + & go [] + & (`State.execState` LenientDeclCoherencyCheckState Map.empty (PartialDeclNameLookup Map.empty Map.empty)) + & view #declNameLookup + where + go :: + [NameSegment] -> + (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + State LenientDeclCoherencyCheckState () + go prefix (Nametree defns children) = do + for_ (Map.toList defns.terms) \case + (_, Referent.Ref _) -> pure () + (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure () + (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do + #expectedConstructors %= Map.adjust (Map.map (lenientRecordConstructorName conId (fullName name))) typeRef + + childrenWeWentInto <- + forMaybe (Map.toList defns.types) \case + (_, ReferenceBuiltin _) -> pure Nothing + (name, ReferenceDerived typeRef) -> do + state <- State.get + let whatHappened = + let recordNewDecl :: WhatHappened (Map Name ConstructorNames) + recordNewDecl = + case expectNumConstructors typeRef numConstructorsById of + 0 -> UninhabitedDecl + n -> InhabitedDecl (Map.singleton typeName (emptyConstructorNames n)) + in Map.upsertF (\_ -> recordNewDecl) typeRef state.expectedConstructors + case whatHappened of + UninhabitedDecl -> do + #declNameLookup . #declToConstructors %= Map.insert typeName [] + pure Nothing + InhabitedDecl expectedConstructors1 -> do + let child = Map.findWithDefault (Nametree (Defns Map.empty Map.empty) Map.empty) name children + #expectedConstructors .= expectedConstructors1 + go (name : prefix) child + state <- State.get + let (constructorNames0, expectedConstructors) = + Map.alterF f typeRef state.expectedConstructors + where + f :: + Maybe (Map Name ConstructorNames) -> + (ConstructorNames, Maybe (Map Name ConstructorNames)) + f = + -- fromJust is safe here because we upserted `typeRef` key above + -- deleteLookupJust is safe here because we upserted `typeName` key above + fromJust + >>> Map.deleteLookupJust typeName + >>> over _2 \m -> if Map.null m then Nothing else Just m + + constructorNames :: [Maybe Name] + constructorNames = + IntMap.elems constructorNames0 + + #expectedConstructors .= expectedConstructors + #declNameLookup . #constructorToDecl %= \constructorToDecl -> + List.foldl' + ( \acc -> \case + Nothing -> acc + Just constructorName -> Map.insert constructorName typeName acc + ) + constructorToDecl + constructorNames + #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames + pure (Just name) + where + typeName = fullName name + + let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto + for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child + where + fullName name = + Name.fromReverseSegments (name :| prefix) + data DeclCoherencyCheckState = DeclCoherencyCheckState { expectedConstructors :: !(Map TypeReferenceId (Name, ConstructorNames)), declNameLookup :: !DeclNameLookup @@ -478,3 +560,11 @@ data WhatHappened a = UninhabitedDecl | InhabitedDecl !a deriving stock (Functor, Show) + +expectNumConstructors :: (HasCallStack) => TypeReferenceId -> Map TypeReferenceId Int -> Int +expectNumConstructors refId numConstructorsById = + case Map.lookup refId numConstructorsById of + Just numConstructors -> numConstructors + Nothing -> + error $ + reportBug "E061715" ("type ref " ++ show refId ++ " not found in map " ++ show numConstructorsById) From 21209e2bdd48a16cca4d74d000d2f0494c78d3f5 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 1 Jul 2024 13:17:38 -0600 Subject: [PATCH 502/631] Extract the `Doc` lexer into a top-level function --- unison-syntax/src/Unison/Syntax/Lexer.hs | 857 ++++++++++++----------- 1 file changed, 429 insertions(+), 428 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 14fe31f9a7..144ccd95c3 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -400,6 +400,435 @@ restoreStack lbl p = do S.put (s2 {layout = layout1}) pure $ p <> closes +-- | The `Doc` lexer as documented on unison-lang.org +doc2 :: P [Token Lexeme] +doc2 = do + -- Ensure we're at a doc before we start consuming tokens + P.lookAhead (lit "{{") + openStart <- posP + -- Produce any layout tokens, such as closing the last open block or virtual semicolons + -- We don't use 'token' on "{{" directly because we don't want to duplicate layout + -- tokens if we do the rewrite hack for type-docs below. + beforeStartToks <- token' ignore (pure ()) + void $ lit "{{" + openEnd <- posP + CP.space + -- Construct the token for opening the doc block. + let openTok = Token (Open "syntax.docUntitledSection") openStart openEnd + env0 <- S.get + -- Disable layout while parsing the doc block and reset the section number + (bodyToks0, closeTok) <- local + ( \env -> + env + { inLayout = False, + parentSections = 0 : (parentSections env0) + } + ) + do + bodyToks <- body + closeStart <- posP + lit "}}" + closeEnd <- posP + pure (bodyToks, Token Close closeStart closeEnd) + let docToks = beforeStartToks <> [openTok] <> bodyToks0 <> [closeTok] + -- Parse any layout tokens after the doc block, e.g. virtual semicolon + endToks <- token' ignore (pure ()) + -- Hack to allow anonymous doc blocks before type decls + -- {{ Some docs }} Foo.doc = {{ Some docs }} + -- ability Foo where => ability Foo where + tn <- subsequentTypeName + pure $ case (tn) of + -- If we're followed by a type, we rewrite the doc block to be a named doc block. + (Just (WordyId tname)) + | isTopLevel -> + beforeStartToks + <> [WordyId (HQ'.fromName (Name.snoc (HQ'.toName tname) NameSegment.docSegment)) <$ openTok, Open "=" <$ openTok] + <> [openTok] + <> bodyToks0 + <> [closeTok] + -- We need an extra 'Close' here because we added an extra Open above. + <> [closeTok] + <> endToks + where + isTopLevel = length (layout env0) + maybe 0 (const 1) (opening env0) == 1 + _ -> docToks <> endToks + where + wordyKw kw = separated wordySep (lit kw) + subsequentTypeName = P.lookAhead . P.optional $ do + let lit' s = lit s <* sp + let modifier = typeModifiersAlt (lit' . Text.unpack) + let typeOrAbility' = typeOrAbilityAlt (wordyKw . Text.unpack) + _ <- optional modifier *> typeOrAbility' *> sp + Token name start stop <- tokenP identifierP + if Name.isSymboly (HQ'.toName name) + then P.customFailure (Token (InvalidSymbolyId (Text.unpack (HQ'.toTextWith Name.toText name))) start stop) + else pure (WordyId name) + ignore _ _ _ = [] + body = join <$> P.many (sectionElem <* CP.space) + sectionElem = section <|> fencedBlock <|> list <|> paragraph + paragraph = wrap "syntax.docParagraph" $ join <$> spaced leaf + reserved word = List.isPrefixOf "}}" word || all (== '#') word + + wordy closing = wrap "syntax.docWord" . tok . fmap Textual . P.try $ do + let end = + P.lookAhead $ + void docClose + <|> void docOpen + <|> void (P.satisfy isSpace) + <|> void closing + word <- P.manyTill (P.satisfy (\ch -> not (isSpace ch))) end + guard (not $ reserved word || null word) + pure word + + leafy closing = groupy closing gs + where + gs = + link + <|> externalLink + <|> exampleInline + <|> expr + <|> boldOrItalicOrStrikethrough closing + <|> verbatim + <|> atDoc + <|> wordy closing + + leaf = leafy mzero + + atDoc = src <|> evalInline <|> signature <|> signatureInline + where + comma = lit "," <* CP.space + src = + src' "syntax.docSource" "@source" + <|> src' "syntax.docFoldedSource" "@foldedSource" + srcElem = + wrap "syntax.docSourceElement" $ + (typeLink <|> termLink) + <+> ( fmap (fromMaybe []) . P.optional $ + (tok (Reserved <$> lit "@") <+> (CP.space *> annotations)) + ) + where + annotation = tok identifierLexemeP <|> expr <* CP.space + annotations = + join <$> P.some (wrap "syntax.docEmbedAnnotation" annotation) + src' name atName = wrap name $ do + _ <- lit atName *> (lit " {" <|> lit "{") *> CP.space + s <- P.sepBy1 srcElem comma + _ <- lit "}" + pure (join s) + signature = wrap "syntax.docSignature" $ do + _ <- (lit "@signatures" <|> lit "@signature") *> (lit " {" <|> lit "{") *> CP.space + s <- join <$> P.sepBy1 signatureLink comma + _ <- lit "}" + pure s + signatureInline = wrap "syntax.docSignatureInline" $ do + _ <- lit "@inlineSignature" *> (lit " {" <|> lit "{") *> CP.space + s <- signatureLink + _ <- lit "}" + pure s + evalInline = wrap "syntax.docEvalInline" $ do + _ <- lit "@eval" *> (lit " {" <|> lit "{") *> CP.space + let inlineEvalClose = [] <$ lit "}" + s <- lexemes' inlineEvalClose + pure s + + typeLink = wrap "syntax.docEmbedTypeLink" do + _ <- typeOrAbilityAlt (wordyKw . Text.unpack) <* CP.space + tok identifierLexemeP <* CP.space + + termLink = + wrap "syntax.docEmbedTermLink" $ + tok identifierLexemeP <* CP.space + + signatureLink = + wrap "syntax.docEmbedSignatureLink" $ + tok identifierLexemeP <* CP.space + + groupy closing p = do + Token p start stop <- tokenP p + after <- P.optional . P.try $ leafy closing + pure $ case after of + Nothing -> p + Just after -> + [ Token (Open "syntax.docGroup") start stop', + Token (Open "syntax.docJoin") start stop' + ] + <> p + <> after + <> (take 2 $ repeat (Token Close stop' stop')) + where + stop' = maybe stop end (lastMay after) + + verbatim = + P.label "code (examples: ''**unformatted**'', `words` or '''_words_''')" $ do + Token originalText start stop <- tokenP do + -- a single backtick followed by a non-backtick is treated as monospaced + let tick = P.try (lit "`" <* P.lookAhead (P.satisfy (/= '`'))) + -- also two or more ' followed by that number of closing ' + quotes <- tick <|> (lit "''" <+> P.takeWhileP Nothing (== '\'')) + P.someTill P.anySingle (lit quotes) + let isMultiLine = line start /= line stop + if isMultiLine + then do + let trimmed = (trimAroundDelimiters originalText) + let txt = trimIndentFromVerbatimBlock (column start - 1) trimmed + -- If it's a multi-line verbatim block we trim any whitespace representing + -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' + wrap "syntax.docVerbatim" $ + wrap "syntax.docWord" $ + pure [Token (Textual txt) start stop] + else + wrap "syntax.docCode" $ + wrap "syntax.docWord" $ + pure [Token (Textual originalText) start stop] + + exampleInline = + P.label "inline code (examples: ``List.map f xs``, ``[1] :+ 2``)" $ + wrap "syntax.docExample" $ do + n <- P.try $ do + _ <- lit "`" + length <$> P.takeWhile1P (Just "backticks") (== '`') + let end :: P [Token Lexeme] = [] <$ lit (replicate (n + 1) '`') + ex <- CP.space *> lexemes' end + pure ex + + docClose = [] <$ lit "}}" + docOpen = [] <$ lit "{{" + + link = + P.label "link (examples: {type List}, {Nat.+})" $ + wrap "syntax.docLink" $ + P.try $ + lit "{" *> (typeLink <|> termLink) <* lit "}" + + expr = + P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ + openAs "{{" "syntax.docTransclude" + <+> do + env0 <- S.get + -- we re-allow layout within a transclusion, then restore it to its + -- previous state after + S.put (env0 {inLayout = True}) + -- Note: this P.lookAhead ensures the }} isn't consumed, + -- so it can be consumed below by the `close` which will + -- pop items off the layout stack up to the nearest enclosing + -- syntax.docTransclude. + ts <- lexemes' (P.lookAhead ([] <$ lit "}}")) + S.modify (\env -> env {inLayout = inLayout env0}) + pure ts + <+> close ["syntax.docTransclude"] (lit "}}") + + nonNewlineSpace ch = isSpace ch && ch /= '\n' && ch /= '\r' + nonNewlineSpaces = P.takeWhileP Nothing nonNewlineSpace + + -- Allows whitespace or a newline, but not more than two newlines in a row. + whitespaceWithoutParagraphBreak :: P () + whitespaceWithoutParagraphBreak = void do + void nonNewlineSpaces + optional newline >>= \case + Just _ -> void nonNewlineSpaces + Nothing -> pure () + + fencedBlock = + P.label "block eval (syntax: a fenced code block)" $ + evalUnison <|> exampleBlock <|> other + where + evalUnison = wrap "syntax.docEval" $ do + -- commit after seeing that ``` is on its own line + fence <- P.try $ do + fence <- lit "```" <+> P.takeWhileP Nothing (== '`') + b <- all isSpace <$> P.lookAhead (P.takeWhileP Nothing (/= '\n')) + fence <$ guard b + CP.space + *> local + (\env -> env {inLayout = True, opening = Just "docEval"}) + (restoreStack "docEval" $ lexemes' ([] <$ lit fence)) + + exampleBlock = wrap "syntax.docExampleBlock" $ do + void $ lit "@typecheck" <* CP.space + fence <- lit "```" <+> P.takeWhileP Nothing (== '`') + local + (\env -> env {inLayout = True, opening = Just "docExampleBlock"}) + (restoreStack "docExampleBlock" $ lexemes' ([] <$ lit fence)) + + uncolumn column tabWidth s = + let skip col r | col < 1 = r + skip col s@('\t' : _) | col < tabWidth = s + skip col ('\t' : r) = skip (col - tabWidth) r + skip col (c : r) + | isSpace c && (not $ isControl c) = + skip (col - 1) r + skip _ s = s + in List.intercalate "\n" $ skip column <$> lines s + + other = wrap "syntax.docCodeBlock" $ do + column <- (\x -> x - 1) . toInteger . P.unPos <$> LP.indentLevel + let tabWidth = toInteger . P.unPos $ P.defaultTabWidth + fence <- lit "```" <+> P.takeWhileP Nothing (== '`') + name <- + P.takeWhileP Nothing nonNewlineSpace + *> tok (Textual <$> P.takeWhile1P Nothing (not . isSpace)) + <* P.takeWhileP Nothing nonNewlineSpace + _ <- void CP.eol + verbatim <- + tok $ + Textual . uncolumn column tabWidth . trimAroundDelimiters + <$> P.someTill P.anySingle ([] <$ lit fence) + pure (name <> verbatim) + + boldOrItalicOrStrikethrough closing = do + let start = + some (P.satisfy (== '*')) + <|> some (P.satisfy (== '_')) + <|> some + (P.satisfy (== '~')) + name s = + if take 1 s == "~" + then "syntax.docStrikethrough" + else if take 1 s == "*" then "syntax.docBold" else "syntax.docItalic" + end <- P.try $ do + end <- start + P.lookAhead (P.satisfy (not . isSpace)) + pure end + wrap (name end) . wrap "syntax.docParagraph" $ + join + <$> P.someTill + (leafy (closing <|> (void $ lit end)) <* whitespaceWithoutParagraphBreak) + (lit end) + + externalLink = + P.label "hyperlink (example: [link name](https://destination.com))" $ + wrap "syntax.docNamedLink" $ do + _ <- lit "[" + p <- leafies (void $ char ']') + _ <- lit "]" + _ <- lit "(" + target <- + wrap "syntax.docGroup" . wrap "syntax.docJoin" $ + link <|> fmap join (P.some (expr <|> wordy (char ')'))) + _ <- lit ")" + pure (p <> target) + + -- newline = P.optional (lit "\r") *> lit "\n" + + sp = P.try $ do + spaces <- P.takeWhile1P (Just "space") isSpace + close <- P.optional (P.lookAhead (lit "}}")) + case close of + Nothing -> guard $ ok spaces + Just _ -> pure () + pure spaces + where + ok s = length [() | '\n' <- s] < 2 + + spaced p = P.some (p <* P.optional sp) + leafies close = wrap "syntax.docParagraph" $ join <$> spaced (leafy close) + + list = bulletedList <|> numberedList + + bulletedList = wrap "syntax.docBulletedList" $ join <$> P.sepBy1 bullet listSep + numberedList = wrap "syntax.docNumberedList" $ join <$> P.sepBy1 numberedItem listSep + + listSep = P.try $ newline *> nonNewlineSpaces *> P.lookAhead (bulletedStart <|> numberedStart) + + bulletedStart = P.try $ do + r <- listItemStart' $ [] <$ P.satisfy bulletChar + P.lookAhead (P.satisfy isSpace) + pure r + where + bulletChar ch = ch == '*' || ch == '-' || ch == '+' + + listItemStart' gutter = P.try $ do + nonNewlineSpaces + col <- column <$> posP + parentCol <- S.gets parentListColumn + guard (col > parentCol) + (col,) <$> gutter + + numberedStart = + listItemStart' $ P.try (tok . fmap num $ LP.decimal <* lit ".") + where + num :: Word -> Lexeme + num n = Numeric (show n) + + listItemParagraph = wrap "syntax.docParagraph" $ do + col <- column <$> posP + join <$> P.some (leaf <* sep col) + where + -- Trickiness here to support hard line breaks inside of + -- a bulleted list, so for instance this parses as expected: + -- + -- * uno dos + -- tres quatro + -- * alice bob + -- carol dave eve + sep col = do + _ <- nonNewlineSpaces + _ <- + P.optional . P.try $ + newline + *> nonNewlineSpaces + *> do + col2 <- column <$> posP + guard $ col2 >= col + (P.notFollowedBy $ numberedStart <|> bulletedStart) + pure () + + numberedItem = P.label msg $ do + (col, s) <- numberedStart + pure s + <+> ( wrap "syntax.docColumn" $ do + p <- nonNewlineSpaces *> listItemParagraph + subList <- + local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> list) + pure (p <> fromMaybe [] subList) + ) + where + msg = "numbered list (examples: 1. item1, 8. start numbering at '8')" + + bullet = wrap "syntax.docColumn" . P.label "bullet (examples: * item1, - item2)" $ do + (col, _) <- bulletedStart + p <- nonNewlineSpaces *> listItemParagraph + subList <- + local + (\e -> e {parentListColumn = col}) + (P.optional $ listSep *> list) + pure (p <> fromMaybe [] subList) + + newline = P.label "newline" $ lit "\n" <|> lit "\r\n" + + -- ## Section title + -- + -- A paragraph under this section. + -- Part of the same paragraph. Blanklines separate paragraphs. + -- + -- ### A subsection title + -- + -- A paragraph under this subsection. + + -- # A section title (not a subsection) + section :: P [Token Lexeme] + section = wrap "syntax.docSection" $ do + ns <- S.gets parentSections + hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp + title <- paragraph <* CP.space + let m = length hashes + head ns + body <- + local (\env -> env {parentSections = (m : (tail ns))}) $ + P.many (sectionElem <* CP.space) + pure $ title <> join body + + wrap :: String -> P [Token Lexeme] -> P [Token Lexeme] + wrap o p = do + start <- posP + lexemes <- p + pure $ go start lexemes + where + go start [] = [Token (Open o) start start, Token Close start start] + go start ts@(Token _ x _ : _) = + Token (Open o) start x : (ts ++ [Token Close (end final) (end final)]) + where + final = last ts + lexemes' :: P [Token Lexeme] -> P [Token Lexeme] lexemes' eof = P.optional space >> do @@ -418,434 +847,6 @@ lexemes' eof = <|> token identifierLexemeP <|> (asum . map token) [semi, textual, hash] - doc2 :: P [Token Lexeme] - doc2 = do - -- Ensure we're at a doc before we start consuming tokens - P.lookAhead (lit "{{") - openStart <- posP - -- Produce any layout tokens, such as closing the last open block or virtual semicolons - -- We don't use 'token' on "{{" directly because we don't want to duplicate layout - -- tokens if we do the rewrite hack for type-docs below. - beforeStartToks <- token' ignore (pure ()) - void $ lit "{{" - openEnd <- posP - CP.space - -- Construct the token for opening the doc block. - let openTok = Token (Open "syntax.docUntitledSection") openStart openEnd - env0 <- S.get - -- Disable layout while parsing the doc block and reset the section number - (bodyToks0, closeTok) <- local - ( \env -> - env - { inLayout = False, - parentSections = 0 : (parentSections env0) - } - ) - do - bodyToks <- body - closeStart <- posP - lit "}}" - closeEnd <- posP - pure (bodyToks, Token Close closeStart closeEnd) - let docToks = beforeStartToks <> [openTok] <> bodyToks0 <> [closeTok] - -- Parse any layout tokens after the doc block, e.g. virtual semicolon - endToks <- token' ignore (pure ()) - -- Hack to allow anonymous doc blocks before type decls - -- {{ Some docs }} Foo.doc = {{ Some docs }} - -- ability Foo where => ability Foo where - tn <- subsequentTypeName - pure $ case (tn) of - -- If we're followed by a type, we rewrite the doc block to be a named doc block. - (Just (WordyId tname)) - | isTopLevel -> - beforeStartToks - <> [WordyId (HQ'.fromName (Name.snoc (HQ'.toName tname) NameSegment.docSegment)) <$ openTok, Open "=" <$ openTok] - <> [openTok] - <> bodyToks0 - <> [closeTok] - -- We need an extra 'Close' here because we added an extra Open above. - <> [closeTok] - <> endToks - where - isTopLevel = length (layout env0) + maybe 0 (const 1) (opening env0) == 1 - _ -> docToks <> endToks - where - wordyKw kw = separated wordySep (lit kw) - subsequentTypeName = P.lookAhead . P.optional $ do - let lit' s = lit s <* sp - let modifier = typeModifiersAlt (lit' . Text.unpack) - let typeOrAbility' = typeOrAbilityAlt (wordyKw . Text.unpack) - _ <- optional modifier *> typeOrAbility' *> sp - Token name start stop <- tokenP identifierP - if Name.isSymboly (HQ'.toName name) - then P.customFailure (Token (InvalidSymbolyId (Text.unpack (HQ'.toTextWith Name.toText name))) start stop) - else pure (WordyId name) - ignore _ _ _ = [] - body = join <$> P.many (sectionElem <* CP.space) - sectionElem = section <|> fencedBlock <|> list <|> paragraph - paragraph = wrap "syntax.docParagraph" $ join <$> spaced leaf - reserved word = List.isPrefixOf "}}" word || all (== '#') word - - wordy closing = wrap "syntax.docWord" . tok . fmap Textual . P.try $ do - let end = - P.lookAhead $ - void docClose - <|> void docOpen - <|> void (P.satisfy isSpace) - <|> void closing - word <- P.manyTill (P.satisfy (\ch -> not (isSpace ch))) end - guard (not $ reserved word || null word) - pure word - - leafy closing = groupy closing gs - where - gs = - link - <|> externalLink - <|> exampleInline - <|> expr - <|> boldOrItalicOrStrikethrough closing - <|> verbatim - <|> atDoc - <|> wordy closing - - leaf = leafy mzero - - atDoc = src <|> evalInline <|> signature <|> signatureInline - where - comma = lit "," <* CP.space - src = - src' "syntax.docSource" "@source" - <|> src' "syntax.docFoldedSource" "@foldedSource" - srcElem = - wrap "syntax.docSourceElement" $ - (typeLink <|> termLink) - <+> ( fmap (fromMaybe []) . P.optional $ - (tok (Reserved <$> lit "@") <+> (CP.space *> annotations)) - ) - where - annotation = tok identifierLexemeP <|> expr <* CP.space - annotations = - join <$> P.some (wrap "syntax.docEmbedAnnotation" annotation) - src' name atName = wrap name $ do - _ <- lit atName *> (lit " {" <|> lit "{") *> CP.space - s <- P.sepBy1 srcElem comma - _ <- lit "}" - pure (join s) - signature = wrap "syntax.docSignature" $ do - _ <- (lit "@signatures" <|> lit "@signature") *> (lit " {" <|> lit "{") *> CP.space - s <- join <$> P.sepBy1 signatureLink comma - _ <- lit "}" - pure s - signatureInline = wrap "syntax.docSignatureInline" $ do - _ <- lit "@inlineSignature" *> (lit " {" <|> lit "{") *> CP.space - s <- signatureLink - _ <- lit "}" - pure s - evalInline = wrap "syntax.docEvalInline" $ do - _ <- lit "@eval" *> (lit " {" <|> lit "{") *> CP.space - let inlineEvalClose = [] <$ lit "}" - s <- lexemes' inlineEvalClose - pure s - - typeLink = wrap "syntax.docEmbedTypeLink" do - _ <- typeOrAbilityAlt (wordyKw . Text.unpack) <* CP.space - tok identifierLexemeP <* CP.space - - termLink = - wrap "syntax.docEmbedTermLink" $ - tok identifierLexemeP <* CP.space - - signatureLink = - wrap "syntax.docEmbedSignatureLink" $ - tok identifierLexemeP <* CP.space - - groupy closing p = do - Token p start stop <- tokenP p - after <- P.optional . P.try $ leafy closing - pure $ case after of - Nothing -> p - Just after -> - [ Token (Open "syntax.docGroup") start stop', - Token (Open "syntax.docJoin") start stop' - ] - <> p - <> after - <> (take 2 $ repeat (Token Close stop' stop')) - where - stop' = maybe stop end (lastMay after) - - verbatim = - P.label "code (examples: ''**unformatted**'', `words` or '''_words_''')" $ do - Token originalText start stop <- tokenP do - -- a single backtick followed by a non-backtick is treated as monospaced - let tick = P.try (lit "`" <* P.lookAhead (P.satisfy (/= '`'))) - -- also two or more ' followed by that number of closing ' - quotes <- tick <|> (lit "''" <+> P.takeWhileP Nothing (== '\'')) - P.someTill P.anySingle (lit quotes) - let isMultiLine = line start /= line stop - if isMultiLine - then do - let trimmed = (trimAroundDelimiters originalText) - let txt = trimIndentFromVerbatimBlock (column start - 1) trimmed - -- If it's a multi-line verbatim block we trim any whitespace representing - -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' - wrap "syntax.docVerbatim" $ - wrap "syntax.docWord" $ - pure [Token (Textual txt) start stop] - else - wrap "syntax.docCode" $ - wrap "syntax.docWord" $ - pure [Token (Textual originalText) start stop] - - exampleInline = - P.label "inline code (examples: ``List.map f xs``, ``[1] :+ 2``)" $ - wrap "syntax.docExample" $ do - n <- P.try $ do - _ <- lit "`" - length <$> P.takeWhile1P (Just "backticks") (== '`') - let end :: P [Token Lexeme] = [] <$ lit (replicate (n + 1) '`') - ex <- CP.space *> lexemes' end - pure ex - - docClose = [] <$ lit "}}" - docOpen = [] <$ lit "{{" - - link = - P.label "link (examples: {type List}, {Nat.+})" $ - wrap "syntax.docLink" $ - P.try $ - lit "{" *> (typeLink <|> termLink) <* lit "}" - - expr = - P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ - openAs "{{" "syntax.docTransclude" - <+> do - env0 <- S.get - -- we re-allow layout within a transclusion, then restore it to its - -- previous state after - S.put (env0 {inLayout = True}) - -- Note: this P.lookAhead ensures the }} isn't consumed, - -- so it can be consumed below by the `close` which will - -- pop items off the layout stack up to the nearest enclosing - -- syntax.docTransclude. - ts <- lexemes' (P.lookAhead ([] <$ lit "}}")) - S.modify (\env -> env {inLayout = inLayout env0}) - pure ts - <+> close ["syntax.docTransclude"] (lit "}}") - - nonNewlineSpace ch = isSpace ch && ch /= '\n' && ch /= '\r' - nonNewlineSpaces = P.takeWhileP Nothing nonNewlineSpace - - -- Allows whitespace or a newline, but not more than two newlines in a row. - whitespaceWithoutParagraphBreak :: P () - whitespaceWithoutParagraphBreak = void do - void nonNewlineSpaces - optional newline >>= \case - Just _ -> void nonNewlineSpaces - Nothing -> pure () - - fencedBlock = - P.label "block eval (syntax: a fenced code block)" $ - evalUnison <|> exampleBlock <|> other - where - evalUnison = wrap "syntax.docEval" $ do - -- commit after seeing that ``` is on its own line - fence <- P.try $ do - fence <- lit "```" <+> P.takeWhileP Nothing (== '`') - b <- all isSpace <$> P.lookAhead (P.takeWhileP Nothing (/= '\n')) - fence <$ guard b - CP.space - *> local - (\env -> env {inLayout = True, opening = Just "docEval"}) - (restoreStack "docEval" $ lexemes' ([] <$ lit fence)) - - exampleBlock = wrap "syntax.docExampleBlock" $ do - void $ lit "@typecheck" <* CP.space - fence <- lit "```" <+> P.takeWhileP Nothing (== '`') - local - (\env -> env {inLayout = True, opening = Just "docExampleBlock"}) - (restoreStack "docExampleBlock" $ lexemes' ([] <$ lit fence)) - - uncolumn column tabWidth s = - let skip col r | col < 1 = r - skip col s@('\t' : _) | col < tabWidth = s - skip col ('\t' : r) = skip (col - tabWidth) r - skip col (c : r) - | isSpace c && (not $ isControl c) = - skip (col - 1) r - skip _ s = s - in List.intercalate "\n" $ skip column <$> lines s - - other = wrap "syntax.docCodeBlock" $ do - column <- (\x -> x - 1) . toInteger . P.unPos <$> LP.indentLevel - let tabWidth = toInteger . P.unPos $ P.defaultTabWidth - fence <- lit "```" <+> P.takeWhileP Nothing (== '`') - name <- - P.takeWhileP Nothing nonNewlineSpace - *> tok (Textual <$> P.takeWhile1P Nothing (not . isSpace)) - <* P.takeWhileP Nothing nonNewlineSpace - _ <- void CP.eol - verbatim <- - tok $ - Textual . uncolumn column tabWidth . trimAroundDelimiters - <$> P.someTill P.anySingle ([] <$ lit fence) - pure (name <> verbatim) - - boldOrItalicOrStrikethrough closing = do - let start = - some (P.satisfy (== '*')) - <|> some (P.satisfy (== '_')) - <|> some - (P.satisfy (== '~')) - name s = - if take 1 s == "~" - then "syntax.docStrikethrough" - else if take 1 s == "*" then "syntax.docBold" else "syntax.docItalic" - end <- P.try $ do - end <- start - P.lookAhead (P.satisfy (not . isSpace)) - pure end - wrap (name end) . wrap "syntax.docParagraph" $ - join - <$> P.someTill - (leafy (closing <|> (void $ lit end)) <* whitespaceWithoutParagraphBreak) - (lit end) - - externalLink = - P.label "hyperlink (example: [link name](https://destination.com))" $ - wrap "syntax.docNamedLink" $ do - _ <- lit "[" - p <- leafies (void $ char ']') - _ <- lit "]" - _ <- lit "(" - target <- - wrap "syntax.docGroup" . wrap "syntax.docJoin" $ - link <|> fmap join (P.some (expr <|> wordy (char ')'))) - _ <- lit ")" - pure (p <> target) - - -- newline = P.optional (lit "\r") *> lit "\n" - - sp = P.try $ do - spaces <- P.takeWhile1P (Just "space") isSpace - close <- P.optional (P.lookAhead (lit "}}")) - case close of - Nothing -> guard $ ok spaces - Just _ -> pure () - pure spaces - where - ok s = length [() | '\n' <- s] < 2 - - spaced p = P.some (p <* P.optional sp) - leafies close = wrap "syntax.docParagraph" $ join <$> spaced (leafy close) - - list = bulletedList <|> numberedList - - bulletedList = wrap "syntax.docBulletedList" $ join <$> P.sepBy1 bullet listSep - numberedList = wrap "syntax.docNumberedList" $ join <$> P.sepBy1 numberedItem listSep - - listSep = P.try $ newline *> nonNewlineSpaces *> P.lookAhead (bulletedStart <|> numberedStart) - - bulletedStart = P.try $ do - r <- listItemStart' $ [] <$ P.satisfy bulletChar - P.lookAhead (P.satisfy isSpace) - pure r - where - bulletChar ch = ch == '*' || ch == '-' || ch == '+' - - listItemStart' gutter = P.try $ do - nonNewlineSpaces - col <- column <$> posP - parentCol <- S.gets parentListColumn - guard (col > parentCol) - (col,) <$> gutter - - numberedStart = - listItemStart' $ P.try (tok . fmap num $ LP.decimal <* lit ".") - where - num :: Word -> Lexeme - num n = Numeric (show n) - - listItemParagraph = wrap "syntax.docParagraph" $ do - col <- column <$> posP - join <$> P.some (leaf <* sep col) - where - -- Trickiness here to support hard line breaks inside of - -- a bulleted list, so for instance this parses as expected: - -- - -- * uno dos - -- tres quatro - -- * alice bob - -- carol dave eve - sep col = do - _ <- nonNewlineSpaces - _ <- - P.optional . P.try $ - newline - *> nonNewlineSpaces - *> do - col2 <- column <$> posP - guard $ col2 >= col - (P.notFollowedBy $ numberedStart <|> bulletedStart) - pure () - - numberedItem = P.label msg $ do - (col, s) <- numberedStart - pure s - <+> ( wrap "syntax.docColumn" $ do - p <- nonNewlineSpaces *> listItemParagraph - subList <- - local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> list) - pure (p <> fromMaybe [] subList) - ) - where - msg = "numbered list (examples: 1. item1, 8. start numbering at '8')" - - bullet = wrap "syntax.docColumn" . P.label "bullet (examples: * item1, - item2)" $ do - (col, _) <- bulletedStart - p <- nonNewlineSpaces *> listItemParagraph - subList <- - local - (\e -> e {parentListColumn = col}) - (P.optional $ listSep *> list) - pure (p <> fromMaybe [] subList) - - newline = P.label "newline" $ lit "\n" <|> lit "\r\n" - - -- ## Section title - -- - -- A paragraph under this section. - -- Part of the same paragraph. Blanklines separate paragraphs. - -- - -- ### A subsection title - -- - -- A paragraph under this subsection. - - -- # A section title (not a subsection) - section :: P [Token Lexeme] - section = wrap "syntax.docSection" $ do - ns <- S.gets parentSections - hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp - title <- paragraph <* CP.space - let m = length hashes + head ns - body <- - local (\env -> env {parentSections = (m : (tail ns))}) $ - P.many (sectionElem <* CP.space) - pure $ title <> join body - - wrap :: String -> P [Token Lexeme] -> P [Token Lexeme] - wrap o p = do - start <- posP - lexemes <- p - pure $ go start lexemes - where - go start [] = [Token (Open o) start start, Token Close start start] - go start ts@(Token _ x _ : _) = - Token (Open o) start x : (ts ++ [Token Close (end final) (end final)]) - where - final = last ts - doc :: P [Token Lexeme] doc = open <+> (CP.space *> fmap fixup body) <+> (close <* space) where From d1fe6d9429ac5ed69b101fde6bbc353195f2edf5 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 1 Jul 2024 13:43:06 -0600 Subject: [PATCH 503/631] Separate the `Doc` lexer from the Unison lexer `doc2` is a Unison lexer that traverses a `Doc`. `docBody` is the actual `Doc` lexer that is ignorant of the fact that Unison wraps `Doc` blocks in `{{`/`}}`. --- unison-syntax/src/Unison/Syntax/Lexer.hs | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 144ccd95c3..77c91b8e84 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -425,7 +425,7 @@ doc2 = do } ) do - bodyToks <- body + bodyToks <- docBody closeStart <- posP lit "}}" closeEnd <- posP @@ -453,6 +453,7 @@ doc2 = do isTopLevel = length (layout env0) + maybe 0 (const 1) (opening env0) == 1 _ -> docToks <> endToks where + -- DUPLICATED wordyKw kw = separated wordySep (lit kw) subsequentTypeName = P.lookAhead . P.optional $ do let lit' s = lit s <* sp @@ -464,7 +465,23 @@ doc2 = do then P.customFailure (Token (InvalidSymbolyId (Text.unpack (HQ'.toTextWith Name.toText name))) start stop) else pure (WordyId name) ignore _ _ _ = [] - body = join <$> P.many (sectionElem <* CP.space) + -- DUPLICATED + sp = P.try $ do + spaces <- P.takeWhile1P (Just "space") isSpace + close <- P.optional (P.lookAhead (lit "}}")) + case close of + Nothing -> guard $ ok spaces + Just _ -> pure () + pure spaces + where + ok s = length [() | '\n' <- s] < 2 + +-- | This is the actual `Doc` lexer. Unlike `doc2`, it doesn’t do any Unison-side lexing (i.e., it doesn’t know that +-- Unison wraps `Doc` literals in `}}`). +docBody :: P [Token Lexeme] +docBody = join <$> P.many (sectionElem <* CP.space) + where + wordyKw kw = separated wordySep (lit kw) sectionElem = section <|> fencedBlock <|> list <|> paragraph paragraph = wrap "syntax.docParagraph" $ join <$> spaced leaf reserved word = List.isPrefixOf "}}" word || all (== '#') word From 543daa36c74ab0bf1d4643b37b4baef30de88994 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 3 Jul 2024 12:59:09 -0600 Subject: [PATCH 504/631] Move the `Annotated` class to the `Ann` module This is in preparation for using `Ann` in the `Lexer` module, as that module actually does some parsing. --- unison-syntax/src/Unison/Parser/Ann.hs | 21 +++++++++++++++++++++ unison-syntax/src/Unison/Syntax/Lexer.hs | 5 +++++ unison-syntax/src/Unison/Syntax/Parser.hs | 16 ++-------------- 3 files changed, 28 insertions(+), 14 deletions(-) diff --git a/unison-syntax/src/Unison/Parser/Ann.hs b/unison-syntax/src/Unison/Parser/Ann.hs index feec96279c..961bbcb30c 100644 --- a/unison-syntax/src/Unison/Parser/Ann.hs +++ b/unison-syntax/src/Unison/Parser/Ann.hs @@ -4,7 +4,10 @@ module Unison.Parser.Ann where +import Data.List.NonEmpty (NonEmpty) +import Data.Void (absurd) import Unison.Lexer.Pos qualified as L +import Unison.Prelude data Ann = -- Used for things like Builtins which don't have a source position. @@ -79,3 +82,21 @@ encompasses (GeneratedFrom ann) other = encompasses ann other encompasses ann (GeneratedFrom other) = encompasses ann other encompasses (Ann start1 end1) (Ann start2 end2) = Just $ start1 <= start2 && end1 >= end2 + +class Annotated a where + ann :: a -> Ann + +instance Annotated Ann where + ann = id + +instance (Annotated a) => Annotated [a] where + ann = foldMap ann + +instance (Annotated a) => Annotated (NonEmpty a) where + ann = foldMap ann + +instance (Annotated a) => Annotated (Maybe a) where + ann = foldMap ann + +instance Annotated Void where + ann = absurd diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 77c91b8e84..fa169e2d06 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Unison.Syntax.Lexer ( Token (..), @@ -51,6 +52,7 @@ import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment (docSegment) import Unison.NameSegment.Internal qualified as NameSegment +import Unison.Parser.Ann (Ann (Ann), Annotated (..)) import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH @@ -64,6 +66,9 @@ import Unison.Syntax.ShortHash qualified as ShortHash (shortHashP) import Unison.Util.Bytes qualified as Bytes import Unison.Util.Monoid (intercalateMap) +instance Annotated (Token a) where + ann (Token _ s e) = Ann s e + type BlockName = String type Layout = [(BlockName, Column)] diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index affab5bf2c..4945f4347e 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -1,4 +1,5 @@ {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Unison.Syntax.Parser ( Annotated (..), @@ -77,7 +78,7 @@ import Unison.Hashable qualified as Hashable import Unison.Name as Name import Unison.Names (Names) import Unison.Names.ResolutionResult qualified as Names -import Unison.Parser.Ann (Ann (..)) +import Unison.Parser.Ann (Ann (..), Annotated (..)) import Unison.Pattern (Pattern) import Unison.Pattern qualified as Pattern import Unison.Prelude @@ -177,25 +178,12 @@ newtype Input = Input {inputStream :: [L.Token L.Lexeme]} deriving stock (Eq, Ord, Show) deriving newtype (P.Stream, P.VisualStream) -class Annotated a where - ann :: a -> Ann - -instance Annotated Ann where - ann = id - -instance Annotated (L.Token a) where - ann (L.Token _ s e) = Ann s e - instance (Annotated a) => Annotated (ABT.Term f v a) where ann = ann . ABT.annotation instance (Annotated a) => Annotated (Pattern a) where ann = ann . Pattern.loc -instance (Annotated a) => Annotated [a] where - ann [] = mempty - ann (h : t) = foldl' (\acc a -> acc <> ann a) (ann h) t - instance (Annotated a, Annotated b) => Annotated (MatchCase a b) where ann (MatchCase p _ b) = ann p <> ann b From 5f87b4152739662e20120810ee0525228f9a3363 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 1 Jul 2024 21:11:53 -0600 Subject: [PATCH 505/631] Un-hiding the `Doc` parser MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `doc2` was a parser in lexer’s clothing. It would parse recursively, but then return the result as a flat list of tokens. This separates the parsing from the “unparsing” (which returns the tokens), so now we have a parser to a recursive `Doc` structure. This currently immediately applies the unparser, and should result in an identical stream of tokens as the previous version. Eventually, we should be able to avoid unparsing the `Doc` structure. --- unison-syntax/package.yaml | 1 + unison-syntax/src/Unison/Syntax/Lexer.hs | 451 ++++++++++++++++------- unison-syntax/unison-syntax.cabal | 2 + 3 files changed, 330 insertions(+), 124 deletions(-) diff --git a/unison-syntax/package.yaml b/unison-syntax/package.yaml index 8e1a478baf..ccb1a057d7 100644 --- a/unison-syntax/package.yaml +++ b/unison-syntax/package.yaml @@ -10,6 +10,7 @@ dependencies: - containers - cryptonite - extra + - free - lens - megaparsec - mtl diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index fa169e2d06..fd27118050 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -8,6 +8,16 @@ module Unison.Syntax.Lexer Err (..), Pos (..), Lexeme (..), + DocTree, + DocUntitledSection (..), + DocTop (..), + DocColumn (..), + DocLeaf (..), + DocEmbedLink (..), + DocSourceElement (..), + DocEmbedSignatureLink (..), + DocJoin (..), + DocEmbedAnnotation (..), lexer, escapeChars, debugFileLex, @@ -28,16 +38,19 @@ module Unison.Syntax.Lexer ) where +import Control.Comonad.Cofree (Cofree ((:<))) import Control.Monad.State qualified as S import Data.Char (isAlphaNum, isControl, isDigit, isSpace, ord, toLower) import Data.Foldable qualified as Foldable import Data.List qualified as List import Data.List.Extra qualified as List +import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as Nel import Data.List.NonEmpty qualified as NonEmpty import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text +import Data.Void (vacuous) import GHC.Exts (sortWith) import Text.Megaparsec qualified as P import Text.Megaparsec.Char (char) @@ -52,7 +65,7 @@ import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment (docSegment) import Unison.NameSegment.Internal qualified as NameSegment -import Unison.Parser.Ann (Ann (Ann), Annotated (..)) +import Unison.Parser.Ann (Ann (Ann, GeneratedFrom), Annotated (..)) import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH @@ -66,6 +79,9 @@ import Unison.Syntax.ShortHash qualified as ShortHash (shortHashP) import Unison.Util.Bytes qualified as Bytes import Unison.Util.Monoid (intercalateMap) +instance (Annotated a) => Annotated (Cofree f a) where + ann (a :< _) = ann a + instance Annotated (Token a) where ann (Token _ s e) = Ann s e @@ -418,11 +434,9 @@ doc2 = do void $ lit "{{" openEnd <- posP CP.space - -- Construct the token for opening the doc block. - let openTok = Token (Open "syntax.docUntitledSection") openStart openEnd env0 <- S.get -- Disable layout while parsing the doc block and reset the section number - (bodyToks0, closeTok) <- local + (docToks, closeTok) <- local ( \env -> env { inLayout = False, @@ -430,33 +444,30 @@ doc2 = do } ) do - bodyToks <- docBody + bodyToks <- docBody (lit "}}") closeStart <- posP lit "}}" closeEnd <- posP - pure (bodyToks, Token Close closeStart closeEnd) - let docToks = beforeStartToks <> [openTok] <> bodyToks0 <> [closeTok] + pure (docToLexemes (openStart, closeEnd) bodyToks, Token Close closeStart closeEnd) -- Parse any layout tokens after the doc block, e.g. virtual semicolon endToks <- token' ignore (pure ()) -- Hack to allow anonymous doc blocks before type decls -- {{ Some docs }} Foo.doc = {{ Some docs }} -- ability Foo where => ability Foo where tn <- subsequentTypeName - pure $ case (tn) of - -- If we're followed by a type, we rewrite the doc block to be a named doc block. - (Just (WordyId tname)) - | isTopLevel -> - beforeStartToks - <> [WordyId (HQ'.fromName (Name.snoc (HQ'.toName tname) NameSegment.docSegment)) <$ openTok, Open "=" <$ openTok] - <> [openTok] - <> bodyToks0 - <> [closeTok] - -- We need an extra 'Close' here because we added an extra Open above. - <> [closeTok] - <> endToks - where - isTopLevel = length (layout env0) + maybe 0 (const 1) (opening env0) == 1 - _ -> docToks <> endToks + pure $ + beforeStartToks <> case (tn) of + -- If we're followed by a type, we rewrite the doc block to be a named doc block. + Just (WordyId tname) + | isTopLevel -> + Token (WordyId (HQ'.fromName (Name.snoc (HQ'.toName tname) NameSegment.docSegment))) openStart openEnd + : Token (Open "=") openStart openEnd + : docToks + -- We need an extra 'Close' here because we added an extra Open above. + <> (closeTok : endToks) + where + isTopLevel = length (layout env0) + maybe 0 (const 1) (opening env0) == 1 + _ -> docToks <> endToks where -- DUPLICATED wordyKw kw = separated wordySep (lit kw) @@ -481,17 +492,221 @@ doc2 = do where ok s = length [() | '\n' <- s] < 2 +-- | Like `P.some`, but returns an actual `NonEmpty`. +some' :: P a -> P (NonEmpty a) +some' p = liftA2 (:|) p $ many p + +-- | Like `P.someTill`, but returns an actual `NonEmpty`. +someTill' :: P a -> P end -> P (NonEmpty a) +someTill' p end = liftA2 (:|) p $ P.manyTill p end + +-- | Like `P.sepBy1`, but returns an actual `NonEmpty`. +sepBy1' :: P a -> P sep -> P (NonEmpty a) +sepBy1' p sep = liftA2 (:|) p . many $ sep *> p + +newtype DocUntitledSection a = DocUntitledSection [a] + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +-- | Haskell parallel to @unison/base.Doc@. +-- +-- This is much more restricted than @unison/base.Doc@, but it covers everything we can parse from Haskell. The +-- mismatch with Unison is a problem, as someone can create a Unison Doc with explicit constructors or function calls, +-- have it rendered to a scratch file, and then we can’t parse it. Changing the types here to match Unison wouldn’t +-- fix the issue. We have to modify the types and parser in concert (in both Haskell and Unison) to bring them in +-- line. +-- +-- __NB__: Uses of @[`Token` `Lexeme`]@ here indicate a nested transition to the Unison lexer. +data DocTop a + = -- | The first argument is always a Paragraph + DocSection a [a] + | DocEval [Token Lexeme] + | DocExampleBlock [Token Lexeme] + | DocCodeBlock (Token String) (Token String) + | DocBulletedList (NonEmpty (DocColumn a)) + | DocNumberedList (NonEmpty (Token Word64, DocColumn a)) + | DocParagraph (NonEmpty (DocLeaf a)) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +data DocColumn a + = -- | The first is always a Paragraph, and the second a Bulleted or Numbered List + DocColumn a (Maybe a) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +data DocLeaf a + = DocLink DocEmbedLink + | -- | first is a Paragraph, second is always a Group (which contains either a single Term/Type link or list of + -- Transcludes & Words) + DocNamedLink a (DocLeaf Void) + | DocExample [Token Lexeme] + | DocTransclude [Token Lexeme] + | -- | Always a Paragraph + DocBold a + | -- | Always a Paragraph + DocItalic a + | -- | Always a Paragraph + DocStrikethrough a + | -- | Always a Word + DocVerbatim (DocLeaf Void) + | -- | Always a Word + DocCode (DocLeaf Void) + | DocSource (NonEmpty DocSourceElement) + | DocFoldedSource (NonEmpty DocSourceElement) + | DocEvalInline [Token Lexeme] + | DocSignature (NonEmpty DocEmbedSignatureLink) + | DocSignatureInline DocEmbedSignatureLink + | DocWord (Token String) + | DocGroup (DocJoin a) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +data DocEmbedLink + = DocEmbedTypeLink (Token (HQ'.HashQualified Name)) + | DocEmbedTermLink (Token (HQ'.HashQualified Name)) + deriving (Eq, Ord, Show) + +data DocSourceElement = DocSourceElement DocEmbedLink [DocEmbedAnnotation] + deriving (Eq, Ord, Show) + +newtype DocEmbedSignatureLink = DocEmbedSignatureLink (Token (HQ'.HashQualified Name)) + deriving (Eq, Ord, Show) + +newtype DocJoin a = DocJoin (NonEmpty (DocLeaf a)) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +newtype DocEmbedAnnotation + = -- | Always a DocTransclude + DocEmbedAnnotation (Either (Token (HQ'.HashQualified Name)) (DocLeaf Void)) + deriving (Eq, Ord, Show) + +type DocTree = Cofree DocTop Ann + +instance (Annotated a) => Annotated (DocTop a) where + ann = \case + DocSection title body -> ann title <> ann body + DocEval code -> ann code + DocExampleBlock code -> ann code + DocCodeBlock label body -> ann label <> ann body + DocBulletedList items -> ann items + DocNumberedList items -> ann $ snd <$> items + DocParagraph leaves -> ann leaves + +instance (Annotated a) => Annotated (DocColumn a) where + ann (DocColumn para list) = ann para <> ann list + +instance (Annotated a) => Annotated (DocLeaf a) where + ann = \case + DocLink link -> ann link + DocNamedLink label target -> ann label <> ann target + DocExample code -> ann code + DocTransclude code -> ann code + DocBold para -> ann para + DocItalic para -> ann para + DocStrikethrough para -> ann para + DocVerbatim word -> ann word + DocCode word -> ann word + DocSource elems -> ann elems + DocFoldedSource elems -> ann elems + DocEvalInline code -> ann code + DocSignature links -> ann links + DocSignatureInline link -> ann link + DocWord text -> ann text + DocGroup (DocJoin leaves) -> ann leaves + +instance Annotated DocEmbedLink where + ann = \case + DocEmbedTypeLink name -> ann name + DocEmbedTermLink name -> ann name + +instance Annotated DocSourceElement where + ann (DocSourceElement link target) = ann link <> ann target + +instance Annotated DocEmbedSignatureLink where + ann (DocEmbedSignatureLink name) = ann name + +instance Annotated DocEmbedAnnotation where + ann (DocEmbedAnnotation a) = either ann ann a + +-- | This is a short-term hack to turn our parse tree back into the sequence of lexemes the current parser expects. +-- +-- The medium-term solution is to preserve @[`DocTree`]@ as its own lexeme type, and hand it to the parser without +-- flattening it back to tokens. Longer-term, maybe we add a real lexer for @Doc@, and then whatever is left of this +-- parser moves into the actual parser. +docToLexemes :: (Pos, Pos) -> DocUntitledSection DocTree -> [Token Lexeme] +docToLexemes (startDoc, endDoc) (DocUntitledSection tops) = + Token (Open "syntax.docUntitledSection") startDoc startDoc + : concatMap cata tops <> pure (Token Close endDoc endDoc) + where + wrap :: Ann -> String -> [Token Lexeme] -> [Token Lexeme] + wrap ann suffix lexemes = go (extractStart ann) lexemes + where + extractStart = \case + Ann start _ -> start + GeneratedFrom a -> extractStart a + a -> error $ "expected a good Pos! Got: " <> show a + o = "syntax.doc" <> suffix + go start [] = [Token (Open o) start start, Token Close start start] + go start ts@(Token _ x _ : _) = + Token (Open o) start x : (ts ++ [Token Close (end final) (end final)]) + where + final = last ts + cata :: DocTree -> [Token Lexeme] + cata (a :< top) = docTop a $ cata <$> top + docTop start = \case + DocSection title body -> wrap start "Section" $ title <> join body + DocEval code -> wrap start "Eval" code + DocExampleBlock code -> wrap start "ExampleBlock" code + DocCodeBlock label text -> wrap start "CodeBlock" [Textual <$> label, Textual <$> text] + DocBulletedList items -> wrap start "BulletedList" . concat $ (\col -> docColumn (ann col) col) <$> items + DocNumberedList items -> + wrap start "NumberedList" . concat $ + uncurry (:) . bimap (Numeric . show <$>) (\col -> docColumn (ann col) col) + <$> items + DocParagraph body -> wrap start "Paragraph" . concat $ (\l -> docLeaf (ann l) l) <$> body + docColumn start (DocColumn para mlist) = wrap start "Column" $ foldr (flip (<>)) para mlist + docLeaf start = \case + DocLink link -> wrap start "Link" $ docEmbedLink (ann link) link + DocNamedLink name target -> wrap start "NamedLink" $ name <> docLeaf (ann target) (vacuous target) + DocExample code -> wrap start "Example" code + DocTransclude code -> wrap start "Transclude" code + DocBold para -> wrap start "Bold" para + DocItalic para -> wrap start "Italic" para + DocStrikethrough para -> wrap start "Strikethrough" para + DocVerbatim word -> wrap start "Verbatim" . docLeaf (ann word) $ vacuous word + DocCode word -> wrap start "Code" . docLeaf (ann word) $ vacuous word + DocSource elems -> wrap start "Source" . concat $ (\e -> docSourceElement (ann e) e) <$> elems + DocFoldedSource elems -> wrap start "FoldedSource" . concat $ (\e -> docSourceElement (ann e) e) <$> elems + DocEvalInline code -> wrap start "EvalInline" code + DocSignature links -> wrap start "Signature" . concat $ (\l -> docEmbedSignatureLink (ann l) l) <$> links + DocSignatureInline link -> wrap start "SignatureInline" $ docEmbedSignatureLink (ann link) link + DocWord text -> wrap start "Word" . pure $ Textual <$> text + DocGroup (DocJoin leaves) -> + wrap start "Group" . wrap start "Join" . concat $ (\l -> docLeaf (ann l) l) <$> leaves + docEmbedLink start = \case + DocEmbedTypeLink ident -> wrap start "EmbedTypeLink" . pure $ identifierLexeme <$> ident + DocEmbedTermLink ident -> wrap start "EmbedTermLink" . pure $ identifierLexeme <$> ident + docSourceElement start (DocSourceElement link anns) = + wrap start "SourceElement" $ + docEmbedLink (ann link) link + <> maybe + [] + ((Token (Reserved "@") (Pos 0 0) (Pos 0 0) :) . concatMap (\a -> docEmbedAnnotation (ann a) a)) + (NonEmpty.nonEmpty anns) + docEmbedSignatureLink start (DocEmbedSignatureLink ident) = + wrap start "EmbedSignatureLink" . pure $ identifierLexeme <$> ident + docEmbedAnnotation start (DocEmbedAnnotation a) = + wrap start "EmbedAnnotation" $ either (pure . fmap identifierLexeme) (\l -> docLeaf (ann l) $ vacuous l) a + -- | This is the actual `Doc` lexer. Unlike `doc2`, it doesn’t do any Unison-side lexing (i.e., it doesn’t know that -- Unison wraps `Doc` literals in `}}`). -docBody :: P [Token Lexeme] -docBody = join <$> P.many (sectionElem <* CP.space) +docBody :: P end -> P (DocUntitledSection DocTree) +docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) where wordyKw kw = separated wordySep (lit kw) sectionElem = section <|> fencedBlock <|> list <|> paragraph - paragraph = wrap "syntax.docParagraph" $ join <$> spaced leaf + paragraph = wrap' . DocParagraph <$> spaced leaf reserved word = List.isPrefixOf "}}" word || all (== '#') word - wordy closing = wrap "syntax.docWord" . tok . fmap Textual . P.try $ do + wordy :: P end -> P (DocLeaf void) + wordy closing = fmap DocWord . tokenP . P.try $ do let end = P.lookAhead $ void docClose @@ -520,65 +735,61 @@ docBody = join <$> P.many (sectionElem <* CP.space) where comma = lit "," <* CP.space src = - src' "syntax.docSource" "@source" - <|> src' "syntax.docFoldedSource" "@foldedSource" + src' DocSource "@source" + <|> src' DocFoldedSource "@foldedSource" srcElem = - wrap "syntax.docSourceElement" $ - (typeLink <|> termLink) - <+> ( fmap (fromMaybe []) . P.optional $ - (tok (Reserved <$> lit "@") <+> (CP.space *> annotations)) - ) + DocSourceElement + <$> (typeLink <|> termLink) + <*> ( fmap (fromMaybe []) . P.optional $ + (lit "@") *> (CP.space *> annotations) + ) where - annotation = tok identifierLexemeP <|> expr <* CP.space + annotation = fmap Left (tokenP identifierP) <|> fmap Right expr <* CP.space annotations = - join <$> P.some (wrap "syntax.docEmbedAnnotation" annotation) - src' name atName = wrap name $ do + P.some (DocEmbedAnnotation <$> annotation) + src' name atName = fmap name $ do _ <- lit atName *> (lit " {" <|> lit "{") *> CP.space - s <- P.sepBy1 srcElem comma + s <- sepBy1' srcElem comma _ <- lit "}" - pure (join s) - signature = wrap "syntax.docSignature" $ do + pure s + signature = fmap DocSignature $ do _ <- (lit "@signatures" <|> lit "@signature") *> (lit " {" <|> lit "{") *> CP.space - s <- join <$> P.sepBy1 signatureLink comma + s <- sepBy1' signatureLink comma _ <- lit "}" pure s - signatureInline = wrap "syntax.docSignatureInline" $ do + signatureInline = fmap DocSignatureInline $ do _ <- lit "@inlineSignature" *> (lit " {" <|> lit "{") *> CP.space s <- signatureLink _ <- lit "}" pure s - evalInline = wrap "syntax.docEvalInline" $ do + evalInline = fmap DocEvalInline $ do _ <- lit "@eval" *> (lit " {" <|> lit "{") *> CP.space let inlineEvalClose = [] <$ lit "}" s <- lexemes' inlineEvalClose pure s - typeLink = wrap "syntax.docEmbedTypeLink" do + typeLink = fmap DocEmbedTypeLink $ do _ <- typeOrAbilityAlt (wordyKw . Text.unpack) <* CP.space - tok identifierLexemeP <* CP.space + tokenP identifierP <* CP.space termLink = - wrap "syntax.docEmbedTermLink" $ - tok identifierLexemeP <* CP.space + fmap DocEmbedTermLink $ + tokenP identifierP <* CP.space signatureLink = - wrap "syntax.docEmbedSignatureLink" $ - tok identifierLexemeP <* CP.space + fmap DocEmbedSignatureLink $ + tokenP identifierP <* CP.space groupy closing p = do - Token p start stop <- tokenP p + Token p _ _ <- tokenP p after <- P.optional . P.try $ leafy closing pure $ case after of Nothing -> p Just after -> - [ Token (Open "syntax.docGroup") start stop', - Token (Open "syntax.docJoin") start stop' - ] - <> p - <> after - <> (take 2 $ repeat (Token Close stop' stop')) - where - stop' = maybe stop end (lastMay after) + DocGroup + . DocJoin + $ p + :| pure after verbatim = P.label "code (examples: ''**unformatted**'', `words` or '''_words_''')" $ do @@ -595,17 +806,17 @@ docBody = join <$> P.many (sectionElem <* CP.space) let txt = trimIndentFromVerbatimBlock (column start - 1) trimmed -- If it's a multi-line verbatim block we trim any whitespace representing -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' - wrap "syntax.docVerbatim" $ - wrap "syntax.docWord" $ - pure [Token (Textual txt) start stop] + pure . DocVerbatim $ + DocWord $ + Token txt start stop else - wrap "syntax.docCode" $ - wrap "syntax.docWord" $ - pure [Token (Textual originalText) start stop] + pure . DocCode $ + DocWord $ + Token originalText start stop exampleInline = P.label "inline code (examples: ``List.map f xs``, ``[1] :+ 2``)" $ - wrap "syntax.docExample" $ do + fmap DocExample $ do n <- P.try $ do _ <- lit "`" length <$> P.takeWhile1P (Just "backticks") (== '`') @@ -613,19 +824,19 @@ docBody = join <$> P.many (sectionElem <* CP.space) ex <- CP.space *> lexemes' end pure ex - docClose = [] <$ lit "}}" + docClose = [] <$ docClose' docOpen = [] <$ lit "{{" link = P.label "link (examples: {type List}, {Nat.+})" $ - wrap "syntax.docLink" $ + fmap DocLink $ P.try $ lit "{" *> (typeLink <|> termLink) <* lit "}" expr = - P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ + fmap DocTransclude . P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ openAs "{{" "syntax.docTransclude" - <+> do + *> do env0 <- S.get -- we re-allow layout within a transclusion, then restore it to its -- previous state after @@ -637,7 +848,7 @@ docBody = join <$> P.many (sectionElem <* CP.space) ts <- lexemes' (P.lookAhead ([] <$ lit "}}")) S.modify (\env -> env {inLayout = inLayout env0}) pure ts - <+> close ["syntax.docTransclude"] (lit "}}") + <* close ["syntax.docTransclude"] (lit "}}") nonNewlineSpace ch = isSpace ch && ch /= '\n' && ch /= '\r' nonNewlineSpaces = P.takeWhileP Nothing nonNewlineSpace @@ -654,7 +865,7 @@ docBody = join <$> P.many (sectionElem <* CP.space) P.label "block eval (syntax: a fenced code block)" $ evalUnison <|> exampleBlock <|> other where - evalUnison = wrap "syntax.docEval" $ do + evalUnison = fmap (wrap' . DocEval) $ do -- commit after seeing that ``` is on its own line fence <- P.try $ do fence <- lit "```" <+> P.takeWhileP Nothing (== '`') @@ -665,7 +876,7 @@ docBody = join <$> P.many (sectionElem <* CP.space) (\env -> env {inLayout = True, opening = Just "docEval"}) (restoreStack "docEval" $ lexemes' ([] <$ lit fence)) - exampleBlock = wrap "syntax.docExampleBlock" $ do + exampleBlock = fmap (wrap' . DocExampleBlock) $ do void $ lit "@typecheck" <* CP.space fence <- lit "```" <+> P.takeWhileP Nothing (== '`') local @@ -682,20 +893,20 @@ docBody = join <$> P.many (sectionElem <* CP.space) skip _ s = s in List.intercalate "\n" $ skip column <$> lines s - other = wrap "syntax.docCodeBlock" $ do + other = fmap (uncurry $ wrapSimple2 DocCodeBlock) $ do column <- (\x -> x - 1) . toInteger . P.unPos <$> LP.indentLevel let tabWidth = toInteger . P.unPos $ P.defaultTabWidth fence <- lit "```" <+> P.takeWhileP Nothing (== '`') name <- P.takeWhileP Nothing nonNewlineSpace - *> tok (Textual <$> P.takeWhile1P Nothing (not . isSpace)) + *> tokenP (P.takeWhile1P Nothing (not . isSpace)) <* P.takeWhileP Nothing nonNewlineSpace _ <- void CP.eol verbatim <- - tok $ - Textual . uncolumn column tabWidth . trimAroundDelimiters + tokenP $ + uncolumn column tabWidth . trimAroundDelimiters <$> P.someTill P.anySingle ([] <$ lit fence) - pure (name <> verbatim) + pure (name, verbatim) boldOrItalicOrStrikethrough closing = do let start = @@ -705,30 +916,29 @@ docBody = join <$> P.many (sectionElem <* CP.space) (P.satisfy (== '~')) name s = if take 1 s == "~" - then "syntax.docStrikethrough" - else if take 1 s == "*" then "syntax.docBold" else "syntax.docItalic" + then DocStrikethrough + else if take 1 s == "*" then DocBold else DocItalic end <- P.try $ do end <- start P.lookAhead (P.satisfy (not . isSpace)) pure end - wrap (name end) . wrap "syntax.docParagraph" $ - join - <$> P.someTill - (leafy (closing <|> (void $ lit end)) <* whitespaceWithoutParagraphBreak) - (lit end) + name end . wrap' . DocParagraph + <$> someTill' + (leafy (closing <|> (void $ lit end)) <* whitespaceWithoutParagraphBreak) + (lit end) externalLink = P.label "hyperlink (example: [link name](https://destination.com))" $ - wrap "syntax.docNamedLink" $ do + fmap (uncurry DocNamedLink) $ do _ <- lit "[" p <- leafies (void $ char ']') _ <- lit "]" _ <- lit "(" target <- - wrap "syntax.docGroup" . wrap "syntax.docJoin" $ - link <|> fmap join (P.some (expr <|> wordy (char ')'))) + fmap (DocGroup . DocJoin) $ + fmap pure link <|> some' (expr <|> wordy (char ')')) _ <- lit ")" - pure (p <> target) + pure (p, target) -- newline = P.optional (lit "\r") *> lit "\n" @@ -742,15 +952,15 @@ docBody = join <$> P.many (sectionElem <* CP.space) where ok s = length [() | '\n' <- s] < 2 - spaced p = P.some (p <* P.optional sp) - leafies close = wrap "syntax.docParagraph" $ join <$> spaced (leafy close) + spaced p = some' (p <* P.optional sp) + leafies close = wrap' . DocParagraph <$> spaced (leafy close) list = bulletedList <|> numberedList - bulletedList = wrap "syntax.docBulletedList" $ join <$> P.sepBy1 bullet listSep - numberedList = wrap "syntax.docNumberedList" $ join <$> P.sepBy1 numberedItem listSep + bulletedList = wrap' . DocBulletedList <$> sepBy1' bullet listSep + numberedList = wrap' . DocNumberedList <$> sepBy1' numberedItem listSep - listSep = P.try $ newline *> nonNewlineSpaces *> P.lookAhead (bulletedStart <|> numberedStart) + listSep = P.try $ newline *> nonNewlineSpaces *> P.lookAhead (void bulletedStart <|> void numberedStart) bulletedStart = P.try $ do r <- listItemStart' $ [] <$ P.satisfy bulletChar @@ -759,6 +969,7 @@ docBody = join <$> P.many (sectionElem <* CP.space) where bulletChar ch = ch == '*' || ch == '-' || ch == '+' + listItemStart' :: P a -> P (Int, a) listItemStart' gutter = P.try $ do nonNewlineSpaces col <- column <$> posP @@ -767,14 +978,11 @@ docBody = join <$> P.many (sectionElem <* CP.space) (col,) <$> gutter numberedStart = - listItemStart' $ P.try (tok . fmap num $ LP.decimal <* lit ".") - where - num :: Word -> Lexeme - num n = Numeric (show n) + listItemStart' $ P.try (tokenP $ LP.decimal <* lit ".") - listItemParagraph = wrap "syntax.docParagraph" $ do + listItemParagraph = fmap (wrap' . DocParagraph) $ do col <- column <$> posP - join <$> P.some (leaf <* sep col) + some' (leaf <* sep col) where -- Trickiness here to support hard line breaks inside of -- a bulleted list, so for instance this parses as expected: @@ -792,29 +1000,29 @@ docBody = join <$> P.many (sectionElem <* CP.space) *> do col2 <- column <$> posP guard $ col2 >= col - (P.notFollowedBy $ numberedStart <|> bulletedStart) + (P.notFollowedBy $ void numberedStart <|> void bulletedStart) pure () numberedItem = P.label msg $ do (col, s) <- numberedStart - pure s - <+> ( wrap "syntax.docColumn" $ do + (s,) + <$> ( fmap (uncurry DocColumn) $ do p <- nonNewlineSpaces *> listItemParagraph subList <- local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> list) - pure (p <> fromMaybe [] subList) + pure (p, subList) ) where msg = "numbered list (examples: 1. item1, 8. start numbering at '8')" - bullet = wrap "syntax.docColumn" . P.label "bullet (examples: * item1, - item2)" $ do + bullet = fmap (uncurry DocColumn) . P.label "bullet (examples: * item1, - item2)" $ do (col, _) <- bulletedStart p <- nonNewlineSpaces *> listItemParagraph subList <- local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> list) - pure (p <> fromMaybe [] subList) + pure (p, subList) newline = P.label "newline" $ lit "\n" <|> lit "\r\n" @@ -828,8 +1036,8 @@ docBody = join <$> P.many (sectionElem <* CP.space) -- A paragraph under this subsection. -- # A section title (not a subsection) - section :: P [Token Lexeme] - section = wrap "syntax.docSection" $ do + section :: P DocTree + section = fmap (wrap' . uncurry DocSection) $ do ns <- S.gets parentSections hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp title <- paragraph <* CP.space @@ -837,19 +1045,13 @@ docBody = join <$> P.many (sectionElem <* CP.space) body <- local (\env -> env {parentSections = (m : (tail ns))}) $ P.many (sectionElem <* CP.space) - pure $ title <> join body + pure $ (title, body) - wrap :: String -> P [Token Lexeme] -> P [Token Lexeme] - wrap o p = do - start <- posP - lexemes <- p - pure $ go start lexemes - where - go start [] = [Token (Open o) start start, Token Close start start] - go start ts@(Token _ x _ : _) = - Token (Open o) start x : (ts ++ [Token Close (end final) (end final)]) - where - final = last ts + wrap' :: DocTop DocTree -> DocTree + wrap' doc = ann doc :< doc + + wrapSimple2 :: (Annotated a, Annotated b) => (a -> b -> DocTop DocTree) -> a -> b -> DocTree + wrapSimple2 fn a b = ann a <> ann b :< fn a b lexemes' :: P [Token Lexeme] -> P [Token Lexeme] lexemes' eof = @@ -1289,12 +1491,13 @@ identifierP = do -- .foo.++.doc -- `.`.`..` (This is a two-segment identifier without a leading dot: "." then "..") identifierLexemeP :: P Lexeme -identifierLexemeP = do - name <- identifierP - pure - if Name.isSymboly (HQ'.toName name) - then SymbolyId name - else WordyId name +identifierLexemeP = identifierLexeme <$> identifierP + +identifierLexeme :: HQ'.HashQualified Name -> Lexeme +identifierLexeme name = + if Name.isSymboly (HQ'.toName name) + then SymbolyId name + else WordyId name wordyIdSegP :: P NameSegment wordyIdSegP = diff --git a/unison-syntax/unison-syntax.cabal b/unison-syntax/unison-syntax.cabal index 888982134f..4b097e6021 100644 --- a/unison-syntax/unison-syntax.cabal +++ b/unison-syntax/unison-syntax.cabal @@ -69,6 +69,7 @@ library , containers , cryptonite , extra + , free , lens , megaparsec , mtl @@ -127,6 +128,7 @@ test-suite syntax-tests , cryptonite , easytest , extra + , free , lens , megaparsec , mtl From 227ff27cea21af3a636bb94d0ccadc80fcd37d9f Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 5 Jul 2024 14:15:05 -0600 Subject: [PATCH 506/631] =?UTF-8?q?Don=E2=80=99t=20=E2=80=9Cun-parse?= =?UTF-8?q?=E2=80=9D=20`Doc`.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This removes the layer that makes the `Doc` parser look like a lexer and replaces it with a function that converts the Doc structure directly Unison Terms. --- .../src/Unison/Syntax/TermParser.hs | 301 +++++++++--------- unison-syntax/src/Unison/Syntax/Lexer.hs | 103 ++---- unison-syntax/src/Unison/Syntax/Parser.hs | 9 +- 3 files changed, 178 insertions(+), 235 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 635a974d89..1f1dda24c1 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -12,6 +12,7 @@ module Unison.Syntax.TermParser ) where +import Control.Comonad.Cofree (Cofree ((:<))) import Control.Monad.Reader (asks, local) import Data.Char qualified as Char import Data.Foldable (foldrM) @@ -24,6 +25,7 @@ import Data.Sequence qualified as Sequence import Data.Set qualified as Set import Data.Text qualified as Text import Data.Tuple.Extra qualified as TupleE +import Data.Void (vacuous) import Text.Megaparsec qualified as P import U.Core.ABT qualified as ABT import Unison.ABT qualified as ABT @@ -38,7 +40,7 @@ import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names -import Unison.Parser.Ann (Ann) +import Unison.Parser.Ann (Ann (Ann)) import Unison.Parser.Ann qualified as Ann import Unison.Pattern (Pattern) import Unison.Pattern qualified as Pattern @@ -113,8 +115,10 @@ rewriteBlock = do pure (DD.rewriteType (ann kw <> ann rhs) (L.payload <$> vs) lhs rhs) typeLink' :: (Monad m, Var v) => P v m (L.Token Reference) -typeLink' = do - id <- hqPrefixId +typeLink' = findUniqueType =<< hqPrefixId + +findUniqueType :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> P v m (L.Token Reference) +findUniqueType id = do ns <- asks names case Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns of s @@ -434,7 +438,7 @@ resolveHashQualified tok = do names <- asks names case L.payload tok of HQ.NameOnly n -> pure $ Term.var (ann tok) (Name.toVar n) - _ -> case Names.lookupHQTerm Names.IncludeSuffixes (L.payload tok) names of + hqn -> case Names.lookupHQTerm Names.IncludeSuffixes hqn names of s | Set.null s -> failCommitted $ UnknownTerm tok s | Set.size s > 1 -> failCommitted $ UnknownTerm tok s @@ -461,160 +465,155 @@ termLeaf = doc2Block <&> \(spanAnn, trm) -> trm {ABT.annotation = ABT.annotation trm <> spanAnn} ] --- Syntax for documentation v2 blocks, which are surrounded by {{ }}. +-- | Gives a parser an explicit stream to parse, so that it consumes nothing from the original stream when it runs. +-- +-- This is used inside the `Doc` -> `Term` conversion, where we have chunks of Unison code embedded that need to be +-- parsed. It’s a consequence of parsing Doc in the midst of the Unison lexer. +subParse :: (Ord v, Monad m) => P v m a -> [L.Token L.Lexeme] -> P v m a +subParse p toks = do + orig <- P.getInput + P.setInput $ Input toks + result <- p <* P.eof + P.setInput orig + pure result + +-- | Syntax for documentation v2 blocks, which are surrounded by @{{@ @}}@. -- The lexer does most of the heavy lifting so there's not a lot for -- the parser to do. For instance, in -- --- {{ --- Hi there! --- --- goodbye. --- }} +-- > {{ +-- > Hi there! +-- > +-- > goodbye. +-- > }} -- -- the lexer will produce: -- --- [Open "syntax.docUntitledSection", --- Open "syntax.docParagraph", --- Open "syntax.docWord", Textual "Hi", Close, --- Open "syntax.docWord", Textual "there!", Close, --- Close --- Open "syntax.docParagraph", --- Open "syntax.docWord", Textual "goodbye", Close, --- Close --- Close] +-- > [ Doc +-- > ( DocUntitledSection +-- > (DocParagraph (DocWord "Hi" :| [DocWord "there!"])) +-- > (DocParagraph (DocWord "goodbye" :| [])) +-- > ) +-- > ] -- -- The parser will parse this into the Unison expression: -- --- syntax.docUntitledSection [ --- syntax.docParagraph [syntax.docWord "Hi", syntax.docWord "there!"], --- syntax.docParagraph [syntax.docWord "goodbye"] --- ] +-- > syntax.docUntitledSection [ +-- > syntax.docParagraph [syntax.docWord "Hi", syntax.docWord "there!"], +-- > syntax.docParagraph [syntax.docWord "goodbye"] +-- > ] -- --- Where `syntax.doc{Paragraph, UntitledSection,...}` are all ordinary term +-- Where @syntax.doc{Paragraph, UntitledSection,...}@ are all ordinary term -- variables that will be looked up in the environment like anything else. This -- means that the documentation syntax can have its meaning changed by --- overriding what functions the names `syntax.doc*` correspond to. +-- overriding what functions the names @syntax.doc*@ correspond to. doc2Block :: forall m v. (Monad m, Var v) => P v m (Ann {- Annotation for the whole spanning block -}, Term v Ann) doc2Block = do - P.lookAhead (openBlockWith "syntax.docUntitledSection") *> elem + L.Token docContents startDoc endDoc <- doc + let docAnn = Ann startDoc endDoc + (docAnn,) . docUntitledSection (gann docAnn) <$> traverse (cata $ docTop <=< sequenceA) docContents where - -- For terms which aren't blocks the spanning annotation is the same as the - -- term annotation. - selfAnnotated :: Term v Ann -> (Ann, Term v Ann) - selfAnnotated t = (ann t, t) - elem :: P v m (Ann {- Annotation for the whole spanning block -}, Term v Ann) - elem = - (selfAnnotated <$> text) <|> do - startTok <- openBlock - let -- here, `t` will be something like `Open "syntax.docWord"` - -- so `f` will be a term var with the name "syntax.docWord". - f = f' startTok - f' t = Term.var (ann t) (Var.nameds (L.payload t)) - - -- follows are some common syntactic forms used for parsing child elements - - -- regular is parsed into `f child1 child2 child3` for however many children - regular = do - cs <- P.many (snd <$> elem) - endTok <- closeBlock - let trm = Term.apps' f cs - pure (ann startTok <> ann endTok, trm) - - -- variadic is parsed into: `f [child1, child2, ...]` - variadic = variadic' f - variadic' f = do - cs <- P.many (snd <$> elem) - endTok <- closeBlock - let trm = Term.apps' f [Term.list (ann cs) cs] - pure (ann startTok <> ann endTok, trm) - - -- sectionLike is parsed into: `f tm [child1, child2, ...]` - sectionLike = do - arg1 <- (snd <$> elem) - cs <- P.many (snd <$> elem) - endTok <- closeBlock - let trm = Term.apps' f [arg1, Term.list (ann cs) cs] - pure (ann startTok <> ann endTok, trm) - - evalLike wrap = do - tm <- term - endTok <- closeBlock - let trm = Term.apps' f [wrap tm] - pure (ann startTok <> ann endTok, trm) - - -- converts `tm` to `'tm` - -- - -- Embedded examples like ``1 + 1`` are represented as terms, - -- but are wrapped in delays so they are left unevaluated for the - -- code which renders documents. (We want the doc display to get - -- the unevaluated expression `1 + 1` and not `2`) - addDelay tm = Term.delay (ann tm) tm - case L.payload startTok of - "syntax.docJoin" -> variadic - "syntax.docUntitledSection" -> variadic - "syntax.docColumn" -> variadic - "syntax.docParagraph" -> variadic - "syntax.docSignature" -> variadic - "syntax.docSource" -> variadic - "syntax.docFoldedSource" -> variadic - "syntax.docBulletedList" -> variadic - "syntax.docSourceAnnotations" -> variadic - "syntax.docSourceElement" -> do - link <- (snd <$> elem) - anns <- P.optional $ reserved "@" *> (snd <$> elem) - endTok <- closeBlock - let trm = Term.apps' f [link, fromMaybe (Term.list (ann link) mempty) anns] - pure (ann startTok <> ann endTok, trm) - "syntax.docNumberedList" -> do - nitems@((n, _) : _) <- P.some nitem - endTok <- closeBlock - let items = snd <$> nitems - let trm = Term.apps' f [n, Term.list (ann items) items] - pure (ann startTok <> ann endTok, trm) - where - nitem = do - n <- number - t <- openBlockWith "syntax.docColumn" - let f = f' ("syntax.docColumn" <$ t) - (_spanAnn, child) <- variadic' f - pure (n, child) - "syntax.docSection" -> sectionLike - -- @source{ type Blah, foo, type Bar } - "syntax.docEmbedTermLink" -> do - tm <- addDelay <$> (hashQualifiedPrefixTerm <|> hashQualifiedInfixTerm) - endTok <- closeBlock - let trm = Term.apps' f [tm] - pure (ann startTok <> ann endTok, trm) - "syntax.docEmbedSignatureLink" -> do - tm <- addDelay <$> (hashQualifiedPrefixTerm <|> hashQualifiedInfixTerm) - endTok <- closeBlock - let trm = Term.apps' f [tm] - pure (ann startTok <> ann endTok, trm) - "syntax.docEmbedTypeLink" -> do - r <- typeLink' - endTok <- closeBlock - let trm = Term.apps' f [Term.typeLink (ann r) (L.payload r)] - pure (ann startTok <> ann endTok, trm) - "syntax.docExample" -> do - trm <- term - endTok <- closeBlock - let spanAnn = ann startTok <> ann endTok - pure . (spanAnn,) $ case trm of - tm@(Term.Apps' _ xs) -> - let fvs = List.Extra.nubOrd $ concatMap (toList . Term.freeVars) xs - n = Term.nat (ann tm) (fromIntegral (length fvs)) - lam = addDelay $ Term.lam' (ann tm) ((Ann.GeneratedFrom spanAnn,) <$> fvs) tm - in Term.apps' f [n, lam] - tm -> Term.apps' f [Term.nat (ann tm) 0, addDelay tm] - "syntax.docTransclude" -> evalLike id - "syntax.docEvalInline" -> evalLike addDelay - "syntax.docExampleBlock" -> do - (spanAnn, tm) <- block'' False True "syntax.docExampleBlock" (pure (void startTok)) closeBlock - pure $ (spanAnn, Term.apps' f [Term.nat (ann tm) 0, addDelay tm]) - "syntax.docEval" -> do - (spanAnn, tm) <- block' False "syntax.docEval" (pure (void startTok)) closeBlock - pure $ (spanAnn, Term.apps' f [addDelay tm]) - _ -> regular + cata :: (Functor f) => (f a -> a) -> Cofree f x -> a + cata fn (_ :< fx) = fn $ cata fn <$> fx + + gann :: (Annotated a) => a -> Ann + gann = Ann.GeneratedFrom . ann + + addDelay :: Term v Ann -> Term v Ann + addDelay tm = Term.delay (ann tm) tm + + f :: (Annotated a) => a -> String -> Term v Ann + f a = Term.var (gann a) . Var.nameds . ("syntax.doc" <>) + + docUntitledSection :: Ann -> L.DocUntitledSection (Term v Ann) -> Term v Ann + docUntitledSection ann (L.DocUntitledSection tops) = + Term.app ann (f ann "UntitledSection") $ Term.list (gann tops) tops + + docTop :: L.DocTop (Term v Ann) -> TermP v m + docTop d = case d of + L.DocSection title body -> pure $ Term.apps' (f d "Section") [title, Term.list (gann body) body] + L.DocEval code -> + Term.app (gann d) (f d "Eval") . addDelay . snd + <$> subParse (block' False False "syntax.docEval" (pure $ pure ()) $ Ann.External <$ P.eof) code + L.DocExampleBlock code -> + Term.apps' (f d "ExampleBlock") . (Term.nat (gann d) 0 :) . pure . addDelay . snd + <$> subParse (block' False True "syntax.docExampleBlock" (pure $ pure ()) $ Ann.External <$ P.eof) code + L.DocCodeBlock label body -> + pure $ + Term.apps' + (f d "CodeBlock") + [Term.text (ann label) . Text.pack $ L.payload label, Term.text (ann body) . Text.pack $ L.payload body] + L.DocBulletedList items -> + pure $ Term.app (gann d) (f d "BulletedList") . Term.list (gann items) . toList $ docColumn <$> items + L.DocNumberedList items@((n, _) :| _) -> + pure $ + Term.apps' + (f d "NumberedList") + [Term.nat (ann d) $ L.payload n, Term.list (gann $ snd <$> items) . toList $ docColumn . snd <$> items] + L.DocParagraph leaves -> + Term.app (gann d) (f d "Paragraph") . Term.list (ann leaves) . toList <$> traverse docLeaf leaves + + docColumn :: L.DocColumn (Term v Ann) -> Term v Ann + docColumn d@(L.DocColumn para sublist) = + Term.app (gann d) (f d "Column") . Term.list (gann d) $ para : toList sublist + + docLeaf :: L.DocLeaf (Term v Ann) -> TermP v m + docLeaf d = case d of + L.DocLink link -> Term.app (gann d) (f d "Link") <$> docEmbedLink link + L.DocNamedLink para target -> Term.apps' (f d "NamedLink") . (para :) . pure <$> docLeaf (vacuous target) + L.DocExample code -> do + trm <- subParse term code + pure . Term.apps' (f d "Example") $ case trm of + tm@(Term.Apps' _ xs) -> + let fvs = List.Extra.nubOrd $ concatMap (toList . Term.freeVars) xs + n = Term.nat (ann tm) (fromIntegral (length fvs)) + lam = addDelay $ Term.lam' (ann tm) ((mempty,) <$> fvs) tm + in [n, lam] + tm -> [Term.nat (ann tm) 0, addDelay tm] + L.DocTransclude code -> Term.app (gann d) (f d "Transclude") <$> subParse term code + L.DocBold para -> pure $ Term.app (gann d) (f d "Bold") para + L.DocItalic para -> pure $ Term.app (gann d) (f d "Italic") para + L.DocStrikethrough para -> pure $ Term.app (gann d) (f d "Strikethrough") para + L.DocVerbatim leaf -> Term.app (gann d) (f d "Verbatim") <$> docLeaf (vacuous leaf) + L.DocCode leaf -> Term.app (gann d) (f d "Code") <$> docLeaf (vacuous leaf) + L.DocSource elems -> + Term.app (gann d) (f d "Source") . Term.list (ann elems) . toList <$> traverse docSourceElement elems + L.DocFoldedSource elems -> + Term.app (gann d) (f d "FoldedSource") . Term.list (ann elems) . toList <$> traverse docSourceElement elems + L.DocEvalInline code -> Term.app (gann d) (f d "EvalInline") . addDelay <$> subParse term code + L.DocSignature links -> + Term.app (gann d) (f d "Signature") . Term.list (ann links) . toList <$> traverse docEmbedSignatureLink links + L.DocSignatureInline link -> Term.app (gann d) (f d "SignatureInline") <$> docEmbedSignatureLink link + L.DocWord txt -> pure . Term.app (gann d) (f d "Word") . Term.text (ann txt) . Text.pack $ L.payload txt + L.DocGroup (L.DocJoin leaves) -> + Term.app (gann d) (f d "Group") . Term.app (gann d) (f d "Join") . Term.list (ann leaves) . toList + <$> traverse docLeaf leaves + + docEmbedLink :: L.DocEmbedLink -> TermP v m + docEmbedLink d = case d of + L.DocEmbedTypeLink ident -> + Term.app (gann d) (f d "EmbedTypeLink") . Term.typeLink (ann d) . L.payload + <$> findUniqueType (HQ'.toHQ <$> ident) + L.DocEmbedTermLink ident -> + Term.app (gann d) (f d "EmbedTermLink") . addDelay <$> resolveHashQualified (HQ'.toHQ <$> ident) + + docSourceElement :: L.DocSourceElement -> TermP v m + docSourceElement d@(L.DocSourceElement link anns) = do + link' <- docEmbedLink link + anns' <- traverse docEmbedAnnotation anns + pure $ Term.apps' (f d "SourceElement") [link', Term.list (ann anns) anns'] + + docEmbedSignatureLink :: L.DocEmbedSignatureLink -> TermP v m + docEmbedSignatureLink d@(L.DocEmbedSignatureLink ident) = + Term.app (gann d) (f d "EmbedSignatureLink") . addDelay <$> resolveHashQualified (HQ'.toHQ <$> ident) + + docEmbedAnnotation :: L.DocEmbedAnnotation -> TermP v m + docEmbedAnnotation d@(L.DocEmbedAnnotation a) = + -- This is the only place I’m not sure we’re doing the right thing. In the lexer, this can be an identifier or a + -- DocLeaf, but here it could be either /text/ or a Doc element. And I don’t think there’s any way the lexemes + -- produced for an identifier and the lexemes consumed for text line up. So, I think this is a bugfix I can’t + -- avoid. + Term.app (gann d) (f d "EmbedAnnotation") <$> either (resolveHashQualified . fmap HQ'.toHQ) (docLeaf . vacuous) a docBlock :: (Monad m, Var v) => TermP v m docBlock = do @@ -1143,7 +1142,7 @@ customFailure :: (P.MonadParsec e s m) => e -> m a customFailure = P.customFailure block :: forall m v. (Monad m, Var v) => String -> P v m (Ann, Term v Ann) -block s = block' False s (openBlockWith s) closeBlock +block s = block' False False s (openBlockWith s) closeBlock -- example: use Foo.bar.Baz + ++ x -- + ++ and x are called the "suffixes" of the `use` statement, and @@ -1213,24 +1212,16 @@ substImports ns imports = ] block' :: - (Monad m, Var v) => - IsTop -> - String -> - P v m (L.Token ()) -> - P v m (L.Token ()) -> - P v m (Ann {- ann which spans the whole block -}, Term v Ann) -block' isTop = block'' isTop False - -block'' :: forall m v end. (Monad m, Var v, Annotated end) => IsTop -> - Bool -> -- `True` means insert `()` at end of block if it ends with a statement + -- | `True` means insert `()` at end of block if it ends with a statement + Bool -> String -> P v m (L.Token ()) -> P v m end -> P v m (Ann {- ann which spans the whole block -}, Term v Ann) -block'' isTop implicitUnitAtEnd s openBlock closeBlock = do +block' isTop implicitUnitAtEnd s openBlock closeBlock = do open <- openBlock (names, imports) <- imports _ <- optional semi diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index fd27118050..3c5041cf6f 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -42,6 +42,7 @@ import Control.Comonad.Cofree (Cofree ((:<))) import Control.Monad.State qualified as S import Data.Char (isAlphaNum, isControl, isDigit, isSpace, ord, toLower) import Data.Foldable qualified as Foldable +import Data.Functor.Classes import Data.List qualified as List import Data.List.Extra qualified as List import Data.List.NonEmpty (NonEmpty ((:|))) @@ -50,7 +51,6 @@ import Data.List.NonEmpty qualified as NonEmpty import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text -import Data.Void (vacuous) import GHC.Exts (sortWith) import Text.Megaparsec qualified as P import Text.Megaparsec.Char (char) @@ -65,7 +65,7 @@ import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment (docSegment) import Unison.NameSegment.Internal qualified as NameSegment -import Unison.Parser.Ann (Ann (Ann, GeneratedFrom), Annotated (..)) +import Unison.Parser.Ann (Ann (Ann), Annotated (..)) import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH @@ -158,6 +158,7 @@ data Lexeme | Bytes Bytes.Bytes -- bytes literals | Hash ShortHash -- hash literals | Err Err + | Doc (DocUntitledSection DocTree) deriving stock (Eq, Show, Ord) type IsVirtual = Bool -- is it a virtual semi or an actual semi? @@ -389,6 +390,7 @@ displayLexeme = \case Bytes _b -> "bytes literal" Hash h -> Text.unpack (SH.toText h) Err e -> show e + Doc _ -> "doc structure" infixl 2 <+> @@ -436,7 +438,7 @@ doc2 = do CP.space env0 <- S.get -- Disable layout while parsing the doc block and reset the section number - (docToks, closeTok) <- local + (docTok, closeTok) <- local ( \env -> env { inLayout = False, @@ -444,16 +446,18 @@ doc2 = do } ) do - bodyToks <- docBody (lit "}}") + body <- docBody (lit "}}") closeStart <- posP lit "}}" closeEnd <- posP - pure (docToLexemes (openStart, closeEnd) bodyToks, Token Close closeStart closeEnd) + pure (Token (Doc body) openStart closeEnd, Token Close closeStart closeEnd) -- Parse any layout tokens after the doc block, e.g. virtual semicolon endToks <- token' ignore (pure ()) -- Hack to allow anonymous doc blocks before type decls -- {{ Some docs }} Foo.doc = {{ Some docs }} -- ability Foo where => ability Foo where + -- + -- __FIXME__: This should be done _after_ parsing, not in lexing. tn <- subsequentTypeName pure $ beforeStartToks <> case (tn) of @@ -462,12 +466,13 @@ doc2 = do | isTopLevel -> Token (WordyId (HQ'.fromName (Name.snoc (HQ'.toName tname) NameSegment.docSegment))) openStart openEnd : Token (Open "=") openStart openEnd - : docToks - -- We need an extra 'Close' here because we added an extra Open above. - <> (closeTok : endToks) + : docTok + -- We need an extra 'Close' here because we added an extra Open above. + : closeTok + : endToks where isTopLevel = length (layout env0) + maybe 0 (const 1) (opening env0) == 1 - _ -> docToks <> endToks + _ -> docTok : endToks where -- DUPLICATED wordyKw kw = separated wordySep (lit kw) @@ -527,6 +532,15 @@ data DocTop a | DocParagraph (NonEmpty (DocLeaf a)) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) +instance Eq1 DocTop where + liftEq _ _ _ = True + +instance Ord1 DocTop where + liftCompare _ _ _ = LT + +instance Show1 DocTop where + liftShowsPrec _ _ _ _ x = x + data DocColumn a = -- | The first is always a Paragraph, and the second a Bulleted or Numbered List DocColumn a (Maybe a) @@ -625,76 +639,6 @@ instance Annotated DocEmbedSignatureLink where instance Annotated DocEmbedAnnotation where ann (DocEmbedAnnotation a) = either ann ann a --- | This is a short-term hack to turn our parse tree back into the sequence of lexemes the current parser expects. --- --- The medium-term solution is to preserve @[`DocTree`]@ as its own lexeme type, and hand it to the parser without --- flattening it back to tokens. Longer-term, maybe we add a real lexer for @Doc@, and then whatever is left of this --- parser moves into the actual parser. -docToLexemes :: (Pos, Pos) -> DocUntitledSection DocTree -> [Token Lexeme] -docToLexemes (startDoc, endDoc) (DocUntitledSection tops) = - Token (Open "syntax.docUntitledSection") startDoc startDoc - : concatMap cata tops <> pure (Token Close endDoc endDoc) - where - wrap :: Ann -> String -> [Token Lexeme] -> [Token Lexeme] - wrap ann suffix lexemes = go (extractStart ann) lexemes - where - extractStart = \case - Ann start _ -> start - GeneratedFrom a -> extractStart a - a -> error $ "expected a good Pos! Got: " <> show a - o = "syntax.doc" <> suffix - go start [] = [Token (Open o) start start, Token Close start start] - go start ts@(Token _ x _ : _) = - Token (Open o) start x : (ts ++ [Token Close (end final) (end final)]) - where - final = last ts - cata :: DocTree -> [Token Lexeme] - cata (a :< top) = docTop a $ cata <$> top - docTop start = \case - DocSection title body -> wrap start "Section" $ title <> join body - DocEval code -> wrap start "Eval" code - DocExampleBlock code -> wrap start "ExampleBlock" code - DocCodeBlock label text -> wrap start "CodeBlock" [Textual <$> label, Textual <$> text] - DocBulletedList items -> wrap start "BulletedList" . concat $ (\col -> docColumn (ann col) col) <$> items - DocNumberedList items -> - wrap start "NumberedList" . concat $ - uncurry (:) . bimap (Numeric . show <$>) (\col -> docColumn (ann col) col) - <$> items - DocParagraph body -> wrap start "Paragraph" . concat $ (\l -> docLeaf (ann l) l) <$> body - docColumn start (DocColumn para mlist) = wrap start "Column" $ foldr (flip (<>)) para mlist - docLeaf start = \case - DocLink link -> wrap start "Link" $ docEmbedLink (ann link) link - DocNamedLink name target -> wrap start "NamedLink" $ name <> docLeaf (ann target) (vacuous target) - DocExample code -> wrap start "Example" code - DocTransclude code -> wrap start "Transclude" code - DocBold para -> wrap start "Bold" para - DocItalic para -> wrap start "Italic" para - DocStrikethrough para -> wrap start "Strikethrough" para - DocVerbatim word -> wrap start "Verbatim" . docLeaf (ann word) $ vacuous word - DocCode word -> wrap start "Code" . docLeaf (ann word) $ vacuous word - DocSource elems -> wrap start "Source" . concat $ (\e -> docSourceElement (ann e) e) <$> elems - DocFoldedSource elems -> wrap start "FoldedSource" . concat $ (\e -> docSourceElement (ann e) e) <$> elems - DocEvalInline code -> wrap start "EvalInline" code - DocSignature links -> wrap start "Signature" . concat $ (\l -> docEmbedSignatureLink (ann l) l) <$> links - DocSignatureInline link -> wrap start "SignatureInline" $ docEmbedSignatureLink (ann link) link - DocWord text -> wrap start "Word" . pure $ Textual <$> text - DocGroup (DocJoin leaves) -> - wrap start "Group" . wrap start "Join" . concat $ (\l -> docLeaf (ann l) l) <$> leaves - docEmbedLink start = \case - DocEmbedTypeLink ident -> wrap start "EmbedTypeLink" . pure $ identifierLexeme <$> ident - DocEmbedTermLink ident -> wrap start "EmbedTermLink" . pure $ identifierLexeme <$> ident - docSourceElement start (DocSourceElement link anns) = - wrap start "SourceElement" $ - docEmbedLink (ann link) link - <> maybe - [] - ((Token (Reserved "@") (Pos 0 0) (Pos 0 0) :) . concatMap (\a -> docEmbedAnnotation (ann a) a)) - (NonEmpty.nonEmpty anns) - docEmbedSignatureLink start (DocEmbedSignatureLink ident) = - wrap start "EmbedSignatureLink" . pure $ identifierLexeme <$> ident - docEmbedAnnotation start (DocEmbedAnnotation a) = - wrap start "EmbedAnnotation" $ either (pure . fmap identifierLexeme) (\l -> docLeaf (ann l) $ vacuous l) a - -- | This is the actual `Doc` lexer. Unlike `doc2`, it doesn’t do any Unison-side lexing (i.e., it doesn’t know that -- Unison wraps `Doc` literals in `}}`). docBody :: P end -> P (DocUntitledSection DocTree) @@ -1741,6 +1685,7 @@ instance P.VisualStream [Token Lexeme] where pretty Close = "" pretty (Semi True) = "" pretty (Semi False) = ";" + pretty (Doc d) = show d pad (Pos line1 col1) (Pos line2 col2) = if line1 == line2 then replicate (col2 - col1) ' ' diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 4945f4347e..733ecc93cf 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -5,7 +5,8 @@ module Unison.Syntax.Parser ( Annotated (..), Err, Error (..), - Input, + -- FIXME: Don’t export the data constructor + Input (..), P, ParsingEnv (..), UniqueName, @@ -16,6 +17,7 @@ module Unison.Syntax.Parser chainr1, character, closeBlock, + doc, failCommitted, failureIf, hqInfixId, @@ -393,6 +395,11 @@ string = queryToken getString getString (L.Textual s) = Just (Text.pack s) getString _ = Nothing +doc :: (Ord v) => P v m (L.Token (L.DocUntitledSection L.DocTree)) +doc = queryToken \case + L.Doc d -> pure d + _ -> Nothing + -- | Parses a tuple of 'a's, or a single parenthesized 'a' -- -- returns the result of combining elements with 'pair', alongside the annotation containing From 159ea3a433ad18a30af64984673fede127866def Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 22 Jul 2024 15:03:00 -0600 Subject: [PATCH 507/631] Extract `preParse` from `lexer` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit After running the core of the lexer, the `lexer` function then does some work to turn the stream into a tree, and reorder some lexemes. It then throws away the tree structure. This is the first step of preserving the tree structure for the parser. It extracts the “pre-parser” from `lexer` so that it can eventually be used _after_ the lexer, rather than internally. This also moves `fixup` to be applied on each block as we reorder it, rather than across the entire stream at the end (since the goal is to not _have_ an entire stream any more). --- unison-syntax/src/Unison/Syntax/Lexer.hs | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 3c5041cf6f..fd48d6abb3 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -1564,7 +1564,7 @@ stanzas = go [] -- Moves type and ability declarations to the front of the token stream -- and move `use` statements to the front of each block reorder :: [T (Token Lexeme)] -> [T (Token Lexeme)] -reorder = join . sortWith f . stanzas +reorder = foldr fixup [] . join . sortWith f . stanzas where f [] = 3 :: Int f (t0 : _) = case payload $ headToken t0 of @@ -1572,16 +1572,17 @@ reorder = join . sortWith f . stanzas Open typOrA | Set.member (Text.pack typOrA) typeOrAbility -> 1 Reserved "use" -> 0 _ -> 3 :: Int + -- after reordering can end up with trailing semicolon at the end of + -- a block, which we remove with this pass + fixup (payload . headToken -> Semi _) [] = [] + fixup tok tail = tok : tail + +-- | This turns the lexeme stream into a tree, reordering some lexeme subsequences. +preParse :: [Token Lexeme] -> T (Token Lexeme) +preParse = reorderTree reorder . tree lexer :: String -> String -> [Token Lexeme] -lexer scope rem = - let t = tree $ lexer0' scope rem - -- after reordering can end up with trailing semicolon at the end of - -- a block, which we remove with this pass - fixup ((payload -> Semi _) : t@(payload -> Close) : tl) = t : fixup tl - fixup [] = [] - fixup (h : t) = h : fixup t - in fixup . toList $ reorderTree reorder t +lexer scope = toList . preParse . lexer0' scope isDelayOrForce :: Char -> Bool isDelayOrForce op = op == '\'' || op == '!' From 32472bd9e01cb87ac310f375a199e44800c05b9a Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 24 Jul 2024 19:46:17 -0600 Subject: [PATCH 508/631] Allow EOF to close layout blocks This removes the need to pad the lexer stream with trailing `Close` lexemes. If EOF is reached, the parser will automatically close any layout blocks (but not context-free blocks). --- .../src/Unison/Syntax/TermParser.hs | 25 +++--- .../reparses-with-same-hash.u | 2 +- .../transcripts/error-messages.output.md | 2 + unison-syntax/src/Unison/Syntax/Lexer.hs | 87 ++++++++++--------- unison-syntax/src/Unison/Syntax/Parser.hs | 6 ++ 5 files changed, 71 insertions(+), 51 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 1f1dda24c1..999d5658ba 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -103,7 +103,7 @@ rewriteBlock = do rewriteTermlike kw mk = do kw <- quasikeyword kw lhs <- term - (_spanAnn, rhs) <- block "==>" + (_spanAnn, rhs) <- layoutBlock "==>" pure (mk (ann kw <> ann rhs) lhs rhs) rewriteTerm = rewriteTermlike "term" DD.rewriteTerm rewriteCase = rewriteTermlike "case" DD.rewriteCase @@ -164,13 +164,13 @@ match :: (Monad m, Var v) => TermP v m match = do start <- openBlockWith "match" scrutinee <- term - _ <- closeBlock + _ <- optionalCloseBlock _ <- P.try (openBlockWith "with") <|> do t <- anyToken P.customFailure (ExpectedBlockOpen "with" t) (_arities, cases) <- NonEmpty.unzip <$> matchCases1 start - _ <- closeBlock + _ <- optionalCloseBlock pure $ Term.match (ann start <> ann (NonEmpty.last cases)) @@ -212,10 +212,10 @@ matchCase = do [ Nothing <$ P.try (quasikeyword "otherwise"), Just <$> infixAppOrBooleanOp ] - (_spanAnn, t) <- block "->" + (_spanAnn, t) <- layoutBlock "->" pure (guard, t) let unguardedBlock = label "case match" do - (_spanAnn, t) <- block "->" + (_spanAnn, t) <- layoutBlock "->" pure (Nothing, t) -- a pattern's RHS is either one or more guards, or a single unguarded block. guardsAndBlocks <- guardedBlocks <|> (pure @[] <$> unguardedBlock) @@ -357,10 +357,10 @@ lam p = label "lambda" $ mkLam <$> P.try (some prefixDefinitionName <* reserved in Term.lam' (ann (head vs) <> ann b) annotatedArgs b letBlock, handle, ifthen :: (Monad m, Var v) => TermP v m -letBlock = label "let" $ (snd <$> block "let") +letBlock = label "let" $ (snd <$> layoutBlock "let") handle = label "handle" do (handleSpan, b) <- block "handle" - (_withSpan, handler) <- block "with" + (_withSpan, handler) <- layoutBlock "with" -- We don't use the annotation span from 'with' here because it will -- include a dedent if it's at the end of block. -- Meaning the newline gets overwritten when pretty-printing and it messes things up. @@ -377,7 +377,7 @@ lamCase = do start <- openBlockWith "cases" cases <- matchCases1 start (arity, cases) <- checkCasesArities cases - _ <- closeBlock + _ <- optionalCloseBlock lamvars <- replicateM arity (Parser.uniqueName 10) let vars = Var.named <$> [tweak v i | (v, i) <- lamvars `zip` [(1 :: Int) ..]] @@ -396,7 +396,7 @@ ifthen = label "if" do start <- peekAny (_spanAnn, c) <- block "if" (_spanAnn, t) <- block "then" - (_spanAnn, f) <- block "else" + (_spanAnn, f) <- layoutBlock "else" pure $ Term.iff (ann start <> ann f) c t f text :: (Var v) => TermP v m @@ -987,7 +987,7 @@ delayQuote = P.label "quote" do delayBlock :: (Monad m, Var v) => P v m (Ann {- Ann spanning the whole block -}, Term v Ann) delayBlock = P.label "do" do - (spanAnn, b) <- block "do" + (spanAnn, b) <- layoutBlock "do" let argSpan = (ann b {- would be nice to use the annotation for 'do' here, but it's not terribly important -}) pure $ (spanAnn, DD.delayTerm (ann b) argSpan b) @@ -1074,7 +1074,7 @@ destructuringBind = do let boundVars' = snd <$> boundVars _ <- P.lookAhead (openBlockWith "=") pure (p, boundVars') - (_spanAnn, scrute) <- block "=" -- Dwight K. Scrute ("The People's Scrutinee") + (_spanAnn, scrute) <- layoutBlock "=" -- Dwight K. Scrute ("The People's Scrutinee") let guard = Nothing let absChain vs t = foldr (\v t -> ABT.abs' (ann t) v t) t vs thecase t = Term.MatchCase p (fmap (absChain boundVars) guard) $ absChain boundVars t @@ -1144,6 +1144,9 @@ customFailure = P.customFailure block :: forall m v. (Monad m, Var v) => String -> P v m (Ann, Term v Ann) block s = block' False False s (openBlockWith s) closeBlock +layoutBlock :: forall m v. (Monad m, Var v) => String -> P v m (Ann, Term v Ann) +layoutBlock s = block' False False s (openBlockWith s) optionalCloseBlock + -- example: use Foo.bar.Baz + ++ x -- + ++ and x are called the "suffixes" of the `use` statement, and -- `Foo.bar.Baz` is called the prefix. A `use` statement has the effect diff --git a/unison-src/transcripts-round-trip/reparses-with-same-hash.u b/unison-src/transcripts-round-trip/reparses-with-same-hash.u index 98fbe28a57..5d75eff442 100644 --- a/unison-src/transcripts-round-trip/reparses-with-same-hash.u +++ b/unison-src/transcripts-round-trip/reparses-with-same-hash.u @@ -542,7 +542,7 @@ fix_4384d = {{ {{ docExampleBlock 0 '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17, fix_4384e = id : x -> x id x = x - {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0) }} }} + {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0)) }} }} fnApplicationSyntax = Environment.default = do 1 + 1 diff --git a/unison-src/transcripts/error-messages.output.md b/unison-src/transcripts/error-messages.output.md index 0b3e334aa6..03e7e652ac 100644 --- a/unison-src/transcripts/error-messages.output.md +++ b/unison-src/transcripts/error-messages.output.md @@ -290,6 +290,7 @@ x = match Some a with I was surprised to find a -> here. I was expecting one of these instead: + * end of input * newline or semicolon ``` @@ -312,6 +313,7 @@ x = match Some a with I was surprised to find a '|' here. I was expecting one of these instead: + * end of input * newline or semicolon ``` diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index fd48d6abb3..2ca3dc3738 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -288,9 +288,9 @@ showErrorFancy = \case GT -> "greater than " P.ErrorCustom a -> P.showErrorComponent a -lexer0' :: String -> String -> [Token Lexeme] -lexer0' scope rem = - case flip S.evalState env0 $ P.runParserT lexemes scope rem of +lexer :: String -> String -> [Token Lexeme] +lexer scope rem = + case flip S.evalState env0 $ P.runParserT (lexemes eof) scope rem of Left e -> let errsWithSourcePos = fst $ @@ -326,8 +326,14 @@ lexer0' scope rem = endPos = startPos & \(Pos l c) -> Pos l (c + errorLength) in [Token (Err err) startPos endPos] in errsWithSourcePos >>= errorToTokens - Right ts -> Token (Open scope) topLeftCorner topLeftCorner : tweak ts + Right ts -> postLex $ Token (Open scope) topLeftCorner topLeftCorner : ts where + eof :: P [Token Lexeme] + eof = P.try do + p <- P.eof >> posP + n <- maybe 0 (const 1) <$> S.gets opening + l <- S.gets layout + pure $ replicate (length l + n) (Token Close p p) errorItemToString :: EP.ErrorItem Char -> String errorItemToString = \case (P.Tokens ts) -> Foldable.toList ts @@ -336,28 +342,31 @@ lexer0' scope rem = customErrs es = [Err <$> e | P.ErrorCustom e <- toList es] toPos (P.SourcePos _ line col) = Pos (P.unPos line) (P.unPos col) env0 = ParsingEnv [] (Just scope) True [0] 0 - -- hacky postprocessing pass to do some cleanup of stuff that's annoying to - -- fix without adding more state to the lexer: - -- - 1+1 lexes as [1, +1], convert this to [1, +, 1] - -- - when a semi followed by a virtual semi, drop the virtual, lets you - -- write - -- foo x = action1; - -- 2 - -- - semi immediately after first Open is ignored - tweak [] = [] - tweak (h@(payload -> Semi False) : (payload -> Semi True) : t) = h : tweak t - tweak (h@(payload -> Reserved _) : t) = h : tweak t - tweak (t1 : t2@(payload -> Numeric num) : rem) - | notLayout t1 && touches t1 t2 && isSigned num = - t1 - : Token - (SymbolyId (HQ'.fromName (Name.unsafeParseText (Text.pack (take 1 num))))) - (start t2) - (inc $ start t2) - : Token (Numeric (drop 1 num)) (inc $ start t2) (end t2) - : tweak rem - tweak (h : t) = h : tweak t + +-- | hacky postprocessing pass to do some cleanup of stuff that's annoying to +-- fix without adding more state to the lexer: +-- - 1+1 lexes as [1, +1], convert this to [1, +, 1] +-- - when a semi followed by a virtual semi, drop the virtual, lets you +-- write +-- foo x = action1; +-- 2 +-- - semi immediately after first Open is ignored +tweak :: (Token Lexeme) -> [Token Lexeme] -> [Token Lexeme] +tweak h@(Token (Semi False) _ _) (Token (Semi True) _ _ : t) = h : t +-- __NB__: This case only exists to guard against the following one +tweak h@(Token (Reserved _) _ _) t = h : t +tweak t1 (t2@(Token (Numeric num) _ _) : rem) + | notLayout t1 && touches t1 t2 && isSigned num = + t1 + : Token + (SymbolyId (HQ'.fromName (Name.unsafeParseText (Text.pack (take 1 num))))) + (start t2) + (inc $ start t2) + : Token (Numeric (drop 1 num)) (inc $ start t2) (end t2) + : rem + where isSigned num = all (\ch -> ch == '-' || ch == '+') $ take 1 num +tweak h t = h : t formatTrivialError :: Set String -> Set String -> [Char] formatTrivialError unexpectedTokens expectedTokens = @@ -377,7 +386,7 @@ formatTrivialError unexpectedTokens expectedTokens = displayLexeme :: Lexeme -> String displayLexeme = \case Open o -> o - Semi True -> "end of section" + Semi True -> "end of stanza" Semi False -> "semicolon" Close -> "end of section" Reserved r -> "'" <> r <> "'" @@ -397,16 +406,6 @@ infixl 2 <+> (<+>) :: (Monoid a) => P a -> P a -> P a p1 <+> p2 = do a1 <- p1; a2 <- p2; pure (a1 <> a2) -lexemes :: P [Token Lexeme] -lexemes = lexemes' eof - where - eof :: P [Token Lexeme] - eof = P.try do - p <- P.eof >> posP - n <- maybe 0 (const 1) <$> S.gets opening - l <- S.gets layout - pure $ replicate (length l + n) (Token Close p p) - -- Runs the parser `p`, then: -- 1. resets the layout stack to be what it was before `p`. -- 2. emits enough closing tokens to reach `lbl` but not pop it. @@ -998,7 +997,14 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) wrapSimple2 fn a b = ann a <> ann b :< fn a b lexemes' :: P [Token Lexeme] -> P [Token Lexeme] -lexemes' eof = +lexemes' = + -- NB: `postLex` requires the token stream to start with an `Open`, otherwise it can’t create a `T`, so this adds one, + -- runs `postLex`, then removes it. + fmap (tail . postLex . (Token (Open "fake") mempty mempty :)) . lexemes + +-- | Consumes an entire Unison “module”. +lexemes :: P [Token Lexeme] -> P [Token Lexeme] +lexemes eof = P.optional space >> do hd <- join <$> P.manyTill toks (P.lookAhead eof) tl <- eof @@ -1581,8 +1587,11 @@ reorder = foldr fixup [] . join . sortWith f . stanzas preParse :: [Token Lexeme] -> T (Token Lexeme) preParse = reorderTree reorder . tree -lexer :: String -> String -> [Token Lexeme] -lexer scope = toList . preParse . lexer0' scope +-- | A few transformations that happen between lexing and parsing. +-- +-- All of these things should move out of the lexer, and be applied in the parse. +postLex :: [Token Lexeme] -> [Token Lexeme] +postLex = toList . preParse . foldr tweak [] isDelayOrForce :: Char -> Bool isDelayOrForce op = op == '\'' || op == '!' diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 733ecc93cf..498e460f3f 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -17,6 +17,7 @@ module Unison.Syntax.Parser chainr1, character, closeBlock, + optionalCloseBlock, doc, failCommitted, failureIf, @@ -270,6 +271,11 @@ semi = label "newline or semicolon" $ queryToken go closeBlock :: (Ord v) => P v m (L.Token ()) closeBlock = void <$> matchToken L.Close +-- | With layout, blocks might “close” without an explicit outdent (e.g., not even a newline at the end of a +-- `DocTransclude`). This allows those blocks to be closed by EOF. +optionalCloseBlock :: (Ord v) => P v m (L.Token ()) +optionalCloseBlock = closeBlock <|> (\() -> L.Token () mempty mempty) <$> P.eof + wordyPatternName :: (Var v) => P v m (L.Token v) wordyPatternName = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just $ Name.toVar n From 94065e06104b155a66fd8268e6498e0540ba5108 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 24 Jul 2024 19:54:06 -0600 Subject: [PATCH 509/631] Make comments into Haddock --- unison-syntax/src/Unison/Syntax/Lexer.hs | 13 +++--- unison-syntax/src/Unison/Syntax/Parser.hs | 55 ++++++++++++----------- 2 files changed, 34 insertions(+), 34 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 2ca3dc3738..ce2d63b564 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -90,17 +90,16 @@ type BlockName = String type Layout = [(BlockName, Column)] data ParsingEnv = ParsingEnv - { -- layout stack + { -- | layout stack layout :: !Layout, - -- `Just b` if a block of type `b` is being opened + -- | `Just b` if a block of type `b` is being opened opening :: Maybe BlockName, - -- are we inside a construct that uses layout? + -- | are we inside a construct that uses layout? inLayout :: Bool, - -- Use a stack to remember the parent section and - -- allow docSections within docSections. - -- 1 means we are inside a # Heading 1 + -- | Use a stack to remember the parent section and allow docSections within docSections. + -- - 1 means we are inside a # Heading 1 parentSections :: [Int], - -- 4 means we are inside a list starting at the fourth column + -- | 4 means we are inside a list starting at the fourth column parentListColumn :: Int } deriving (Show) diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 498e460f3f..e12a2a94c4 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -158,19 +158,20 @@ data Error v | UnknownType (L.Token (HQ.HashQualified Name)) (Set Reference) | UnknownId (L.Token (HQ.HashQualified Name)) (Set Referent) (Set Reference) | ExpectedBlockOpen String (L.Token L.Lexeme) - | -- Indicates a cases or match/with which doesn't have any patterns + | -- | Indicates a cases or match/with which doesn't have any patterns EmptyMatch (L.Token ()) | EmptyWatch Ann | UseInvalidPrefixSuffix (Either (L.Token Name) (L.Token Name)) (Maybe [L.Token Name]) | UseEmpty (L.Token String) -- an empty `use` statement | DidntExpectExpression (L.Token L.Lexeme) (Maybe (L.Token L.Lexeme)) | TypeDeclarationErrors [UF.Error v Ann] - | -- MissingTypeModifier (type|ability) name + | -- | MissingTypeModifier (type|ability) name MissingTypeModifier (L.Token String) (L.Token v) | ResolutionFailures [Names.ResolutionFailure v Ann] | DuplicateTypeNames [(v, [Ann])] | DuplicateTermNames [(v, [Ann])] - | PatternArityMismatch Int Int Ann -- PatternArityMismatch expectedArity actualArity location + | -- | PatternArityMismatch expectedArity actualArity location + PatternArityMismatch Int Int Ann | FloatPattern Ann deriving (Show, Eq, Ord) @@ -242,11 +243,11 @@ run' p s name env = run :: (Monad m, Ord v) => P v m a -> String -> ParsingEnv m -> m (Either (Err v) a) run p s = run' p s "" --- Virtual pattern match on a lexeme. +-- | Virtual pattern match on a lexeme. queryToken :: (Ord v) => (L.Lexeme -> Maybe a) -> P v m (L.Token a) queryToken f = P.token (traverse f) Set.empty --- Consume a block opening and return the string that opens the block. +-- | Consume a block opening and return the string that opens the block. openBlock :: (Ord v) => P v m (L.Token String) openBlock = queryToken getOpen where @@ -256,23 +257,23 @@ openBlock = queryToken getOpen openBlockWith :: (Ord v) => String -> P v m (L.Token ()) openBlockWith s = void <$> P.satisfy ((L.Open s ==) . L.payload) --- Match a particular lexeme exactly, and consume it. +-- | Match a particular lexeme exactly, and consume it. matchToken :: (Ord v) => L.Lexeme -> P v m (L.Token L.Lexeme) matchToken x = P.satisfy ((==) x . L.payload) --- Consume a virtual semicolon +-- | Consume a virtual semicolon semi :: (Ord v) => P v m (L.Token ()) semi = label "newline or semicolon" $ queryToken go where go (L.Semi _) = Just () go _ = Nothing --- Consume the end of a block +-- | Consume the end of a block closeBlock :: (Ord v) => P v m (L.Token ()) closeBlock = void <$> matchToken L.Close -- | With layout, blocks might “close” without an explicit outdent (e.g., not even a newline at the end of a --- `DocTransclude`). This allows those blocks to be closed by EOF. +-- `DocTransclude`). This allows those blocks to be closed by EOF. optionalCloseBlock :: (Ord v) => P v m (L.Token ()) optionalCloseBlock = closeBlock <|> (\() -> L.Token () mempty mempty) <$> P.eof @@ -281,13 +282,13 @@ wordyPatternName = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just $ Name.toVar n _ -> Nothing --- Parse an prefix identifier e.g. Foo or (+), discarding any hash +-- | Parse a prefix identifier e.g. Foo or (+), discarding any hash prefixDefinitionName :: (Var v) => P v m (L.Token v) prefixDefinitionName = wordyDefinitionName <|> parenthesize symbolyDefinitionName --- Parse a prefix identifier e.g. Foo or (+), rejecting any hash --- This is useful for term declarations, where type signatures and term names should not have hashes. +-- | Parse a prefix identifier e.g. Foo or (+), rejecting any hash +-- This is useful for term declarations, where type signatures and term names should not have hashes. prefixTermName :: (Var v) => P v m (L.Token v) prefixTermName = wordyTermName <|> parenthesize symbolyTermName where @@ -299,34 +300,34 @@ prefixTermName = wordyTermName <|> parenthesize symbolyTermName L.SymbolyId (HQ'.NameOnly n) -> Just $ Name.toVar n _ -> Nothing --- Parse a wordy identifier e.g. Foo, discarding any hash +-- | Parse a wordy identifier e.g. Foo, discarding any hash wordyDefinitionName :: (Var v) => P v m (L.Token v) wordyDefinitionName = queryToken $ \case L.WordyId n -> Just $ Name.toVar (HQ'.toName n) L.Blank s -> Just $ Var.nameds ("_" <> s) _ -> Nothing --- Parse a wordyId as a Name, rejecting any hash +-- | Parse a wordyId as a Name, rejecting any hash importWordyId :: (Ord v) => P v m (L.Token Name) importWordyId = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just n L.Blank s | not (null s) -> Just $ Name.unsafeParseText (Text.pack ("_" <> s)) _ -> Nothing --- The `+` in: use Foo.bar + as a Name +-- | The `+` in: use Foo.bar + as a Name importSymbolyId :: (Ord v) => P v m (L.Token Name) importSymbolyId = queryToken \case L.SymbolyId (HQ'.NameOnly n) -> Just n _ -> Nothing --- Parse a symboly ID like >>= or &&, discarding any hash +-- | Parse a symboly ID like >>= or &&, discarding any hash symbolyDefinitionName :: (Var v) => P v m (L.Token v) symbolyDefinitionName = queryToken $ \case L.SymbolyId n -> Just $ Name.toVar (HQ'.toName n) _ -> Nothing -- | Expect parentheses around a token, includes the parentheses within the start/end --- annotations of the resulting token. +-- annotations of the resulting token. parenthesize :: (Ord v) => P v m (L.Token a) -> P v m (L.Token a) parenthesize p = do (start, a) <- P.try do @@ -340,7 +341,7 @@ hqPrefixId, hqInfixId :: (Ord v) => P v m (L.Token (HQ.HashQualified Name)) hqPrefixId = hqWordyId_ <|> parenthesize hqSymbolyId_ hqInfixId = hqSymbolyId_ --- Parse a hash-qualified alphanumeric identifier +-- | Parse a hash-qualified alphanumeric identifier hqWordyId_ :: (Ord v) => P v m (L.Token (HQ.HashQualified Name)) hqWordyId_ = queryToken \case L.WordyId n -> Just $ HQ'.toHQ n @@ -348,20 +349,20 @@ hqWordyId_ = queryToken \case L.Blank s | not (null s) -> Just $ HQ.NameOnly (Name.unsafeParseText (Text.pack ("_" <> s))) _ -> Nothing --- Parse a hash-qualified symboly ID like >>=#foo or && +-- | Parse a hash-qualified symboly ID like >>=#foo or && hqSymbolyId_ :: (Ord v) => P v m (L.Token (HQ.HashQualified Name)) hqSymbolyId_ = queryToken \case L.SymbolyId n -> Just (HQ'.toHQ n) _ -> Nothing --- Parse a reserved word +-- | Parse a reserved word reserved :: (Ord v) => String -> P v m (L.Token String) reserved w = label w $ queryToken getReserved where getReserved (L.Reserved w') | w == w' = Just w getReserved _ = Nothing --- Parse a placeholder or typed hole +-- | Parse a placeholder or typed hole blank :: (Ord v) => P v m (L.Token String) blank = label "blank" $ queryToken getBlank where @@ -436,12 +437,12 @@ chainr1 p op = go1 go1 = p >>= go2 go2 hd = do { op <- op; op hd <$> go1 } <|> pure hd --- Parse `p` 1+ times, combining with `op` +-- | Parse `p` 1+ times, combining with `op` chainl1 :: (Ord v) => P v m a -> P v m (a -> a -> a) -> P v m a chainl1 p op = foldl (flip ($)) <$> p <*> P.many (flip <$> op <*> p) --- If `p` would succeed, this fails uncommitted. --- Otherwise, `failIfOk` used to produce the output +-- | If `p` would succeed, this fails uncommitted. +-- Otherwise, `failIfOk` used to produce the output failureIf :: (Ord v) => P v m (P v m b) -> P v m a -> P v m b failureIf failIfOk p = do dontwant <- P.try . P.lookAhead $ failIfOk @@ -449,9 +450,9 @@ failureIf failIfOk p = do when (isJust p) $ fail "failureIf" dontwant --- Gives this var an id based on its position - a useful trick to --- obtain a variable whose id won't match any other id in the file --- `positionalVar a Var.missingResult` +-- | Gives this var an id based on its position - a useful trick to +-- obtain a variable whose id won't match any other id in the file +-- `positionalVar a Var.missingResult` positionalVar :: (Annotated a, Var v) => a -> v -> v positionalVar a v = let s = start (ann a) From 567238fae8dccfe399e935c919e93a363a30a03a Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 22 Jul 2024 16:44:17 -0600 Subject: [PATCH 510/631] Expose `preParse` to the parser --- parser-typechecker/src/Unison/PrintError.hs | 2 +- unison-syntax/src/Unison/Syntax/Lexer.hs | 28 ++++++++------------- unison-syntax/src/Unison/Syntax/Parser.hs | 11 +++----- unison-syntax/test/Main.hs | 4 +-- 4 files changed, 18 insertions(+), 27 deletions(-) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 5647ccde63..8b73b179f1 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -1336,7 +1336,7 @@ prettyParseError s e = lexerOutput :: Pretty (AnnotatedText a) lexerOutput = if showLexerOutput - then "\nLexer output:\n" <> fromString (L.debugLex' s) + then "\nLexer output:\n" <> fromString (L.debugPreParse' s) else mempty renderParseErrors :: diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index ce2d63b564..dc755e7c79 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -19,11 +19,11 @@ module Unison.Syntax.Lexer DocJoin (..), DocEmbedAnnotation (..), lexer, + preParse, escapeChars, - debugFileLex, - debugLex', - debugLex'', - debugLex''', + debugFilePreParse, + debugPreParse, + debugPreParse', showEscapeChar, touches, @@ -1628,14 +1628,11 @@ typeModifiersAlt f = inc :: Pos -> Pos inc (Pos line col) = Pos line (col + 1) -debugFileLex :: String -> IO () -debugFileLex file = do - contents <- readUtf8 file - let s = debugLex'' (lexer file (Text.unpack contents)) - putStrLn s +debugFilePreParse :: FilePath -> IO () +debugFilePreParse file = putStrLn . debugPreParse . preParse . lexer file . Text.unpack =<< readUtf8 file -debugLex'' :: [Token Lexeme] -> String -debugLex'' [Token (Err (UnexpectedTokens msg)) start end] = +debugPreParse :: T (Token Lexeme) -> String +debugPreParse (L (Token (Err (UnexpectedTokens msg)) start end)) = (if start == end then msg1 else msg2) <> ":\n" <> msg where msg1 = "Error on line " <> show (line start) <> ", column " <> show (column start) @@ -1648,13 +1645,10 @@ debugLex'' [Token (Err (UnexpectedTokens msg)) start end] = <> show (line end) <> ", column " <> show (column end) -debugLex'' ts = show . fmap payload . tree $ ts +debugPreParse ts = show $ payload <$> ts -debugLex' :: String -> String -debugLex' = debugLex'' . lexer "debugLex" - -debugLex''' :: String -> String -> String -debugLex''' s = debugLex'' . lexer s +debugPreParse' :: String -> String +debugPreParse' = debugPreParse . preParse . lexer "debugPreParse" instance EP.ShowErrorComponent (Token Err) where showErrorComponent (Token err _ _) = go err diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index e12a2a94c4..344de0fd1b 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -61,6 +61,7 @@ where import Control.Monad.Reader (ReaderT (..)) import Control.Monad.Reader.Class (asks) import Crypto.Random qualified as Random +import Data.Bool (bool) import Data.Bytes.Put (runPutS) import Data.Bytes.Serial (serialize) import Data.Bytes.VarInt (VarInt (..)) @@ -199,8 +200,7 @@ label = P.label traceRemainingTokens :: (Ord v) => String -> P v m () traceRemainingTokens label = do remainingTokens <- lookAhead $ many anyToken - let _ = - trace ("REMAINDER " ++ label ++ ":\n" ++ L.debugLex'' remainingTokens) () + let _ = trace ("REMAINDER " ++ label ++ ":\n" ++ L.debugPreParse (L.preParse remainingTokens)) () pure () mkAnn :: (Annotated a, Annotated b) => a -> b -> Ann @@ -231,12 +231,9 @@ rootFile p = p <* P.eof run' :: (Monad m, Ord v) => P v m a -> String -> String -> ParsingEnv m -> m (Either (Err v) a) run' p s name env = - let lex = - if debug - then L.lexer name (trace (L.debugLex''' "lexer receives" s) s) - else L.lexer name s + let lex = bool id (traceWith L.debugPreParse) debug . L.preParse $ L.lexer name s pTraced = traceRemainingTokens "parser receives" *> p - in runReaderT (runParserT pTraced name (Input lex)) env <&> \case + in runReaderT (runParserT pTraced name . Input $ toList lex) env <&> \case Left err -> Left (Nel.head (P.bundleErrors err)) Right x -> Right x diff --git a/unison-syntax/test/Main.hs b/unison-syntax/test/Main.hs index bd40c7ded8..5c13940b0a 100644 --- a/unison-syntax/test/Main.hs +++ b/unison-syntax/test/Main.hs @@ -221,8 +221,8 @@ test = t :: String -> [Lexeme] -> Test () t s expected = - let actual0 = payload <$> lexer "ignored filename" s - actual = take (length actual0 - 2) . drop 1 $ actual0 + let actual0 = payload <$> preParse (lexer "ignored filename" s) + actual = take (length actual0 - 2) . drop 1 $ toList actual0 in scope s $ if actual == expected then ok From 6c561f314628c1e8b6e77fa6c7e0118f67265a71 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 22 Jul 2024 16:45:21 -0600 Subject: [PATCH 511/631] Rename `T` to `BlockTree` --- unison-syntax/src/Unison/Syntax/Lexer.hs | 49 +++++++++++++----------- 1 file changed, 26 insertions(+), 23 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index dc755e7c79..a83d4da38b 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -1520,15 +1520,18 @@ pop = drop 1 topLeftCorner :: Pos topLeftCorner = Pos 1 1 -data T a = T a [T a] [a] | L a deriving (Functor, Foldable, Traversable) - -headToken :: T a -> a -headToken (T a _ _) = a -headToken (L a) = a - -instance (Show a) => Show (T a) where - show (L a) = show a - show (T open mid close) = +data BlockTree a + = Block a [BlockTree a] [a] + | Leaf a + deriving (Functor, Foldable, Traversable) + +headToken :: BlockTree a -> a +headToken (Block a _ _) = a +headToken (Leaf a) = a + +instance (Show a) => Show (BlockTree a) where + show (Leaf a) = show a + show (Block open mid close) = show open ++ "\n" ++ indent " " (intercalateMap "\n" show mid) @@ -1539,26 +1542,26 @@ instance (Show a) => Show (T a) where go by '\n' = '\n' : by go _ c = [c] -reorderTree :: ([T a] -> [T a]) -> T a -> T a -reorderTree _ l@(L _) = l -reorderTree f (T open mid close) = T open (f (reorderTree f <$> mid)) close +reorderTree :: ([BlockTree a] -> [BlockTree a]) -> BlockTree a -> BlockTree a +reorderTree f (Block open mid close) = Block open (f (reorderTree f <$> mid)) close +reorderTree _ l = l -tree :: [Token Lexeme] -> T (Token Lexeme) +tree :: [Token Lexeme] -> BlockTree (Token Lexeme) tree toks = one toks const where - one (open@(payload -> Open _) : ts) k = many (T open) [] ts k - one (t : ts) k = k (L t) ts + one (open@(payload -> Open _) : ts) k = many (Block open) [] ts k + one (t : ts) k = k (Leaf t) ts one [] k = k lastErr [] where - lastErr = case drop (length toks - 1) toks of - [] -> L (Token (Err LayoutError) topLeftCorner topLeftCorner) - (t : _) -> L $ t {payload = Err LayoutError} + lastErr = Leaf case drop (length toks - 1) toks of + [] -> Token (Err LayoutError) topLeftCorner topLeftCorner + (t : _) -> t {payload = Err LayoutError} many open acc [] k = k (open (reverse acc) []) [] many open acc (t@(payload -> Close) : ts) k = k (open (reverse acc) [t]) ts many open acc ts k = one ts $ \t ts -> many open (t : acc) ts k -stanzas :: [T (Token Lexeme)] -> [[T (Token Lexeme)]] +stanzas :: [BlockTree (Token Lexeme)] -> [[BlockTree (Token Lexeme)]] stanzas = go [] where go acc [] = [reverse acc] @@ -1568,7 +1571,7 @@ stanzas = go [] -- Moves type and ability declarations to the front of the token stream -- and move `use` statements to the front of each block -reorder :: [T (Token Lexeme)] -> [T (Token Lexeme)] +reorder :: [BlockTree (Token Lexeme)] -> [BlockTree (Token Lexeme)] reorder = foldr fixup [] . join . sortWith f . stanzas where f [] = 3 :: Int @@ -1583,7 +1586,7 @@ reorder = foldr fixup [] . join . sortWith f . stanzas fixup tok tail = tok : tail -- | This turns the lexeme stream into a tree, reordering some lexeme subsequences. -preParse :: [Token Lexeme] -> T (Token Lexeme) +preParse :: [Token Lexeme] -> BlockTree (Token Lexeme) preParse = reorderTree reorder . tree -- | A few transformations that happen between lexing and parsing. @@ -1631,8 +1634,8 @@ inc (Pos line col) = Pos line (col + 1) debugFilePreParse :: FilePath -> IO () debugFilePreParse file = putStrLn . debugPreParse . preParse . lexer file . Text.unpack =<< readUtf8 file -debugPreParse :: T (Token Lexeme) -> String -debugPreParse (L (Token (Err (UnexpectedTokens msg)) start end)) = +debugPreParse :: BlockTree (Token Lexeme) -> String +debugPreParse (Leaf (Token (Err (UnexpectedTokens msg)) start end)) = (if start == end then msg1 else msg2) <> ":\n" <> msg where msg1 = "Error on line " <> show (line start) <> ", column " <> show (column start) From 3158e666033b124c17ec20ff7f96549548533703 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 23 Jul 2024 13:59:12 -0600 Subject: [PATCH 512/631] Restructure `BlockTree` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit We now build the stanzas at the same time as the tree, and don’t discard them after reordering. This also changes the closing element of `Block` to be `Maybe` instead of `[]`. --- unison-syntax/src/Unison/Syntax/Lexer.hs | 50 +++++++++++++++--------- 1 file changed, 32 insertions(+), 18 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index a83d4da38b..a356757bf7 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -39,6 +39,7 @@ module Unison.Syntax.Lexer where import Control.Comonad.Cofree (Cofree ((:<))) +import Control.Lens qualified as Lens import Control.Monad.State qualified as S import Data.Char (isAlphaNum, isControl, isDigit, isSpace, ord, toLower) import Data.Foldable qualified as Foldable @@ -1521,7 +1522,13 @@ topLeftCorner :: Pos topLeftCorner = Pos 1 1 data BlockTree a - = Block a [BlockTree a] [a] + = Block + -- | The token that opens the block + a + -- | “Stanzas” of nested tokens + [[BlockTree a]] + -- | The closing token, if any + (Maybe a) | Leaf a deriving (Functor, Foldable, Traversable) @@ -1534,22 +1541,22 @@ instance (Show a) => Show (BlockTree a) where show (Block open mid close) = show open ++ "\n" - ++ indent " " (intercalateMap "\n" show mid) + ++ indent " " (intercalateMap "\n" (intercalateMap " " show) mid) ++ "\n" - ++ intercalateMap "" show close + ++ maybe "" show close where indent by s = by ++ (s >>= go by) go by '\n' = '\n' : by go _ c = [c] -reorderTree :: ([BlockTree a] -> [BlockTree a]) -> BlockTree a -> BlockTree a -reorderTree f (Block open mid close) = Block open (f (reorderTree f <$> mid)) close +reorderTree :: ([[BlockTree a]] -> [[BlockTree a]]) -> BlockTree a -> BlockTree a +reorderTree f (Block open mid close) = Block open (f (fmap (reorderTree f) <$> mid)) close reorderTree _ l = l tree :: [Token Lexeme] -> BlockTree (Token Lexeme) tree toks = one toks const where - one (open@(payload -> Open _) : ts) k = many (Block open) [] ts k + one (open@(payload -> Open _) : ts) k = many (Block open . stanzas) [] ts k one (t : ts) k = k (Leaf t) ts one [] k = k lastErr [] where @@ -1557,22 +1564,24 @@ tree toks = one toks const [] -> Token (Err LayoutError) topLeftCorner topLeftCorner (t : _) -> t {payload = Err LayoutError} - many open acc [] k = k (open (reverse acc) []) [] - many open acc (t@(payload -> Close) : ts) k = k (open (reverse acc) [t]) ts + many open acc [] k = k (open (reverse acc) Nothing) [] + many open acc (t@(payload -> Close) : ts) k = k (open (reverse acc) $ pure t) ts many open acc ts k = one ts $ \t ts -> many open (t : acc) ts k stanzas :: [BlockTree (Token Lexeme)] -> [[BlockTree (Token Lexeme)]] -stanzas = go [] - where - go acc [] = [reverse acc] - go acc (t : ts) = case payload $ headToken t of - Semi _ -> reverse (t : acc) : go [] ts - _ -> go (t : acc) ts +stanzas = + toList + . foldr + ( \tok (curr :| stanzas) -> case tok of + Leaf (Token (Semi _) _ _) -> [tok] :| curr : stanzas + _ -> (tok : curr) :| stanzas + ) + ([] :| []) -- Moves type and ability declarations to the front of the token stream -- and move `use` statements to the front of each block -reorder :: [BlockTree (Token Lexeme)] -> [BlockTree (Token Lexeme)] -reorder = foldr fixup [] . join . sortWith f . stanzas +reorder :: [[BlockTree (Token Lexeme)]] -> [[BlockTree (Token Lexeme)]] +reorder = foldr fixup [] . sortWith f where f [] = 3 :: Int f (t0 : _) = case payload $ headToken t0 of @@ -1582,8 +1591,13 @@ reorder = foldr fixup [] . join . sortWith f . stanzas _ -> 3 :: Int -- after reordering can end up with trailing semicolon at the end of -- a block, which we remove with this pass - fixup (payload . headToken -> Semi _) [] = [] - fixup tok tail = tok : tail + fixup stanza [] = case Lens.unsnoc stanza of + Nothing -> [] + -- remove any trailing `Semi` from the last non-empty stanza + Just (init, Leaf (Token (Semi _) _ _)) -> [init] + -- don’t touch other stanzas + Just (_, _) -> [stanza] + fixup stanza tail = stanza : tail -- | This turns the lexeme stream into a tree, reordering some lexeme subsequences. preParse :: [Token Lexeme] -> BlockTree (Token Lexeme) From a6f6d9c8dc35adabb6052eccb5e341b80083d317 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Wed, 24 Jul 2024 22:59:18 -0600 Subject: [PATCH 513/631] Remove unnecessary `docOpen` in Doc parser --- unison-syntax/src/Unison/Syntax/Lexer.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index a356757bf7..9f2119011a 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -653,7 +653,6 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) let end = P.lookAhead $ void docClose - <|> void docOpen <|> void (P.satisfy isSpace) <|> void closing word <- P.manyTill (P.satisfy (\ch -> not (isSpace ch))) end @@ -768,7 +767,6 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) pure ex docClose = [] <$ docClose' - docOpen = [] <$ lit "{{" link = P.label "link (examples: {type List}, {Nat.+})" $ From c53cb088e1262a2f06a81fc1dc66f685d86cc707 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 25 Jul 2024 10:28:33 -0600 Subject: [PATCH 514/631] Split `Doc` into its own module --- .../src/Unison/Syntax/TermParser.hs | 79 +++--- unison-syntax/src/Unison/Syntax/Lexer.hs | 232 ++++-------------- .../src/Unison/Syntax/Lexer/Token.hs | 4 + unison-syntax/src/Unison/Syntax/Parser.hs | 5 +- .../src/Unison/Syntax/Parser/Doc/Data.hs | 166 +++++++++++++ unison-syntax/unison-syntax.cabal | 1 + 6 files changed, 260 insertions(+), 227 deletions(-) create mode 100644 unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 999d5658ba..89d5504079 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -25,7 +25,7 @@ import Data.Sequence qualified as Sequence import Data.Set qualified as Set import Data.Text qualified as Text import Data.Tuple.Extra qualified as TupleE -import Data.Void (vacuous) +import Data.Void (absurd, vacuous) import Text.Megaparsec qualified as P import U.Core.ABT qualified as ABT import Unison.ABT qualified as ABT @@ -52,6 +52,7 @@ import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser hiding (seq) import Unison.Syntax.Parser qualified as Parser (seq, uniqueName) +import Unison.Syntax.Parser.Doc.Data qualified as Doc import Unison.Syntax.TypeParser qualified as TypeParser import Unison.Term (IsTop, Term) import Unison.Term qualified as Term @@ -525,43 +526,43 @@ doc2Block = do f :: (Annotated a) => a -> String -> Term v Ann f a = Term.var (gann a) . Var.nameds . ("syntax.doc" <>) - docUntitledSection :: Ann -> L.DocUntitledSection (Term v Ann) -> Term v Ann - docUntitledSection ann (L.DocUntitledSection tops) = + docUntitledSection :: Ann -> Doc.UntitledSection (Term v Ann) -> Term v Ann + docUntitledSection ann (Doc.UntitledSection tops) = Term.app ann (f ann "UntitledSection") $ Term.list (gann tops) tops - docTop :: L.DocTop (Term v Ann) -> TermP v m + docTop :: Doc.Top [L.Token L.Lexeme] (Term v Ann) -> TermP v m docTop d = case d of - L.DocSection title body -> pure $ Term.apps' (f d "Section") [title, Term.list (gann body) body] - L.DocEval code -> + Doc.Section title body -> pure $ Term.apps' (f d "Section") [title, Term.list (gann body) body] + Doc.Eval code -> Term.app (gann d) (f d "Eval") . addDelay . snd <$> subParse (block' False False "syntax.docEval" (pure $ pure ()) $ Ann.External <$ P.eof) code - L.DocExampleBlock code -> + Doc.ExampleBlock code -> Term.apps' (f d "ExampleBlock") . (Term.nat (gann d) 0 :) . pure . addDelay . snd <$> subParse (block' False True "syntax.docExampleBlock" (pure $ pure ()) $ Ann.External <$ P.eof) code - L.DocCodeBlock label body -> + Doc.CodeBlock label body -> pure $ Term.apps' (f d "CodeBlock") [Term.text (ann label) . Text.pack $ L.payload label, Term.text (ann body) . Text.pack $ L.payload body] - L.DocBulletedList items -> + Doc.BulletedList items -> pure $ Term.app (gann d) (f d "BulletedList") . Term.list (gann items) . toList $ docColumn <$> items - L.DocNumberedList items@((n, _) :| _) -> + Doc.NumberedList items@((n, _) :| _) -> pure $ Term.apps' (f d "NumberedList") [Term.nat (ann d) $ L.payload n, Term.list (gann $ snd <$> items) . toList $ docColumn . snd <$> items] - L.DocParagraph leaves -> + Doc.Paragraph leaves -> Term.app (gann d) (f d "Paragraph") . Term.list (ann leaves) . toList <$> traverse docLeaf leaves - docColumn :: L.DocColumn (Term v Ann) -> Term v Ann - docColumn d@(L.DocColumn para sublist) = + docColumn :: Doc.Column (Term v Ann) -> Term v Ann + docColumn d@(Doc.Column para sublist) = Term.app (gann d) (f d "Column") . Term.list (gann d) $ para : toList sublist - docLeaf :: L.DocLeaf (Term v Ann) -> TermP v m + docLeaf :: Doc.Leaf [L.Token L.Lexeme] (Term v Ann) -> TermP v m docLeaf d = case d of - L.DocLink link -> Term.app (gann d) (f d "Link") <$> docEmbedLink link - L.DocNamedLink para target -> Term.apps' (f d "NamedLink") . (para :) . pure <$> docLeaf (vacuous target) - L.DocExample code -> do + Doc.Link link -> Term.app (gann d) (f d "Link") <$> docEmbedLink link + Doc.NamedLink para target -> Term.apps' (f d "NamedLink") . (para :) . pure <$> docLeaf (vacuous target) + Doc.Example code -> do trm <- subParse term code pure . Term.apps' (f d "Example") $ case trm of tm@(Term.Apps' _ xs) -> @@ -570,45 +571,45 @@ doc2Block = do lam = addDelay $ Term.lam' (ann tm) ((mempty,) <$> fvs) tm in [n, lam] tm -> [Term.nat (ann tm) 0, addDelay tm] - L.DocTransclude code -> Term.app (gann d) (f d "Transclude") <$> subParse term code - L.DocBold para -> pure $ Term.app (gann d) (f d "Bold") para - L.DocItalic para -> pure $ Term.app (gann d) (f d "Italic") para - L.DocStrikethrough para -> pure $ Term.app (gann d) (f d "Strikethrough") para - L.DocVerbatim leaf -> Term.app (gann d) (f d "Verbatim") <$> docLeaf (vacuous leaf) - L.DocCode leaf -> Term.app (gann d) (f d "Code") <$> docLeaf (vacuous leaf) - L.DocSource elems -> + Doc.Transclude code -> Term.app (gann d) (f d "Transclude") <$> subParse term code + Doc.Bold para -> pure $ Term.app (gann d) (f d "Bold") para + Doc.Italic para -> pure $ Term.app (gann d) (f d "Italic") para + Doc.Strikethrough para -> pure $ Term.app (gann d) (f d "Strikethrough") para + Doc.Verbatim leaf -> Term.app (gann d) (f d "Verbatim") <$> docLeaf (bimap absurd absurd leaf) + Doc.Code leaf -> Term.app (gann d) (f d "Code") <$> docLeaf (bimap absurd absurd leaf) + Doc.Source elems -> Term.app (gann d) (f d "Source") . Term.list (ann elems) . toList <$> traverse docSourceElement elems - L.DocFoldedSource elems -> + Doc.FoldedSource elems -> Term.app (gann d) (f d "FoldedSource") . Term.list (ann elems) . toList <$> traverse docSourceElement elems - L.DocEvalInline code -> Term.app (gann d) (f d "EvalInline") . addDelay <$> subParse term code - L.DocSignature links -> + Doc.EvalInline code -> Term.app (gann d) (f d "EvalInline") . addDelay <$> subParse term code + Doc.Signature links -> Term.app (gann d) (f d "Signature") . Term.list (ann links) . toList <$> traverse docEmbedSignatureLink links - L.DocSignatureInline link -> Term.app (gann d) (f d "SignatureInline") <$> docEmbedSignatureLink link - L.DocWord txt -> pure . Term.app (gann d) (f d "Word") . Term.text (ann txt) . Text.pack $ L.payload txt - L.DocGroup (L.DocJoin leaves) -> + Doc.SignatureInline link -> Term.app (gann d) (f d "SignatureInline") <$> docEmbedSignatureLink link + Doc.Word txt -> pure . Term.app (gann d) (f d "Word") . Term.text (ann txt) . Text.pack $ L.payload txt + Doc.Group (Doc.Join leaves) -> Term.app (gann d) (f d "Group") . Term.app (gann d) (f d "Join") . Term.list (ann leaves) . toList <$> traverse docLeaf leaves - docEmbedLink :: L.DocEmbedLink -> TermP v m + docEmbedLink :: Doc.EmbedLink -> TermP v m docEmbedLink d = case d of - L.DocEmbedTypeLink ident -> + Doc.EmbedTypeLink ident -> Term.app (gann d) (f d "EmbedTypeLink") . Term.typeLink (ann d) . L.payload <$> findUniqueType (HQ'.toHQ <$> ident) - L.DocEmbedTermLink ident -> + Doc.EmbedTermLink ident -> Term.app (gann d) (f d "EmbedTermLink") . addDelay <$> resolveHashQualified (HQ'.toHQ <$> ident) - docSourceElement :: L.DocSourceElement -> TermP v m - docSourceElement d@(L.DocSourceElement link anns) = do + docSourceElement :: Doc.SourceElement [L.Token L.Lexeme] -> TermP v m + docSourceElement d@(Doc.SourceElement link anns) = do link' <- docEmbedLink link anns' <- traverse docEmbedAnnotation anns pure $ Term.apps' (f d "SourceElement") [link', Term.list (ann anns) anns'] - docEmbedSignatureLink :: L.DocEmbedSignatureLink -> TermP v m - docEmbedSignatureLink d@(L.DocEmbedSignatureLink ident) = + docEmbedSignatureLink :: Doc.EmbedSignatureLink -> TermP v m + docEmbedSignatureLink d@(Doc.EmbedSignatureLink ident) = Term.app (gann d) (f d "EmbedSignatureLink") . addDelay <$> resolveHashQualified (HQ'.toHQ <$> ident) - docEmbedAnnotation :: L.DocEmbedAnnotation -> TermP v m - docEmbedAnnotation d@(L.DocEmbedAnnotation a) = + docEmbedAnnotation :: Doc.EmbedAnnotation [L.Token L.Lexeme] -> TermP v m + docEmbedAnnotation d@(Doc.EmbedAnnotation a) = -- This is the only place I’m not sure we’re doing the right thing. In the lexer, this can be an identifier or a -- DocLeaf, but here it could be either /text/ or a Doc element. And I don’t think there’s any way the lexemes -- produced for an identifier and the lexemes consumed for text line up. So, I think this is a bugfix I can’t diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 9f2119011a..c0d1c3c04c 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -9,15 +9,6 @@ module Unison.Syntax.Lexer Pos (..), Lexeme (..), DocTree, - DocUntitledSection (..), - DocTop (..), - DocColumn (..), - DocLeaf (..), - DocEmbedLink (..), - DocSourceElement (..), - DocEmbedSignatureLink (..), - DocJoin (..), - DocEmbedAnnotation (..), lexer, preParse, escapeChars, @@ -43,7 +34,6 @@ import Control.Lens qualified as Lens import Control.Monad.State qualified as S import Data.Char (isAlphaNum, isControl, isDigit, isSpace, ord, toLower) import Data.Foldable qualified as Foldable -import Data.Functor.Classes import Data.List qualified as List import Data.List.Extra qualified as List import Data.List.NonEmpty (NonEmpty ((:|))) @@ -66,7 +56,7 @@ import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment (docSegment) import Unison.NameSegment.Internal qualified as NameSegment -import Unison.Parser.Ann (Ann (Ann), Annotated (..)) +import Unison.Parser.Ann (Ann, Annotated (..)) import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH @@ -75,6 +65,7 @@ import Unison.Syntax.Lexer.Token (Token (..), posP, tokenP) import Unison.Syntax.Name qualified as Name (isSymboly, nameP, toText, unsafeParseText) import Unison.Syntax.NameSegment (symbolyIdChar, wordyIdChar, wordyIdStartChar) import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..), wordyP) +import Unison.Syntax.Parser.Doc.Data qualified as Doc import Unison.Syntax.ReservedWords (delimiters, typeModifiers, typeOrAbility) import Unison.Syntax.ShortHash qualified as ShortHash (shortHashP) import Unison.Util.Bytes qualified as Bytes @@ -83,9 +74,6 @@ import Unison.Util.Monoid (intercalateMap) instance (Annotated a) => Annotated (Cofree f a) where ann (a :< _) = ann a -instance Annotated (Token a) where - ann (Token _ s e) = Ann s e - type BlockName = String type Layout = [(BlockName, Column)] @@ -158,7 +146,7 @@ data Lexeme | Bytes Bytes.Bytes -- bytes literals | Hash ShortHash -- hash literals | Err Err - | Doc (DocUntitledSection DocTree) + | Doc (Doc.UntitledSection DocTree) deriving stock (Eq, Show, Ord) type IsVirtual = Bool -- is it a virtual semi or an actual semi? @@ -422,6 +410,8 @@ restoreStack lbl p = do S.put (s2 {layout = layout1}) pure $ p <> closes +type DocTree = Cofree (Doc.Top [Token Lexeme]) Ann + -- | The `Doc` lexer as documented on unison-lang.org doc2 :: P [Token Lexeme] doc2 = do @@ -508,148 +498,18 @@ someTill' p end = liftA2 (:|) p $ P.manyTill p end sepBy1' :: P a -> P sep -> P (NonEmpty a) sepBy1' p sep = liftA2 (:|) p . many $ sep *> p -newtype DocUntitledSection a = DocUntitledSection [a] - deriving (Eq, Ord, Show, Foldable, Functor, Traversable) - --- | Haskell parallel to @unison/base.Doc@. --- --- This is much more restricted than @unison/base.Doc@, but it covers everything we can parse from Haskell. The --- mismatch with Unison is a problem, as someone can create a Unison Doc with explicit constructors or function calls, --- have it rendered to a scratch file, and then we can’t parse it. Changing the types here to match Unison wouldn’t --- fix the issue. We have to modify the types and parser in concert (in both Haskell and Unison) to bring them in --- line. --- --- __NB__: Uses of @[`Token` `Lexeme`]@ here indicate a nested transition to the Unison lexer. -data DocTop a - = -- | The first argument is always a Paragraph - DocSection a [a] - | DocEval [Token Lexeme] - | DocExampleBlock [Token Lexeme] - | DocCodeBlock (Token String) (Token String) - | DocBulletedList (NonEmpty (DocColumn a)) - | DocNumberedList (NonEmpty (Token Word64, DocColumn a)) - | DocParagraph (NonEmpty (DocLeaf a)) - deriving (Eq, Ord, Show, Foldable, Functor, Traversable) - -instance Eq1 DocTop where - liftEq _ _ _ = True - -instance Ord1 DocTop where - liftCompare _ _ _ = LT - -instance Show1 DocTop where - liftShowsPrec _ _ _ _ x = x - -data DocColumn a - = -- | The first is always a Paragraph, and the second a Bulleted or Numbered List - DocColumn a (Maybe a) - deriving (Eq, Ord, Show, Foldable, Functor, Traversable) - -data DocLeaf a - = DocLink DocEmbedLink - | -- | first is a Paragraph, second is always a Group (which contains either a single Term/Type link or list of - -- Transcludes & Words) - DocNamedLink a (DocLeaf Void) - | DocExample [Token Lexeme] - | DocTransclude [Token Lexeme] - | -- | Always a Paragraph - DocBold a - | -- | Always a Paragraph - DocItalic a - | -- | Always a Paragraph - DocStrikethrough a - | -- | Always a Word - DocVerbatim (DocLeaf Void) - | -- | Always a Word - DocCode (DocLeaf Void) - | DocSource (NonEmpty DocSourceElement) - | DocFoldedSource (NonEmpty DocSourceElement) - | DocEvalInline [Token Lexeme] - | DocSignature (NonEmpty DocEmbedSignatureLink) - | DocSignatureInline DocEmbedSignatureLink - | DocWord (Token String) - | DocGroup (DocJoin a) - deriving (Eq, Ord, Show, Foldable, Functor, Traversable) - -data DocEmbedLink - = DocEmbedTypeLink (Token (HQ'.HashQualified Name)) - | DocEmbedTermLink (Token (HQ'.HashQualified Name)) - deriving (Eq, Ord, Show) - -data DocSourceElement = DocSourceElement DocEmbedLink [DocEmbedAnnotation] - deriving (Eq, Ord, Show) - -newtype DocEmbedSignatureLink = DocEmbedSignatureLink (Token (HQ'.HashQualified Name)) - deriving (Eq, Ord, Show) - -newtype DocJoin a = DocJoin (NonEmpty (DocLeaf a)) - deriving (Eq, Ord, Show, Foldable, Functor, Traversable) - -newtype DocEmbedAnnotation - = -- | Always a DocTransclude - DocEmbedAnnotation (Either (Token (HQ'.HashQualified Name)) (DocLeaf Void)) - deriving (Eq, Ord, Show) - -type DocTree = Cofree DocTop Ann - -instance (Annotated a) => Annotated (DocTop a) where - ann = \case - DocSection title body -> ann title <> ann body - DocEval code -> ann code - DocExampleBlock code -> ann code - DocCodeBlock label body -> ann label <> ann body - DocBulletedList items -> ann items - DocNumberedList items -> ann $ snd <$> items - DocParagraph leaves -> ann leaves - -instance (Annotated a) => Annotated (DocColumn a) where - ann (DocColumn para list) = ann para <> ann list - -instance (Annotated a) => Annotated (DocLeaf a) where - ann = \case - DocLink link -> ann link - DocNamedLink label target -> ann label <> ann target - DocExample code -> ann code - DocTransclude code -> ann code - DocBold para -> ann para - DocItalic para -> ann para - DocStrikethrough para -> ann para - DocVerbatim word -> ann word - DocCode word -> ann word - DocSource elems -> ann elems - DocFoldedSource elems -> ann elems - DocEvalInline code -> ann code - DocSignature links -> ann links - DocSignatureInline link -> ann link - DocWord text -> ann text - DocGroup (DocJoin leaves) -> ann leaves - -instance Annotated DocEmbedLink where - ann = \case - DocEmbedTypeLink name -> ann name - DocEmbedTermLink name -> ann name - -instance Annotated DocSourceElement where - ann (DocSourceElement link target) = ann link <> ann target - -instance Annotated DocEmbedSignatureLink where - ann (DocEmbedSignatureLink name) = ann name - -instance Annotated DocEmbedAnnotation where - ann (DocEmbedAnnotation a) = either ann ann a - -- | This is the actual `Doc` lexer. Unlike `doc2`, it doesn’t do any Unison-side lexing (i.e., it doesn’t know that -- Unison wraps `Doc` literals in `}}`). -docBody :: P end -> P (DocUntitledSection DocTree) -docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) +docBody :: P end -> P (Doc.UntitledSection DocTree) +docBody docClose' = Doc.UntitledSection <$> P.many (sectionElem <* CP.space) where wordyKw kw = separated wordySep (lit kw) sectionElem = section <|> fencedBlock <|> list <|> paragraph - paragraph = wrap' . DocParagraph <$> spaced leaf + paragraph = wrap' . Doc.Paragraph <$> spaced leaf reserved word = List.isPrefixOf "}}" word || all (== '#') word - wordy :: P end -> P (DocLeaf void) - wordy closing = fmap DocWord . tokenP . P.try $ do + wordy :: P end -> P (Doc.Leaf [Token Lexeme] void) + wordy closing = fmap Doc.Word . tokenP . P.try $ do let end = P.lookAhead $ void docClose @@ -677,10 +537,10 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) where comma = lit "," <* CP.space src = - src' DocSource "@source" - <|> src' DocFoldedSource "@foldedSource" + src' Doc.Source "@source" + <|> src' Doc.FoldedSource "@foldedSource" srcElem = - DocSourceElement + Doc.SourceElement <$> (typeLink <|> termLink) <*> ( fmap (fromMaybe []) . P.optional $ (lit "@") *> (CP.space *> annotations) @@ -688,38 +548,38 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) where annotation = fmap Left (tokenP identifierP) <|> fmap Right expr <* CP.space annotations = - P.some (DocEmbedAnnotation <$> annotation) + P.some (Doc.EmbedAnnotation <$> annotation) src' name atName = fmap name $ do _ <- lit atName *> (lit " {" <|> lit "{") *> CP.space s <- sepBy1' srcElem comma _ <- lit "}" pure s - signature = fmap DocSignature $ do + signature = fmap Doc.Signature $ do _ <- (lit "@signatures" <|> lit "@signature") *> (lit " {" <|> lit "{") *> CP.space s <- sepBy1' signatureLink comma _ <- lit "}" pure s - signatureInline = fmap DocSignatureInline $ do + signatureInline = fmap Doc.SignatureInline $ do _ <- lit "@inlineSignature" *> (lit " {" <|> lit "{") *> CP.space s <- signatureLink _ <- lit "}" pure s - evalInline = fmap DocEvalInline $ do + evalInline = fmap Doc.EvalInline $ do _ <- lit "@eval" *> (lit " {" <|> lit "{") *> CP.space let inlineEvalClose = [] <$ lit "}" s <- lexemes' inlineEvalClose pure s - typeLink = fmap DocEmbedTypeLink $ do + typeLink = fmap Doc.EmbedTypeLink $ do _ <- typeOrAbilityAlt (wordyKw . Text.unpack) <* CP.space tokenP identifierP <* CP.space termLink = - fmap DocEmbedTermLink $ + fmap Doc.EmbedTermLink $ tokenP identifierP <* CP.space signatureLink = - fmap DocEmbedSignatureLink $ + fmap Doc.EmbedSignatureLink $ tokenP identifierP <* CP.space groupy closing p = do @@ -728,8 +588,8 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) pure $ case after of Nothing -> p Just after -> - DocGroup - . DocJoin + Doc.Group + . Doc.Join $ p :| pure after @@ -748,17 +608,17 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) let txt = trimIndentFromVerbatimBlock (column start - 1) trimmed -- If it's a multi-line verbatim block we trim any whitespace representing -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' - pure . DocVerbatim $ - DocWord $ + pure . Doc.Verbatim $ + Doc.Word $ Token txt start stop else - pure . DocCode $ - DocWord $ + pure . Doc.Code $ + Doc.Word $ Token originalText start stop exampleInline = P.label "inline code (examples: ``List.map f xs``, ``[1] :+ 2``)" $ - fmap DocExample $ do + fmap Doc.Example $ do n <- P.try $ do _ <- lit "`" length <$> P.takeWhile1P (Just "backticks") (== '`') @@ -770,12 +630,12 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) link = P.label "link (examples: {type List}, {Nat.+})" $ - fmap DocLink $ + fmap Doc.Link $ P.try $ lit "{" *> (typeLink <|> termLink) <* lit "}" expr = - fmap DocTransclude . P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ + fmap Doc.Transclude . P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ openAs "{{" "syntax.docTransclude" *> do env0 <- S.get @@ -806,7 +666,7 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) P.label "block eval (syntax: a fenced code block)" $ evalUnison <|> exampleBlock <|> other where - evalUnison = fmap (wrap' . DocEval) $ do + evalUnison = fmap (wrap' . Doc.Eval) $ do -- commit after seeing that ``` is on its own line fence <- P.try $ do fence <- lit "```" <+> P.takeWhileP Nothing (== '`') @@ -817,7 +677,7 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) (\env -> env {inLayout = True, opening = Just "docEval"}) (restoreStack "docEval" $ lexemes' ([] <$ lit fence)) - exampleBlock = fmap (wrap' . DocExampleBlock) $ do + exampleBlock = fmap (wrap' . Doc.ExampleBlock) $ do void $ lit "@typecheck" <* CP.space fence <- lit "```" <+> P.takeWhileP Nothing (== '`') local @@ -834,7 +694,7 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) skip _ s = s in List.intercalate "\n" $ skip column <$> lines s - other = fmap (uncurry $ wrapSimple2 DocCodeBlock) $ do + other = fmap (uncurry $ wrapSimple2 Doc.CodeBlock) $ do column <- (\x -> x - 1) . toInteger . P.unPos <$> LP.indentLevel let tabWidth = toInteger . P.unPos $ P.defaultTabWidth fence <- lit "```" <+> P.takeWhileP Nothing (== '`') @@ -857,26 +717,26 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) (P.satisfy (== '~')) name s = if take 1 s == "~" - then DocStrikethrough - else if take 1 s == "*" then DocBold else DocItalic + then Doc.Strikethrough + else if take 1 s == "*" then Doc.Bold else Doc.Italic end <- P.try $ do end <- start P.lookAhead (P.satisfy (not . isSpace)) pure end - name end . wrap' . DocParagraph + name end . wrap' . Doc.Paragraph <$> someTill' (leafy (closing <|> (void $ lit end)) <* whitespaceWithoutParagraphBreak) (lit end) externalLink = P.label "hyperlink (example: [link name](https://destination.com))" $ - fmap (uncurry DocNamedLink) $ do + fmap (uncurry Doc.NamedLink) $ do _ <- lit "[" p <- leafies (void $ char ']') _ <- lit "]" _ <- lit "(" target <- - fmap (DocGroup . DocJoin) $ + fmap (Doc.Group . Doc.Join) $ fmap pure link <|> some' (expr <|> wordy (char ')')) _ <- lit ")" pure (p, target) @@ -894,12 +754,12 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) ok s = length [() | '\n' <- s] < 2 spaced p = some' (p <* P.optional sp) - leafies close = wrap' . DocParagraph <$> spaced (leafy close) + leafies close = wrap' . Doc.Paragraph <$> spaced (leafy close) list = bulletedList <|> numberedList - bulletedList = wrap' . DocBulletedList <$> sepBy1' bullet listSep - numberedList = wrap' . DocNumberedList <$> sepBy1' numberedItem listSep + bulletedList = wrap' . Doc.BulletedList <$> sepBy1' bullet listSep + numberedList = wrap' . Doc.NumberedList <$> sepBy1' numberedItem listSep listSep = P.try $ newline *> nonNewlineSpaces *> P.lookAhead (void bulletedStart <|> void numberedStart) @@ -921,7 +781,7 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) numberedStart = listItemStart' $ P.try (tokenP $ LP.decimal <* lit ".") - listItemParagraph = fmap (wrap' . DocParagraph) $ do + listItemParagraph = fmap (wrap' . Doc.Paragraph) $ do col <- column <$> posP some' (leaf <* sep col) where @@ -947,7 +807,7 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) numberedItem = P.label msg $ do (col, s) <- numberedStart (s,) - <$> ( fmap (uncurry DocColumn) $ do + <$> ( fmap (uncurry Doc.Column) $ do p <- nonNewlineSpaces *> listItemParagraph subList <- local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> list) @@ -956,7 +816,7 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) where msg = "numbered list (examples: 1. item1, 8. start numbering at '8')" - bullet = fmap (uncurry DocColumn) . P.label "bullet (examples: * item1, - item2)" $ do + bullet = fmap (uncurry Doc.Column) . P.label "bullet (examples: * item1, - item2)" $ do (col, _) <- bulletedStart p <- nonNewlineSpaces *> listItemParagraph subList <- @@ -978,7 +838,7 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) -- # A section title (not a subsection) section :: P DocTree - section = fmap (wrap' . uncurry DocSection) $ do + section = fmap (wrap' . uncurry Doc.Section) $ do ns <- S.gets parentSections hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp title <- paragraph <* CP.space @@ -988,10 +848,10 @@ docBody docClose' = DocUntitledSection <$> P.many (sectionElem <* CP.space) P.many (sectionElem <* CP.space) pure $ (title, body) - wrap' :: DocTop DocTree -> DocTree + wrap' :: Doc.Top [Token Lexeme] DocTree -> DocTree wrap' doc = ann doc :< doc - wrapSimple2 :: (Annotated a, Annotated b) => (a -> b -> DocTop DocTree) -> a -> b -> DocTree + wrapSimple2 :: (Annotated a, Annotated b) => (a -> b -> Doc.Top [Token Lexeme] DocTree) -> a -> b -> DocTree wrapSimple2 fn a b = ann a <> ann b :< fn a b lexemes' :: P [Token Lexeme] -> P [Token Lexeme] diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Token.hs b/unison-syntax/src/Unison/Syntax/Lexer/Token.hs index 81842c409e..e29f276c5e 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Token.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Token.hs @@ -9,6 +9,7 @@ import Data.Text qualified as Text import Text.Megaparsec (ParsecT, TraversableStream) import Text.Megaparsec qualified as P import Unison.Lexer.Pos (Pos (Pos)) +import Unison.Parser.Ann (Ann (Ann), Annotated (..)) import Unison.Prelude data Token a = Token @@ -18,6 +19,9 @@ data Token a = Token } deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) +instance Annotated (Token a) where + ann (Token _ s e) = Ann s e + instance Applicative Token where pure a = Token a (Pos 0 0) (Pos 0 0) Token f start _ <*> Token a _ end = Token (f a) start end diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 344de0fd1b..1bee4d08f4 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -90,6 +90,7 @@ import Unison.Reference (Reference) import Unison.Referent (Referent) import Unison.Syntax.Lexer qualified as L import Unison.Syntax.Name qualified as Name (toVar, unsafeParseText) +import Unison.Syntax.Parser.Doc.Data qualified as Doc import Unison.Term (MatchCase (..)) import Unison.UnisonFile.Error qualified as UF import Unison.Util.Bytes (Bytes) @@ -270,7 +271,7 @@ closeBlock :: (Ord v) => P v m (L.Token ()) closeBlock = void <$> matchToken L.Close -- | With layout, blocks might “close” without an explicit outdent (e.g., not even a newline at the end of a --- `DocTransclude`). This allows those blocks to be closed by EOF. +-- `Doc.Transclude`). This allows those blocks to be closed by EOF. optionalCloseBlock :: (Ord v) => P v m (L.Token ()) optionalCloseBlock = closeBlock <|> (\() -> L.Token () mempty mempty) <$> P.eof @@ -399,7 +400,7 @@ string = queryToken getString getString (L.Textual s) = Just (Text.pack s) getString _ = Nothing -doc :: (Ord v) => P v m (L.Token (L.DocUntitledSection L.DocTree)) +doc :: (Ord v) => P v m (L.Token (Doc.UntitledSection L.DocTree)) doc = queryToken \case L.Doc d -> pure d _ -> Nothing diff --git a/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs b/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs new file mode 100644 index 0000000000..4a88200b8b --- /dev/null +++ b/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs @@ -0,0 +1,166 @@ +-- | Haskell parallel to @unison/base.Doc@. +-- +-- This is much more restricted than @unison/base.Doc@, but it covers everything we can parse from Haskell. The +-- mismatch with Unison is a problem, as someone can create a Unison Doc with explicit constructors or function calls, +-- have it rendered to a scratch file, and then we can’t parse it. Changing the types here to match Unison wouldn’t +-- fix the issue. We have to modify the types and parser in concert (in both Haskell and Unison) to bring them in +-- line. +module Unison.Syntax.Parser.Doc.Data where + +import Data.Functor.Classes +import Data.List.NonEmpty (NonEmpty) +import Unison.HashQualifiedPrime qualified as HQ' +import Unison.Name (Name) +import Unison.Parser.Ann (Annotated (..)) +import Unison.Prelude +import Unison.Syntax.Lexer.Token (Token (..)) + +newtype UntitledSection a = UntitledSection [a] + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +data Top code a + = -- | The first argument is always a Paragraph + Section a [a] + | Eval code + | ExampleBlock code + | CodeBlock (Token String) (Token String) + | BulletedList (NonEmpty (Column a)) + | NumberedList (NonEmpty (Token Word64, Column a)) + | Paragraph (NonEmpty (Leaf code a)) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +instance Eq2 Top where + liftEq2 _ _ _ _ = True + +instance (Eq code) => Eq1 (Top code) + +instance Ord2 Top where + liftCompare2 _ _ _ _ = LT + +instance (Ord code) => Ord1 (Top code) + +instance Show2 Top where + liftShowsPrec2 _ _ _ _ _ _ x = x + +instance (Show code) => Show1 (Top code) + +data Column a + = -- | The first is always a Paragraph, and the second a Bulleted or Numbered List + Column a (Maybe a) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +data Leaf code a + = Link EmbedLink + | -- | first is a Paragraph, second is always a Group (which contains either a single Term/Type link or list of + -- Transcludes & Words) + NamedLink a (Leaf code Void) + | Example code + | Transclude code + | -- | Always a Paragraph + Bold a + | -- | Always a Paragraph + Italic a + | -- | Always a Paragraph + Strikethrough a + | -- | Always a Word + Verbatim (Leaf Void Void) + | -- | Always a Word + Code (Leaf Void Void) + | Source (NonEmpty (SourceElement code)) + | FoldedSource (NonEmpty (SourceElement code)) + | EvalInline code + | Signature (NonEmpty EmbedSignatureLink) + | SignatureInline EmbedSignatureLink + | Word (Token String) + | Group (Join code a) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +instance Bifunctor Leaf where + bimap f g = \case + Link x -> Link x + NamedLink a leaf -> NamedLink (g a) $ first f leaf + Example code -> Example $ f code + Transclude code -> Transclude $ f code + Bold a -> Bold $ g a + Italic a -> Italic $ g a + Strikethrough a -> Strikethrough $ g a + Verbatim leaf -> Verbatim leaf + Code leaf -> Code leaf + Source elems -> Source $ fmap f <$> elems + FoldedSource elems -> FoldedSource $ fmap f <$> elems + EvalInline code -> EvalInline $ f code + Signature x -> Signature x + SignatureInline x -> SignatureInline x + Word x -> Word x + Group join -> Group $ bimap f g join + +data EmbedLink + = EmbedTypeLink (Token (HQ'.HashQualified Name)) + | EmbedTermLink (Token (HQ'.HashQualified Name)) + deriving (Eq, Ord, Show) + +data SourceElement code = SourceElement EmbedLink [EmbedAnnotation code] + deriving (Eq, Ord, Show, Functor) + +newtype EmbedSignatureLink = EmbedSignatureLink (Token (HQ'.HashQualified Name)) + deriving (Eq, Ord, Show) + +newtype Join code a = Join (NonEmpty (Leaf code a)) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +instance Bifunctor Join where + bimap f g (Join leaves) = Join $ bimap f g <$> leaves + +newtype EmbedAnnotation code + = -- | Always a Transclude + EmbedAnnotation (Either (Token (HQ'.HashQualified Name)) (Leaf code Void)) + deriving (Eq, Ord, Show) + +instance Functor EmbedAnnotation where + fmap f (EmbedAnnotation ann) = EmbedAnnotation $ first f <$> ann + +instance (Annotated code, Annotated a) => Annotated (Top code a) where + ann = \case + Section title body -> ann title <> ann body + Eval code -> ann code + ExampleBlock code -> ann code + CodeBlock label body -> ann label <> ann body + BulletedList items -> ann items + NumberedList items -> ann $ snd <$> items + Paragraph leaves -> ann leaves + +instance (Annotated a) => Annotated (Column a) where + ann (Column para list) = ann para <> ann list + +instance (Annotated code, Annotated a) => Annotated (Leaf code a) where + ann = \case + Link link -> ann link + NamedLink label target -> ann label <> ann target + Example code -> ann code + Transclude code -> ann code + Bold para -> ann para + Italic para -> ann para + Strikethrough para -> ann para + Verbatim word -> ann word + Code word -> ann word + Source elems -> ann elems + FoldedSource elems -> ann elems + EvalInline code -> ann code + Signature links -> ann links + SignatureInline link -> ann link + Word text -> ann text + Group (Join leaves) -> ann leaves + +instance Annotated EmbedLink where + ann = \case + EmbedTypeLink name -> ann name + EmbedTermLink name -> ann name + +instance (Annotated code) => Annotated (SourceElement code) where + ann (SourceElement link target) = ann link <> ann target + +instance Annotated EmbedSignatureLink where + ann (EmbedSignatureLink name) = ann name + +instance (Annotated code) => Annotated (EmbedAnnotation code) where + ann (EmbedAnnotation a) = either ann ann a diff --git a/unison-syntax/unison-syntax.cabal b/unison-syntax/unison-syntax.cabal index 4b097e6021..31ee026b7c 100644 --- a/unison-syntax/unison-syntax.cabal +++ b/unison-syntax/unison-syntax.cabal @@ -26,6 +26,7 @@ library Unison.Syntax.Name Unison.Syntax.NameSegment Unison.Syntax.Parser + Unison.Syntax.Parser.Doc.Data Unison.Syntax.ReservedWords Unison.Syntax.ShortHash Unison.Syntax.Var From 70fe615570ed57026fb58b8939a643d9155e58b0 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 25 Jul 2024 14:33:40 -0600 Subject: [PATCH 515/631] Add `Data.Functor.Classes` instances These are needed for the new Doc types, but had been stubbed out. Moving the Doc types to their own module forced the changes that got in the way of generating these with Template Haskell. --- .../src/Unison/Syntax/TermParser.hs | 4 +- unison-syntax/package.yaml | 1 + .../src/Unison/Syntax/Parser/Doc/Data.hs | 90 +++++++++++-------- unison-syntax/unison-syntax.cabal | 2 + 4 files changed, 57 insertions(+), 40 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 89d5504079..6433bf220c 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -598,7 +598,7 @@ doc2Block = do Doc.EmbedTermLink ident -> Term.app (gann d) (f d "EmbedTermLink") . addDelay <$> resolveHashQualified (HQ'.toHQ <$> ident) - docSourceElement :: Doc.SourceElement [L.Token L.Lexeme] -> TermP v m + docSourceElement :: Doc.SourceElement (Doc.Leaf [L.Token L.Lexeme] Void) -> TermP v m docSourceElement d@(Doc.SourceElement link anns) = do link' <- docEmbedLink link anns' <- traverse docEmbedAnnotation anns @@ -608,7 +608,7 @@ doc2Block = do docEmbedSignatureLink d@(Doc.EmbedSignatureLink ident) = Term.app (gann d) (f d "EmbedSignatureLink") . addDelay <$> resolveHashQualified (HQ'.toHQ <$> ident) - docEmbedAnnotation :: Doc.EmbedAnnotation [L.Token L.Lexeme] -> TermP v m + docEmbedAnnotation :: Doc.EmbedAnnotation (Doc.Leaf [L.Token L.Lexeme] Void) -> TermP v m docEmbedAnnotation d@(Doc.EmbedAnnotation a) = -- This is the only place I’m not sure we’re doing the right thing. In the lexer, this can be an identifier or a -- DocLeaf, but here it could be either /text/ or a Doc element. And I don’t think there’s any way the lexemes diff --git a/unison-syntax/package.yaml b/unison-syntax/package.yaml index ccb1a057d7..b093dc182f 100644 --- a/unison-syntax/package.yaml +++ b/unison-syntax/package.yaml @@ -9,6 +9,7 @@ dependencies: - bytes - containers - cryptonite + - deriving-compat - extra - free - lens diff --git a/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs b/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs index 4a88200b8b..5167b2bcf6 100644 --- a/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs +++ b/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + -- | Haskell parallel to @unison/base.Doc@. -- -- This is much more restricted than @unison/base.Doc@, but it covers everything we can parse from Haskell. The @@ -7,8 +9,10 @@ -- line. module Unison.Syntax.Parser.Doc.Data where -import Data.Functor.Classes +import Data.Eq.Deriving (deriveEq1, deriveEq2) import Data.List.NonEmpty (NonEmpty) +import Data.Ord.Deriving (deriveOrd1, deriveOrd2) +import Text.Show.Deriving (deriveShow1, deriveShow2) import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Parser.Ann (Annotated (..)) @@ -19,7 +23,7 @@ newtype UntitledSection a = UntitledSection [a] deriving (Eq, Ord, Show, Foldable, Functor, Traversable) data Top code a - = -- | The first argument is always a Paragraph + = -- | The first argument is always a `Paragraph` Section a [a] | Eval code | ExampleBlock code @@ -29,30 +33,15 @@ data Top code a | Paragraph (NonEmpty (Leaf code a)) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -instance Eq2 Top where - liftEq2 _ _ _ _ = True - -instance (Eq code) => Eq1 (Top code) - -instance Ord2 Top where - liftCompare2 _ _ _ _ = LT - -instance (Ord code) => Ord1 (Top code) - -instance Show2 Top where - liftShowsPrec2 _ _ _ _ _ _ x = x - -instance (Show code) => Show1 (Top code) - data Column a - = -- | The first is always a Paragraph, and the second a Bulleted or Numbered List + = -- | The first is always a `Paragraph`, and the second a `BulletedList` or `NumberedList` Column a (Maybe a) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) data Leaf code a = Link EmbedLink | -- | first is a Paragraph, second is always a Group (which contains either a single Term/Type link or list of - -- Transcludes & Words) + -- `Transclude`s & `Word`s) NamedLink a (Leaf code Void) | Example code | Transclude code @@ -66,13 +55,15 @@ data Leaf code a Verbatim (Leaf Void Void) | -- | Always a Word Code (Leaf Void Void) - | Source (NonEmpty (SourceElement code)) - | FoldedSource (NonEmpty (SourceElement code)) + | -- | Always a Transclude + Source (NonEmpty (SourceElement (Leaf code Void))) + | -- | Always a Transclude + FoldedSource (NonEmpty (SourceElement (Leaf code Void))) | EvalInline code | Signature (NonEmpty EmbedSignatureLink) | SignatureInline EmbedSignatureLink | Word (Token String) - | Group (Join code a) + | Group (Join (Leaf code a)) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) instance Bifunctor Leaf where @@ -86,38 +77,31 @@ instance Bifunctor Leaf where Strikethrough a -> Strikethrough $ g a Verbatim leaf -> Verbatim leaf Code leaf -> Code leaf - Source elems -> Source $ fmap f <$> elems - FoldedSource elems -> FoldedSource $ fmap f <$> elems + Source elems -> Source $ fmap (first f) <$> elems + FoldedSource elems -> FoldedSource $ fmap (first f) <$> elems EvalInline code -> EvalInline $ f code Signature x -> Signature x SignatureInline x -> SignatureInline x Word x -> Word x - Group join -> Group $ bimap f g join + Group join -> Group $ bimap f g <$> join data EmbedLink = EmbedTypeLink (Token (HQ'.HashQualified Name)) | EmbedTermLink (Token (HQ'.HashQualified Name)) deriving (Eq, Ord, Show) -data SourceElement code = SourceElement EmbedLink [EmbedAnnotation code] - deriving (Eq, Ord, Show, Functor) +data SourceElement a = SourceElement EmbedLink [EmbedAnnotation a] + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) newtype EmbedSignatureLink = EmbedSignatureLink (Token (HQ'.HashQualified Name)) deriving (Eq, Ord, Show) -newtype Join code a = Join (NonEmpty (Leaf code a)) +newtype Join a = Join (NonEmpty a) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -instance Bifunctor Join where - bimap f g (Join leaves) = Join $ bimap f g <$> leaves - -newtype EmbedAnnotation code - = -- | Always a Transclude - EmbedAnnotation (Either (Token (HQ'.HashQualified Name)) (Leaf code Void)) - deriving (Eq, Ord, Show) - -instance Functor EmbedAnnotation where - fmap f (EmbedAnnotation ann) = EmbedAnnotation $ first f <$> ann +newtype EmbedAnnotation a + = EmbedAnnotation (Either (Token (HQ'.HashQualified Name)) a) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) instance (Annotated code, Annotated a) => Annotated (Top code a) where ann = \case @@ -164,3 +148,33 @@ instance Annotated EmbedSignatureLink where instance (Annotated code) => Annotated (EmbedAnnotation code) where ann (EmbedAnnotation a) = either ann ann a + +$(deriveEq1 ''Column) +$(deriveOrd1 ''Column) +$(deriveShow1 ''Column) + +$(deriveEq1 ''EmbedAnnotation) +$(deriveOrd1 ''EmbedAnnotation) +$(deriveShow1 ''EmbedAnnotation) + +$(deriveEq1 ''SourceElement) +$(deriveOrd1 ''SourceElement) +$(deriveShow1 ''SourceElement) + +$(deriveEq1 ''Join) +$(deriveOrd1 ''Join) +$(deriveShow1 ''Join) + +$(deriveEq1 ''Leaf) +$(deriveOrd1 ''Leaf) +$(deriveShow1 ''Leaf) +$(deriveEq2 ''Leaf) +$(deriveOrd2 ''Leaf) +$(deriveShow2 ''Leaf) + +$(deriveEq1 ''Top) +$(deriveOrd1 ''Top) +$(deriveShow1 ''Top) +$(deriveEq2 ''Top) +$(deriveOrd2 ''Top) +$(deriveShow2 ''Top) diff --git a/unison-syntax/unison-syntax.cabal b/unison-syntax/unison-syntax.cabal index 31ee026b7c..853da4c817 100644 --- a/unison-syntax/unison-syntax.cabal +++ b/unison-syntax/unison-syntax.cabal @@ -69,6 +69,7 @@ library , bytes , containers , cryptonite + , deriving-compat , extra , free , lens @@ -127,6 +128,7 @@ test-suite syntax-tests , code-page , containers , cryptonite + , deriving-compat , easytest , extra , free From 31f952201c5a1448af0eb78b5a9dbff63f12c05f Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 25 Jul 2024 15:59:51 -0600 Subject: [PATCH 516/631] Simplify `restoreStack` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit It’s only used inside `local`, so its attempts to restore the layout are for naught. --- unison-syntax/src/Unison/Syntax/Lexer.hs | 62 ++++++------------------ 1 file changed, 15 insertions(+), 47 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index c0d1c3c04c..e2cba29dc4 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -257,7 +257,7 @@ token'' tok p = do topHasClosePair :: Layout -> Bool topHasClosePair [] = False topHasClosePair ((name, _) : _) = - name `elem` ["syntax.docTransclude", "{", "(", "[", "handle", "match", "if", "then"] + name `elem` ["DUMMY", "{", "(", "[", "handle", "match", "if", "then"] showErrorFancy :: (P.ShowErrorComponent e) => P.ErrorFancy e -> String showErrorFancy = \case @@ -394,22 +394,6 @@ infixl 2 <+> (<+>) :: (Monoid a) => P a -> P a -> P a p1 <+> p2 = do a1 <- p1; a2 <- p2; pure (a1 <> a2) --- Runs the parser `p`, then: --- 1. resets the layout stack to be what it was before `p`. --- 2. emits enough closing tokens to reach `lbl` but not pop it. --- (you can think of this as just dealing with a final "unclosed" --- block at the end of `p`) -restoreStack :: String -> P [Token Lexeme] -> P [Token Lexeme] -restoreStack lbl p = do - layout1 <- S.gets layout - p <- p - s2 <- S.get - let (pos1, pos2) = foldl' (\_ b -> (start b, end b)) mempty p - unclosed = takeWhile (\(lbl', _) -> lbl' /= lbl) (layout s2) - closes = replicate (length unclosed) (Token Close pos1 pos2) - S.put (s2 {layout = layout1}) - pure $ p <> closes - type DocTree = Cofree (Doc.Top [Token Lexeme]) Ann -- | The `Doc` lexer as documented on unison-lang.org @@ -501,7 +485,7 @@ sepBy1' p sep = liftA2 (:|) p . many $ sep *> p -- | This is the actual `Doc` lexer. Unlike `doc2`, it doesn’t do any Unison-side lexing (i.e., it doesn’t know that -- Unison wraps `Doc` literals in `}}`). docBody :: P end -> P (Doc.UntitledSection DocTree) -docBody docClose' = Doc.UntitledSection <$> P.many (sectionElem <* CP.space) +docBody docClose = Doc.UntitledSection <$> P.many (sectionElem <* CP.space) where wordyKw kw = separated wordySep (lit kw) sectionElem = section <|> fencedBlock <|> list <|> paragraph @@ -626,8 +610,6 @@ docBody docClose' = Doc.UntitledSection <$> P.many (sectionElem <* CP.space) ex <- CP.space *> lexemes' end pure ex - docClose = [] <$ docClose' - link = P.label "link (examples: {type List}, {Nat.+})" $ fmap Doc.Link $ @@ -636,20 +618,7 @@ docBody docClose' = Doc.UntitledSection <$> P.many (sectionElem <* CP.space) expr = fmap Doc.Transclude . P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ - openAs "{{" "syntax.docTransclude" - *> do - env0 <- S.get - -- we re-allow layout within a transclusion, then restore it to its - -- previous state after - S.put (env0 {inLayout = True}) - -- Note: this P.lookAhead ensures the }} isn't consumed, - -- so it can be consumed below by the `close` which will - -- pop items off the layout stack up to the nearest enclosing - -- syntax.docTransclude. - ts <- lexemes' (P.lookAhead ([] <$ lit "}}")) - S.modify (\env -> env {inLayout = inLayout env0}) - pure ts - <* close ["syntax.docTransclude"] (lit "}}") + lit "{{" *> lexemes' ([] <$ lit "}}") nonNewlineSpace ch = isSpace ch && ch /= '\n' && ch /= '\r' nonNewlineSpaces = P.takeWhileP Nothing nonNewlineSpace @@ -673,16 +642,12 @@ docBody docClose' = Doc.UntitledSection <$> P.many (sectionElem <* CP.space) b <- all isSpace <$> P.lookAhead (P.takeWhileP Nothing (/= '\n')) fence <$ guard b CP.space - *> local - (\env -> env {inLayout = True, opening = Just "docEval"}) - (restoreStack "docEval" $ lexemes' ([] <$ lit fence)) + *> lexemes' ([] <$ lit fence) exampleBlock = fmap (wrap' . Doc.ExampleBlock) $ do void $ lit "@typecheck" <* CP.space fence <- lit "```" <+> P.takeWhileP Nothing (== '`') - local - (\env -> env {inLayout = True, opening = Just "docExampleBlock"}) - (restoreStack "docExampleBlock" $ lexemes' ([] <$ lit fence)) + lexemes' $ [] <$ lit fence uncolumn column tabWidth s = let skip col r | col < 1 = r @@ -855,10 +820,16 @@ docBody docClose' = Doc.UntitledSection <$> P.many (sectionElem <* CP.space) wrapSimple2 fn a b = ann a <> ann b :< fn a b lexemes' :: P [Token Lexeme] -> P [Token Lexeme] -lexemes' = +lexemes' eof = -- NB: `postLex` requires the token stream to start with an `Open`, otherwise it can’t create a `T`, so this adds one, -- runs `postLex`, then removes it. - fmap (tail . postLex . (Token (Open "fake") mempty mempty :)) . lexemes + fmap (tail . postLex . (Token (Open "fake") mempty mempty :)) $ + local (\env -> env {inLayout = True, opening = Just "DUMMY"}) do + p <- lexemes eof + -- deals with a final "unclosed" block at the end of `p`) + unclosed <- takeWhile (("DUMMY" /=) . fst) . layout <$> S.get + let pos = end $ last p + pure $ p <> replicate (length unclosed) (Token Close pos pos) -- | Consumes an entire Unison “module”. lexemes :: P [Token Lexeme] -> P [Token Lexeme] @@ -1245,11 +1216,8 @@ separated :: (Char -> Bool) -> P a -> P a separated ok p = P.try $ p <* P.lookAhead (void (P.satisfy ok) <|> P.eof) open :: String -> P [Token Lexeme] -open b = openAs b b - -openAs :: String -> String -> P [Token Lexeme] -openAs syntax b = do - token <- tokenP $ lit syntax +open b = do + token <- tokenP $ lit b env <- S.get S.put (env {opening = Just b}) pure [Open b <$ token] From 6f2d188e5c8a0edae756046c7adaa0fbd9581407 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 25 Jul 2024 14:35:26 -0600 Subject: [PATCH 517/631] Split Doc parser from Unison lexer --- parser-typechecker/src/Unison/PrintError.hs | 2 +- .../src/Unison/Syntax/TermParser.hs | 2 +- .../src/Unison/Syntax/TermPrinter.hs | 2 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 5 +- unison-cli/src/Unison/LSP/FileAnalysis.hs | 2 +- unison-cli/src/Unison/LSP/Types.hs | 2 +- unison-syntax/src/Unison/Syntax/Lexer.hs | 1354 +---------------- .../src/Unison/Syntax/Lexer/Unison.hs | 910 +++++++++++ unison-syntax/src/Unison/Syntax/Parser.hs | 5 +- unison-syntax/src/Unison/Syntax/Parser/Doc.hs | 476 ++++++ unison-syntax/test/Main.hs | 2 +- unison-syntax/unison-syntax.cabal | 2 + 12 files changed, 1430 insertions(+), 1334 deletions(-) create mode 100644 unison-syntax/src/Unison/Syntax/Lexer/Unison.hs create mode 100644 unison-syntax/src/Unison/Syntax/Parser/Doc.hs diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 8b73b179f1..dd796c0159 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -54,7 +54,7 @@ import Unison.Result qualified as Result import Unison.Settings qualified as Settings import Unison.Symbol (Symbol) import Unison.Syntax.HashQualified qualified as HQ (toText) -import Unison.Syntax.Lexer qualified as L +import Unison.Syntax.Lexer.Unison qualified as L import Unison.Syntax.Name qualified as Name (toText) import Unison.Syntax.NamePrinter (prettyHashQualified0) import Unison.Syntax.Parser (Annotated, ann) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 6433bf220c..4c3069b9ff 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -47,7 +47,7 @@ import Unison.Pattern qualified as Pattern import Unison.Prelude import Unison.Reference (Reference) import Unison.Referent (Referent) -import Unison.Syntax.Lexer qualified as L +import Unison.Syntax.Lexer.Unison qualified as L import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser hiding (seq) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index faeda76020..5c41701bf8 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -51,7 +51,7 @@ import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Syntax.HashQualified qualified as HQ (unsafeFromVar) -import Unison.Syntax.Lexer (showEscapeChar) +import Unison.Syntax.Lexer.Unison (showEscapeChar) import Unison.Syntax.Name qualified as Name (isSymboly, parseText, parseTextEither, toText, unsafeParseText) import Unison.Syntax.NamePrinter (styleHashQualified'') import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index e85879cc4a..e17d3fdd9e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -151,8 +151,7 @@ import Unison.ShortHash qualified as SH import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.HashQualified qualified as HQ (parseTextWith, toText) -import Unison.Syntax.Lexer qualified as L -import Unison.Syntax.Lexer qualified as Lexer +import Unison.Syntax.Lexer.Unison qualified as L import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser qualified as Parser @@ -1137,7 +1136,7 @@ handleFindI isVerbose fscope ws input = do -- name query qs -> do - let anythingBeforeHash :: Megaparsec.Parsec (Lexer.Token Text) [Char] Text + let anythingBeforeHash :: Megaparsec.Parsec (L.Token Text) [Char] Text anythingBeforeHash = Text.pack <$> Megaparsec.takeWhileP Nothing (/= '#') let srs = searchBranchScored diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index 7a7ae006cf..bec9f8bf9f 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -57,7 +57,7 @@ import Unison.Result (Note) import Unison.Result qualified as Result import Unison.Symbol (Symbol) import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) -import Unison.Syntax.Lexer qualified as L +import Unison.Syntax.Lexer.Unison qualified as L import Unison.Syntax.Name qualified as Name import Unison.Syntax.Parser qualified as Parser import Unison.Syntax.TypePrinter qualified as TypePrinter diff --git a/unison-cli/src/Unison/LSP/Types.hs b/unison-cli/src/Unison/LSP/Types.hs index b368e915ef..268034ea5a 100644 --- a/unison-cli/src/Unison/LSP/Types.hs +++ b/unison-cli/src/Unison/LSP/Types.hs @@ -41,7 +41,7 @@ import Unison.Server.Backend qualified as Backend import Unison.Server.NameSearch (NameSearch) import Unison.Sqlite qualified as Sqlite import Unison.Symbol -import Unison.Syntax.Lexer qualified as Lexer +import Unison.Syntax.Lexer.Unison qualified as Lexer import Unison.Type (Type) import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Summary (FileSummary (..)) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index e2cba29dc4..cfd932cd7e 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -1,21 +1,13 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-orphans #-} +-- | This currently contains a mix of general lexing utilities and identifier-y lexers. module Unison.Syntax.Lexer ( Token (..), Line, Column, Err (..), Pos (..), - Lexeme (..), - DocTree, - lexer, - preParse, - escapeChars, - debugFilePreParse, - debugPreParse, - debugPreParse', - showEscapeChar, touches, -- * Character classifiers @@ -23,28 +15,40 @@ module Unison.Syntax.Lexer wordyIdStartChar, symbolyIdChar, - -- * Error formatting - formatTrivialError, - displayLexeme, + -- * new exports + BlockName, + Layout, + ParsingEnv (..), + P, + local, + parseFailure, + space, + lit, + err, + commitAfter2, + (<+>), + some', + someTill', + sepBy1', + separated, + wordySep, + identifierP, + wordyIdSegP, + shortHashP, + topBlockName, + pop, + typeOrAbilityAlt, + typeModifiersAlt, + inc, ) where import Control.Comonad.Cofree (Cofree ((:<))) -import Control.Lens qualified as Lens import Control.Monad.State qualified as S -import Data.Char (isAlphaNum, isControl, isDigit, isSpace, ord, toLower) -import Data.Foldable qualified as Foldable -import Data.List qualified as List -import Data.List.Extra qualified as List +import Data.Char (isSpace) import Data.List.NonEmpty (NonEmpty ((:|))) -import Data.List.NonEmpty qualified as Nel -import Data.List.NonEmpty qualified as NonEmpty -import Data.Map.Strict qualified as Map -import Data.Set qualified as Set import Data.Text qualified as Text -import GHC.Exts (sortWith) import Text.Megaparsec qualified as P -import Text.Megaparsec.Char (char) import Text.Megaparsec.Char qualified as CP import Text.Megaparsec.Char.Lexer qualified as LP import Text.Megaparsec.Error qualified as EP @@ -52,24 +56,16 @@ import Text.Megaparsec.Internal qualified as PI import Unison.HashQualifiedPrime qualified as HQ' import Unison.Lexer.Pos (Column, Line, Pos (Pos), column, line) import Unison.Name (Name) -import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) -import Unison.NameSegment qualified as NameSegment (docSegment) -import Unison.NameSegment.Internal qualified as NameSegment -import Unison.Parser.Ann (Ann, Annotated (..)) +import Unison.Parser.Ann (Annotated (..)) import Unison.Prelude import Unison.ShortHash (ShortHash) -import Unison.ShortHash qualified as SH -import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) -import Unison.Syntax.Lexer.Token (Token (..), posP, tokenP) -import Unison.Syntax.Name qualified as Name (isSymboly, nameP, toText, unsafeParseText) +import Unison.Syntax.Lexer.Token (Token (..), posP) +import Unison.Syntax.Name qualified as Name (nameP) import Unison.Syntax.NameSegment (symbolyIdChar, wordyIdChar, wordyIdStartChar) import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..), wordyP) -import Unison.Syntax.Parser.Doc.Data qualified as Doc -import Unison.Syntax.ReservedWords (delimiters, typeModifiers, typeOrAbility) +import Unison.Syntax.ReservedWords (typeModifiers, typeOrAbility) import Unison.Syntax.ShortHash qualified as ShortHash (shortHashP) -import Unison.Util.Bytes qualified as Bytes -import Unison.Util.Monoid (intercalateMap) instance (Annotated a) => Annotated (Cofree f a) where ann (a :< _) = ann a @@ -128,29 +124,6 @@ data Err | UnexpectedTokens String -- Catch-all for all other lexer errors, representing some unexpected tokens. deriving stock (Eq, Ord, Show) -- richer algebra --- Design principle: --- `[Lexeme]` should be sufficient information for parsing without --- further knowledge of spacing or indentation levels --- any knowledge of comments -data Lexeme - = Open String -- start of a block - | Semi IsVirtual -- separator between elements of a block - | Close -- end of a block - | Reserved String -- reserved tokens such as `{`, `(`, `type`, `of`, etc - | Textual String -- text literals, `"foo bar"` - | Character Char -- character literals, `?X` - | WordyId (HQ'.HashQualified Name) -- a (non-infix) identifier. invariant: last segment is wordy - | SymbolyId (HQ'.HashQualified Name) -- an infix identifier. invariant: last segment is symboly - | Blank String -- a typed hole or placeholder - | Numeric String -- numeric literals, left unparsed - | Bytes Bytes.Bytes -- bytes literals - | Hash ShortHash -- hash literals - | Err Err - | Doc (Doc.UntitledSection DocTree) - deriving stock (Eq, Show, Ord) - -type IsVirtual = Bool -- is it a virtual semi or an actual semi? - space :: P () space = LP.space @@ -163,15 +136,6 @@ space = lit :: String -> P String lit = P.try . LP.symbol (pure ()) -token :: P Lexeme -> P [Token Lexeme] -token = token' (\a start end -> [Token a start end]) - --- Token parser: strips trailing whitespace and comments after a --- successful parse, and also takes care of emitting layout tokens --- (such as virtual semicolons and closing tokens). -token' :: (a -> Pos -> Pos -> [Token Lexeme]) -> P a -> P [Token Lexeme] -token' tok p = LP.lexeme space (token'' tok p) - -- Committed failure err :: Pos -> Err -> P x err start t = do @@ -193,283 +157,11 @@ commitAfter2 a b f = do (a, b) <- P.try $ liftA2 (,) a b f a b --- Token parser implementation which leaves trailing whitespace and comments --- but does emit layout tokens such as virtual semicolons and closing tokens. -token'' :: (a -> Pos -> Pos -> [Token Lexeme]) -> P a -> P [Token Lexeme] -token'' tok p = do - start <- posP - -- We save the current state so we can backtrack the state if `p` fails. - env <- S.get - layoutToks <- case opening env of - -- If we're opening a block named b, we push (b, currentColumn) onto - -- the layout stack. Example: - -- - -- blah = cases - -- {- A comment -} - -- -- A one-line comment - -- 0 -> "hi" - -- 1 -> "bye" - -- - -- After the `cases` token, the state will be opening = Just "cases", - -- meaning the parser is searching for the next non-whitespace/comment - -- character to determine the leftmost column of the `cases` block. - -- That will be the column of the `0`. - Just blockname -> - -- special case - handling of empty blocks, as in: - -- foo = - -- bar = 42 - if blockname == "=" && column start <= top l && not (null l) - then do - S.put (env {layout = (blockname, column start + 1) : l, opening = Nothing}) - pops start - else [] <$ S.put (env {layout = layout', opening = Nothing}) - where - layout' = (blockname, column start) : l - l = layout env - -- If we're not opening a block, we potentially pop from - -- the layout stack and/or emit virtual semicolons. - Nothing -> if inLayout env then pops start else pure [] - beforeTokenPos <- posP - a <- p <|> (S.put env >> fail "resetting state") - endPos <- posP - pure $ layoutToks ++ tok a beforeTokenPos endPos - where - pops :: Pos -> P [Token Lexeme] - pops p = do - env <- S.get - let l = layout env - if top l == column p && topContainsVirtualSemis l - then pure [Token (Semi True) p p] - else - if column p > top l || topHasClosePair l - then pure [] - else - if column p < top l - then S.put (env {layout = pop l}) >> ((Token Close p p :) <$> pops p) - else error "impossible" - - -- don't emit virtual semis in (, {, or [ blocks - topContainsVirtualSemis :: Layout -> Bool - topContainsVirtualSemis = \case - [] -> False - ((name, _) : _) -> name /= "(" && name /= "{" && name /= "[" - - topHasClosePair :: Layout -> Bool - topHasClosePair [] = False - topHasClosePair ((name, _) : _) = - name `elem` ["DUMMY", "{", "(", "[", "handle", "match", "if", "then"] - -showErrorFancy :: (P.ShowErrorComponent e) => P.ErrorFancy e -> String -showErrorFancy = \case - P.ErrorFail msg -> msg - P.ErrorIndentation ord ref actual -> - "incorrect indentation (got " - <> show (P.unPos actual) - <> ", should be " - <> p - <> show (P.unPos ref) - <> ")" - where - p = case ord of - LT -> "less than " - EQ -> "equal to " - GT -> "greater than " - P.ErrorCustom a -> P.showErrorComponent a - -lexer :: String -> String -> [Token Lexeme] -lexer scope rem = - case flip S.evalState env0 $ P.runParserT (lexemes eof) scope rem of - Left e -> - let errsWithSourcePos = - fst $ - P.attachSourcePos - P.errorOffset - (toList (P.bundleErrors e)) - (P.bundlePosState e) - errorToTokens :: (EP.ParseError String (Token Err), P.SourcePos) -> [Token Lexeme] - errorToTokens (err, top) = case err of - P.FancyError _ (customErrs -> es) | not (null es) -> es - P.FancyError _errOffset es -> - let msg = intercalateMap "\n" showErrorFancy es - in [Token (Err (UnexpectedTokens msg)) (toPos top) (toPos top)] - P.TrivialError _errOffset mayUnexpectedTokens expectedTokens -> - let unexpectedStr :: Set String - unexpectedStr = - mayUnexpectedTokens - & fmap errorItemToString - & maybeToList - & Set.fromList - errorLength :: Int - errorLength = case Set.toList unexpectedStr of - [] -> 0 - (x : _) -> length x - expectedStr :: Set String - expectedStr = - expectedTokens - & Set.map errorItemToString - err = UnexpectedTokens $ formatTrivialError unexpectedStr expectedStr - startPos = toPos top - -- This is just an attempt to highlight errors better in source excerpts. - -- It may not work in all cases, but should generally provide a better experience. - endPos = startPos & \(Pos l c) -> Pos l (c + errorLength) - in [Token (Err err) startPos endPos] - in errsWithSourcePos >>= errorToTokens - Right ts -> postLex $ Token (Open scope) topLeftCorner topLeftCorner : ts - where - eof :: P [Token Lexeme] - eof = P.try do - p <- P.eof >> posP - n <- maybe 0 (const 1) <$> S.gets opening - l <- S.gets layout - pure $ replicate (length l + n) (Token Close p p) - errorItemToString :: EP.ErrorItem Char -> String - errorItemToString = \case - (P.Tokens ts) -> Foldable.toList ts - (P.Label ts) -> Foldable.toList ts - (P.EndOfInput) -> "end of input" - customErrs es = [Err <$> e | P.ErrorCustom e <- toList es] - toPos (P.SourcePos _ line col) = Pos (P.unPos line) (P.unPos col) - env0 = ParsingEnv [] (Just scope) True [0] 0 - --- | hacky postprocessing pass to do some cleanup of stuff that's annoying to --- fix without adding more state to the lexer: --- - 1+1 lexes as [1, +1], convert this to [1, +, 1] --- - when a semi followed by a virtual semi, drop the virtual, lets you --- write --- foo x = action1; --- 2 --- - semi immediately after first Open is ignored -tweak :: (Token Lexeme) -> [Token Lexeme] -> [Token Lexeme] -tweak h@(Token (Semi False) _ _) (Token (Semi True) _ _ : t) = h : t --- __NB__: This case only exists to guard against the following one -tweak h@(Token (Reserved _) _ _) t = h : t -tweak t1 (t2@(Token (Numeric num) _ _) : rem) - | notLayout t1 && touches t1 t2 && isSigned num = - t1 - : Token - (SymbolyId (HQ'.fromName (Name.unsafeParseText (Text.pack (take 1 num))))) - (start t2) - (inc $ start t2) - : Token (Numeric (drop 1 num)) (inc $ start t2) (end t2) - : rem - where - isSigned num = all (\ch -> ch == '-' || ch == '+') $ take 1 num -tweak h t = h : t - -formatTrivialError :: Set String -> Set String -> [Char] -formatTrivialError unexpectedTokens expectedTokens = - let unexpectedMsg = case Set.toList unexpectedTokens of - [] -> "I found something I didn't expect." - [x] -> - let article = case x of - (c : _) | c `elem` ("aeiou" :: String) -> "an" - _ -> "a" - in "I was surprised to find " <> article <> " " <> x <> " here." - xs -> "I was surprised to find these:\n\n* " <> List.intercalate "\n* " xs - expectedMsg = case Set.toList expectedTokens of - [] -> Nothing - xs -> Just $ "\nI was expecting one of these instead:\n\n* " <> List.intercalate "\n* " xs - in concat $ catMaybes [Just unexpectedMsg, expectedMsg] - -displayLexeme :: Lexeme -> String -displayLexeme = \case - Open o -> o - Semi True -> "end of stanza" - Semi False -> "semicolon" - Close -> "end of section" - Reserved r -> "'" <> r <> "'" - Textual t -> "\"" <> t <> "\"" - Character c -> "?" <> [c] - WordyId hq -> Text.unpack (HQ'.toTextWith Name.toText hq) - SymbolyId hq -> Text.unpack (HQ'.toTextWith Name.toText hq) - Blank b -> b - Numeric n -> n - Bytes _b -> "bytes literal" - Hash h -> Text.unpack (SH.toText h) - Err e -> show e - Doc _ -> "doc structure" - infixl 2 <+> (<+>) :: (Monoid a) => P a -> P a -> P a p1 <+> p2 = do a1 <- p1; a2 <- p2; pure (a1 <> a2) -type DocTree = Cofree (Doc.Top [Token Lexeme]) Ann - --- | The `Doc` lexer as documented on unison-lang.org -doc2 :: P [Token Lexeme] -doc2 = do - -- Ensure we're at a doc before we start consuming tokens - P.lookAhead (lit "{{") - openStart <- posP - -- Produce any layout tokens, such as closing the last open block or virtual semicolons - -- We don't use 'token' on "{{" directly because we don't want to duplicate layout - -- tokens if we do the rewrite hack for type-docs below. - beforeStartToks <- token' ignore (pure ()) - void $ lit "{{" - openEnd <- posP - CP.space - env0 <- S.get - -- Disable layout while parsing the doc block and reset the section number - (docTok, closeTok) <- local - ( \env -> - env - { inLayout = False, - parentSections = 0 : (parentSections env0) - } - ) - do - body <- docBody (lit "}}") - closeStart <- posP - lit "}}" - closeEnd <- posP - pure (Token (Doc body) openStart closeEnd, Token Close closeStart closeEnd) - -- Parse any layout tokens after the doc block, e.g. virtual semicolon - endToks <- token' ignore (pure ()) - -- Hack to allow anonymous doc blocks before type decls - -- {{ Some docs }} Foo.doc = {{ Some docs }} - -- ability Foo where => ability Foo where - -- - -- __FIXME__: This should be done _after_ parsing, not in lexing. - tn <- subsequentTypeName - pure $ - beforeStartToks <> case (tn) of - -- If we're followed by a type, we rewrite the doc block to be a named doc block. - Just (WordyId tname) - | isTopLevel -> - Token (WordyId (HQ'.fromName (Name.snoc (HQ'.toName tname) NameSegment.docSegment))) openStart openEnd - : Token (Open "=") openStart openEnd - : docTok - -- We need an extra 'Close' here because we added an extra Open above. - : closeTok - : endToks - where - isTopLevel = length (layout env0) + maybe 0 (const 1) (opening env0) == 1 - _ -> docTok : endToks - where - -- DUPLICATED - wordyKw kw = separated wordySep (lit kw) - subsequentTypeName = P.lookAhead . P.optional $ do - let lit' s = lit s <* sp - let modifier = typeModifiersAlt (lit' . Text.unpack) - let typeOrAbility' = typeOrAbilityAlt (wordyKw . Text.unpack) - _ <- optional modifier *> typeOrAbility' *> sp - Token name start stop <- tokenP identifierP - if Name.isSymboly (HQ'.toName name) - then P.customFailure (Token (InvalidSymbolyId (Text.unpack (HQ'.toTextWith Name.toText name))) start stop) - else pure (WordyId name) - ignore _ _ _ = [] - -- DUPLICATED - sp = P.try $ do - spaces <- P.takeWhile1P (Just "space") isSpace - close <- P.optional (P.lookAhead (lit "}}")) - case close of - Nothing -> guard $ ok spaces - Just _ -> pure () - pure spaces - where - ok s = length [() | '\n' <- s] < 2 - -- | Like `P.some`, but returns an actual `NonEmpty`. some' :: P a -> P (NonEmpty a) some' p = liftA2 (:|) p $ many p @@ -482,761 +174,12 @@ someTill' p end = liftA2 (:|) p $ P.manyTill p end sepBy1' :: P a -> P sep -> P (NonEmpty a) sepBy1' p sep = liftA2 (:|) p . many $ sep *> p --- | This is the actual `Doc` lexer. Unlike `doc2`, it doesn’t do any Unison-side lexing (i.e., it doesn’t know that --- Unison wraps `Doc` literals in `}}`). -docBody :: P end -> P (Doc.UntitledSection DocTree) -docBody docClose = Doc.UntitledSection <$> P.many (sectionElem <* CP.space) - where - wordyKw kw = separated wordySep (lit kw) - sectionElem = section <|> fencedBlock <|> list <|> paragraph - paragraph = wrap' . Doc.Paragraph <$> spaced leaf - reserved word = List.isPrefixOf "}}" word || all (== '#') word - - wordy :: P end -> P (Doc.Leaf [Token Lexeme] void) - wordy closing = fmap Doc.Word . tokenP . P.try $ do - let end = - P.lookAhead $ - void docClose - <|> void (P.satisfy isSpace) - <|> void closing - word <- P.manyTill (P.satisfy (\ch -> not (isSpace ch))) end - guard (not $ reserved word || null word) - pure word - - leafy closing = groupy closing gs - where - gs = - link - <|> externalLink - <|> exampleInline - <|> expr - <|> boldOrItalicOrStrikethrough closing - <|> verbatim - <|> atDoc - <|> wordy closing - - leaf = leafy mzero - - atDoc = src <|> evalInline <|> signature <|> signatureInline - where - comma = lit "," <* CP.space - src = - src' Doc.Source "@source" - <|> src' Doc.FoldedSource "@foldedSource" - srcElem = - Doc.SourceElement - <$> (typeLink <|> termLink) - <*> ( fmap (fromMaybe []) . P.optional $ - (lit "@") *> (CP.space *> annotations) - ) - where - annotation = fmap Left (tokenP identifierP) <|> fmap Right expr <* CP.space - annotations = - P.some (Doc.EmbedAnnotation <$> annotation) - src' name atName = fmap name $ do - _ <- lit atName *> (lit " {" <|> lit "{") *> CP.space - s <- sepBy1' srcElem comma - _ <- lit "}" - pure s - signature = fmap Doc.Signature $ do - _ <- (lit "@signatures" <|> lit "@signature") *> (lit " {" <|> lit "{") *> CP.space - s <- sepBy1' signatureLink comma - _ <- lit "}" - pure s - signatureInline = fmap Doc.SignatureInline $ do - _ <- lit "@inlineSignature" *> (lit " {" <|> lit "{") *> CP.space - s <- signatureLink - _ <- lit "}" - pure s - evalInline = fmap Doc.EvalInline $ do - _ <- lit "@eval" *> (lit " {" <|> lit "{") *> CP.space - let inlineEvalClose = [] <$ lit "}" - s <- lexemes' inlineEvalClose - pure s - - typeLink = fmap Doc.EmbedTypeLink $ do - _ <- typeOrAbilityAlt (wordyKw . Text.unpack) <* CP.space - tokenP identifierP <* CP.space - - termLink = - fmap Doc.EmbedTermLink $ - tokenP identifierP <* CP.space - - signatureLink = - fmap Doc.EmbedSignatureLink $ - tokenP identifierP <* CP.space - - groupy closing p = do - Token p _ _ <- tokenP p - after <- P.optional . P.try $ leafy closing - pure $ case after of - Nothing -> p - Just after -> - Doc.Group - . Doc.Join - $ p - :| pure after - - verbatim = - P.label "code (examples: ''**unformatted**'', `words` or '''_words_''')" $ do - Token originalText start stop <- tokenP do - -- a single backtick followed by a non-backtick is treated as monospaced - let tick = P.try (lit "`" <* P.lookAhead (P.satisfy (/= '`'))) - -- also two or more ' followed by that number of closing ' - quotes <- tick <|> (lit "''" <+> P.takeWhileP Nothing (== '\'')) - P.someTill P.anySingle (lit quotes) - let isMultiLine = line start /= line stop - if isMultiLine - then do - let trimmed = (trimAroundDelimiters originalText) - let txt = trimIndentFromVerbatimBlock (column start - 1) trimmed - -- If it's a multi-line verbatim block we trim any whitespace representing - -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' - pure . Doc.Verbatim $ - Doc.Word $ - Token txt start stop - else - pure . Doc.Code $ - Doc.Word $ - Token originalText start stop - - exampleInline = - P.label "inline code (examples: ``List.map f xs``, ``[1] :+ 2``)" $ - fmap Doc.Example $ do - n <- P.try $ do - _ <- lit "`" - length <$> P.takeWhile1P (Just "backticks") (== '`') - let end :: P [Token Lexeme] = [] <$ lit (replicate (n + 1) '`') - ex <- CP.space *> lexemes' end - pure ex - - link = - P.label "link (examples: {type List}, {Nat.+})" $ - fmap Doc.Link $ - P.try $ - lit "{" *> (typeLink <|> termLink) <* lit "}" - - expr = - fmap Doc.Transclude . P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ - lit "{{" *> lexemes' ([] <$ lit "}}") - - nonNewlineSpace ch = isSpace ch && ch /= '\n' && ch /= '\r' - nonNewlineSpaces = P.takeWhileP Nothing nonNewlineSpace - - -- Allows whitespace or a newline, but not more than two newlines in a row. - whitespaceWithoutParagraphBreak :: P () - whitespaceWithoutParagraphBreak = void do - void nonNewlineSpaces - optional newline >>= \case - Just _ -> void nonNewlineSpaces - Nothing -> pure () - - fencedBlock = - P.label "block eval (syntax: a fenced code block)" $ - evalUnison <|> exampleBlock <|> other - where - evalUnison = fmap (wrap' . Doc.Eval) $ do - -- commit after seeing that ``` is on its own line - fence <- P.try $ do - fence <- lit "```" <+> P.takeWhileP Nothing (== '`') - b <- all isSpace <$> P.lookAhead (P.takeWhileP Nothing (/= '\n')) - fence <$ guard b - CP.space - *> lexemes' ([] <$ lit fence) - - exampleBlock = fmap (wrap' . Doc.ExampleBlock) $ do - void $ lit "@typecheck" <* CP.space - fence <- lit "```" <+> P.takeWhileP Nothing (== '`') - lexemes' $ [] <$ lit fence - - uncolumn column tabWidth s = - let skip col r | col < 1 = r - skip col s@('\t' : _) | col < tabWidth = s - skip col ('\t' : r) = skip (col - tabWidth) r - skip col (c : r) - | isSpace c && (not $ isControl c) = - skip (col - 1) r - skip _ s = s - in List.intercalate "\n" $ skip column <$> lines s - - other = fmap (uncurry $ wrapSimple2 Doc.CodeBlock) $ do - column <- (\x -> x - 1) . toInteger . P.unPos <$> LP.indentLevel - let tabWidth = toInteger . P.unPos $ P.defaultTabWidth - fence <- lit "```" <+> P.takeWhileP Nothing (== '`') - name <- - P.takeWhileP Nothing nonNewlineSpace - *> tokenP (P.takeWhile1P Nothing (not . isSpace)) - <* P.takeWhileP Nothing nonNewlineSpace - _ <- void CP.eol - verbatim <- - tokenP $ - uncolumn column tabWidth . trimAroundDelimiters - <$> P.someTill P.anySingle ([] <$ lit fence) - pure (name, verbatim) - - boldOrItalicOrStrikethrough closing = do - let start = - some (P.satisfy (== '*')) - <|> some (P.satisfy (== '_')) - <|> some - (P.satisfy (== '~')) - name s = - if take 1 s == "~" - then Doc.Strikethrough - else if take 1 s == "*" then Doc.Bold else Doc.Italic - end <- P.try $ do - end <- start - P.lookAhead (P.satisfy (not . isSpace)) - pure end - name end . wrap' . Doc.Paragraph - <$> someTill' - (leafy (closing <|> (void $ lit end)) <* whitespaceWithoutParagraphBreak) - (lit end) - - externalLink = - P.label "hyperlink (example: [link name](https://destination.com))" $ - fmap (uncurry Doc.NamedLink) $ do - _ <- lit "[" - p <- leafies (void $ char ']') - _ <- lit "]" - _ <- lit "(" - target <- - fmap (Doc.Group . Doc.Join) $ - fmap pure link <|> some' (expr <|> wordy (char ')')) - _ <- lit ")" - pure (p, target) - - -- newline = P.optional (lit "\r") *> lit "\n" - - sp = P.try $ do - spaces <- P.takeWhile1P (Just "space") isSpace - close <- P.optional (P.lookAhead (lit "}}")) - case close of - Nothing -> guard $ ok spaces - Just _ -> pure () - pure spaces - where - ok s = length [() | '\n' <- s] < 2 - - spaced p = some' (p <* P.optional sp) - leafies close = wrap' . Doc.Paragraph <$> spaced (leafy close) - - list = bulletedList <|> numberedList - - bulletedList = wrap' . Doc.BulletedList <$> sepBy1' bullet listSep - numberedList = wrap' . Doc.NumberedList <$> sepBy1' numberedItem listSep - - listSep = P.try $ newline *> nonNewlineSpaces *> P.lookAhead (void bulletedStart <|> void numberedStart) - - bulletedStart = P.try $ do - r <- listItemStart' $ [] <$ P.satisfy bulletChar - P.lookAhead (P.satisfy isSpace) - pure r - where - bulletChar ch = ch == '*' || ch == '-' || ch == '+' - - listItemStart' :: P a -> P (Int, a) - listItemStart' gutter = P.try $ do - nonNewlineSpaces - col <- column <$> posP - parentCol <- S.gets parentListColumn - guard (col > parentCol) - (col,) <$> gutter - - numberedStart = - listItemStart' $ P.try (tokenP $ LP.decimal <* lit ".") - - listItemParagraph = fmap (wrap' . Doc.Paragraph) $ do - col <- column <$> posP - some' (leaf <* sep col) - where - -- Trickiness here to support hard line breaks inside of - -- a bulleted list, so for instance this parses as expected: - -- - -- * uno dos - -- tres quatro - -- * alice bob - -- carol dave eve - sep col = do - _ <- nonNewlineSpaces - _ <- - P.optional . P.try $ - newline - *> nonNewlineSpaces - *> do - col2 <- column <$> posP - guard $ col2 >= col - (P.notFollowedBy $ void numberedStart <|> void bulletedStart) - pure () - - numberedItem = P.label msg $ do - (col, s) <- numberedStart - (s,) - <$> ( fmap (uncurry Doc.Column) $ do - p <- nonNewlineSpaces *> listItemParagraph - subList <- - local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> list) - pure (p, subList) - ) - where - msg = "numbered list (examples: 1. item1, 8. start numbering at '8')" - - bullet = fmap (uncurry Doc.Column) . P.label "bullet (examples: * item1, - item2)" $ do - (col, _) <- bulletedStart - p <- nonNewlineSpaces *> listItemParagraph - subList <- - local - (\e -> e {parentListColumn = col}) - (P.optional $ listSep *> list) - pure (p, subList) - - newline = P.label "newline" $ lit "\n" <|> lit "\r\n" - - -- ## Section title - -- - -- A paragraph under this section. - -- Part of the same paragraph. Blanklines separate paragraphs. - -- - -- ### A subsection title - -- - -- A paragraph under this subsection. - - -- # A section title (not a subsection) - section :: P DocTree - section = fmap (wrap' . uncurry Doc.Section) $ do - ns <- S.gets parentSections - hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp - title <- paragraph <* CP.space - let m = length hashes + head ns - body <- - local (\env -> env {parentSections = (m : (tail ns))}) $ - P.many (sectionElem <* CP.space) - pure $ (title, body) - - wrap' :: Doc.Top [Token Lexeme] DocTree -> DocTree - wrap' doc = ann doc :< doc - - wrapSimple2 :: (Annotated a, Annotated b) => (a -> b -> Doc.Top [Token Lexeme] DocTree) -> a -> b -> DocTree - wrapSimple2 fn a b = ann a <> ann b :< fn a b - -lexemes' :: P [Token Lexeme] -> P [Token Lexeme] -lexemes' eof = - -- NB: `postLex` requires the token stream to start with an `Open`, otherwise it can’t create a `T`, so this adds one, - -- runs `postLex`, then removes it. - fmap (tail . postLex . (Token (Open "fake") mempty mempty :)) $ - local (\env -> env {inLayout = True, opening = Just "DUMMY"}) do - p <- lexemes eof - -- deals with a final "unclosed" block at the end of `p`) - unclosed <- takeWhile (("DUMMY" /=) . fst) . layout <$> S.get - let pos = end $ last p - pure $ p <> replicate (length unclosed) (Token Close pos pos) - --- | Consumes an entire Unison “module”. -lexemes :: P [Token Lexeme] -> P [Token Lexeme] -lexemes eof = - P.optional space >> do - hd <- join <$> P.manyTill toks (P.lookAhead eof) - tl <- eof - pure $ hd <> tl - where - toks :: P [Token Lexeme] - toks = - doc2 - <|> doc - <|> token numeric - <|> token character - <|> reserved - <|> token blank - <|> token identifierLexemeP - <|> (asum . map token) [semi, textual, hash] - - doc :: P [Token Lexeme] - doc = open <+> (CP.space *> fmap fixup body) <+> (close <* space) - where - open = token'' (\t _ _ -> t) $ tok (Open <$> lit "[:") - close = tok (Close <$ lit ":]") - at = lit "@" - -- this removes some trailing whitespace from final textual segment - fixup [] = [] - fixup (Token (Textual (reverse -> txt)) start stop : []) = - [Token (Textual txt') start stop] - where - txt' = reverse (dropWhile (\c -> isSpace c && not (c == '\n')) txt) - fixup (h : t) = h : fixup t - - body :: P [Token Lexeme] - body = txt <+> (atk <|> pure []) - where - ch = (":]" <$ lit "\\:]") <|> ("@" <$ lit "\\@") <|> (pure <$> P.anySingle) - txt = tok (Textual . join <$> P.manyTill ch (P.lookAhead sep)) - sep = void at <|> void close - ref = at *> (tok identifierLexemeP <|> docTyp) - atk = (ref <|> docTyp) <+> body - docTyp = do - _ <- lit "[" - typ <- tok (P.manyTill P.anySingle (P.lookAhead (lit "]"))) - _ <- lit "]" *> CP.space - t <- tok identifierLexemeP - pure $ (fmap Reserved <$> typ) <> t - - blank = - separated wordySep do - _ <- char '_' - seg <- P.optional wordyIdSegP - pure (Blank (maybe "" (Text.unpack . NameSegment.toUnescapedText) seg)) - - semi = char ';' $> Semi False - textual = Textual <$> quoted - quoted = quotedRaw <|> quotedSingleLine - quotedRaw = do - _ <- lit "\"\"\"" - n <- many (char '"') - _ <- optional (char '\n') -- initial newline is skipped - s <- P.manyTill P.anySingle (lit (replicate (length n + 3) '"')) - col0 <- column <$> posP - let col = col0 - (length n) - 3 -- this gets us first col of closing quotes - let leading = replicate (max 0 (col - 1)) ' ' - -- a last line that's equal to `leading` is ignored, since leading - -- spaces up to `col` are not considered part of the string - let tweak l = case reverse l of - last : rest - | col > 1 && last == leading -> reverse rest - | otherwise -> l - [] -> [] - pure $ case tweak (lines s) of - [] -> s - ls - | all (\l -> List.isPrefixOf leading l || all isSpace l) ls -> List.intercalate "\n" (drop (length leading) <$> ls) - | otherwise -> s - quotedSingleLine = char '"' *> P.manyTill (LP.charLiteral <|> sp) (char '"') - where - sp = lit "\\s" $> ' ' - character = Character <$> (char '?' *> (spEsc <|> LP.charLiteral)) - where - spEsc = P.try (char '\\' *> char 's' $> ' ') - - numeric = bytes <|> otherbase <|> float <|> intOrNat - where - intOrNat = P.try $ num <$> sign <*> LP.decimal - float = do - _ <- P.try (P.lookAhead (sign >> (LP.decimal :: P Int) >> (char '.' <|> char 'e' <|> char 'E'))) -- commit after this - start <- posP - sign <- fromMaybe "" <$> sign - base <- P.takeWhile1P (Just "base") isDigit - decimals <- - P.optional $ - let missingFractional = err start (MissingFractional $ base <> ".") - in liftA2 (<>) (lit ".") (P.takeWhile1P (Just "decimals") isDigit <|> missingFractional) - exp <- P.optional $ do - e <- map toLower <$> (lit "e" <|> lit "E") - sign <- fromMaybe "" <$> optional (lit "+" <|> lit "-") - let missingExp = err start (MissingExponent $ base <> fromMaybe "" decimals <> e <> sign) - exp <- P.takeWhile1P (Just "exponent") isDigit <|> missingExp - pure $ e <> sign <> exp - pure $ Numeric (sign <> base <> fromMaybe "" decimals <> fromMaybe "" exp) - - bytes = do - start <- posP - _ <- lit "0xs" - s <- map toLower <$> P.takeWhileP (Just "hexidecimal character") isAlphaNum - case Bytes.fromBase16 $ Bytes.fromWord8s (fromIntegral . ord <$> s) of - Left _ -> err start (InvalidBytesLiteral $ "0xs" <> s) - Right bs -> pure (Bytes bs) - otherbase = octal <|> hex - octal = do - start <- posP - commitAfter2 sign (lit "0o") $ \sign _ -> - fmap (num sign) LP.octal <|> err start InvalidOctalLiteral - hex = do - start <- posP - commitAfter2 sign (lit "0x") $ \sign _ -> - fmap (num sign) LP.hexadecimal <|> err start InvalidHexLiteral - - num :: Maybe String -> Integer -> Lexeme - num sign n = Numeric (fromMaybe "" sign <> show n) - sign = P.optional (lit "+" <|> lit "-") - - hash = Hash <$> P.try shortHashP - - reserved :: P [Token Lexeme] - reserved = - token' (\ts _ _ -> ts) $ - braces - <|> parens - <|> brackets - <|> commaSeparator - <|> delim - <|> delayOrForce - <|> keywords - <|> layoutKeywords - where - keywords = - -- yes "wordy" - just like a wordy keyword like "true", the literal "." (as in the dot in - -- "forall a. a -> a") is considered the keyword "." so long as it is either followed by EOF, a space, or some - -- non-wordy character (because ".foo" is a single identifier lexeme) - wordyKw "." - <|> symbolyKw ":" - <|> openKw "@rewrite" - <|> symbolyKw "@" - <|> symbolyKw "||" - <|> symbolyKw "|" - <|> symbolyKw "&&" - <|> wordyKw "true" - <|> wordyKw "false" - <|> wordyKw "use" - <|> wordyKw "forall" - <|> wordyKw "∀" - <|> wordyKw "termLink" - <|> wordyKw "typeLink" - - wordyKw s = separated wordySep (kw s) - symbolyKw s = separated (not . symbolyIdChar) (kw s) - - kw :: String -> P [Token Lexeme] - kw s = tokenP (lit s) <&> \token -> [Reserved <$> token] - - layoutKeywords :: P [Token Lexeme] - layoutKeywords = - ifElse - <|> withKw - <|> openKw "match" - <|> openKw "handle" - <|> typ - <|> arr - <|> rewriteArr - <|> eq - <|> openKw "cases" - <|> openKw "where" - <|> openKw "let" - <|> openKw "do" - where - ifElse = - openKw "if" - <|> closeKw' (Just "then") ["if"] (lit "then") - <|> closeKw' (Just "else") ["then"] (lit "else") - modKw = typeModifiersAlt (openKw1 wordySep . Text.unpack) - typeOrAbilityKw = typeOrAbilityAlt (openTypeKw1 . Text.unpack) - typ = modKw <|> typeOrAbilityKw - - withKw = do - [Token _ pos1 pos2] <- wordyKw "with" - env <- S.get - let l = layout env - case findClose ["handle", "match"] l of - Nothing -> err pos1 (CloseWithoutMatchingOpen msgOpen "'with'") - where - msgOpen = "'handle' or 'match'" - Just (withBlock, n) -> do - let b = withBlock <> "-with" - S.put (env {layout = drop n l, opening = Just b}) - let opens = [Token (Open "with") pos1 pos2] - pure $ replicate n (Token Close pos1 pos2) ++ opens - - -- In `structural/unique type` and `structural/unique ability`, - -- only the `structural` or `unique` opens a layout block, - -- and `ability` and `type` are just keywords. - openTypeKw1 t = do - b <- S.gets (topBlockName . layout) - case b of - Just mod | Set.member (Text.pack mod) typeModifiers -> wordyKw t - _ -> openKw1 wordySep t - - -- layout keyword which bumps the layout column by 1, rather than looking ahead - -- to the next token to determine the layout column - openKw1 :: (Char -> Bool) -> String -> P [Token Lexeme] - openKw1 sep kw = do - Token kw pos0 pos1 <- tokenP $ separated sep (lit kw) - S.modify (\env -> env {layout = (kw, column $ inc pos0) : layout env}) - pure [Token (Open kw) pos0 pos1] - - eq = do - [Token _ start end] <- symbolyKw "=" - env <- S.get - case topBlockName (layout env) of - -- '=' does not open a layout block if within a type declaration - Just t | t == "type" || Set.member (Text.pack t) typeModifiers -> pure [Token (Reserved "=") start end] - Just _ -> S.put (env {opening = Just "="}) >> pure [Token (Open "=") start end] - _ -> err start LayoutError - - rewriteArr = do - [Token _ start end] <- symbolyKw "==>" - env <- S.get - S.put (env {opening = Just "==>"}) >> pure [Token (Open "==>") start end] - - arr = do - [Token _ start end] <- symbolyKw "->" - env <- S.get - -- -> introduces a layout block if we're inside a `match with` or `cases` - case topBlockName (layout env) of - Just match | match `elem` matchWithBlocks -> do - S.put (env {opening = Just "->"}) - pure [Token (Open "->") start end] - _ -> pure [Token (Reserved "->") start end] - - -- a bit of lookahead here to reserve }} for closing a documentation block - braces = open "{" <|> close ["{"] p - where - p = do - l <- lit "}" - -- if we're within an existing {{ }} block, inLayout will be false - -- so we can actually allow }} to appear in normal code - inLayout <- S.gets inLayout - when (not inLayout) $ void $ P.lookAhead (P.satisfy (/= '}')) - pure l - matchWithBlocks = ["match-with", "cases"] - parens = open "(" <|> close ["("] (lit ")") - brackets = open "[" <|> close ["["] (lit "]") - -- `allowCommaToClose` determines if a comma should close inner blocks. - -- Currently there is a set of blocks where `,` is not treated specially - -- and it just emits a Reserved ",". There are currently only three: - -- `cases`, `match-with`, and `{` - allowCommaToClose match = not $ match `elem` ("{" : matchWithBlocks) - commaSeparator = do - env <- S.get - case topBlockName (layout env) of - Just match - | allowCommaToClose match -> - blockDelimiter ["[", "("] (lit ",") - _ -> fail "this comma is a pattern separator" - - delim = P.try $ do - ch <- P.satisfy (\ch -> ch /= ';' && Set.member ch delimiters) - pos <- posP - pure [Token (Reserved [ch]) pos (inc pos)] - - delayOrForce = separated ok $ do - token <- tokenP $ P.satisfy isDelayOrForce - pure [token <&> \op -> Reserved [op]] - where - ok c = isDelayOrForce c || isSpace c || isAlphaNum c || Set.member c delimiters || c == '\"' - --- | If it's a multi-line verbatim block we trim any whitespace representing --- indentation from the pretty-printer. --- --- E.g. --- --- @@ --- {{ --- # Heading --- ''' --- code --- indented --- ''' --- }} --- @@ --- --- Should lex to the text literal "code\n indented". --- --- If there's text in the literal that has LESS trailing whitespace than the --- opening delimiters, we don't trim it at all. E.g. --- --- @@ --- {{ --- # Heading --- ''' --- code --- ''' --- }} --- @@ --- --- Is parsed as " code". --- --- Trim the expected amount of whitespace from a text literal: --- >>> trimIndentFromVerbatimBlock 2 " code\n indented" --- "code\n indented" --- --- If the text literal has less leading whitespace than the opening delimiters, --- leave it as-is --- >>> trimIndentFromVerbatimBlock 2 "code\n indented" --- "code\n indented" -trimIndentFromVerbatimBlock :: Int -> String -> String -trimIndentFromVerbatimBlock leadingSpaces txt = fromMaybe txt $ do - List.intercalate "\n" <$> for (lines txt) \line -> do - -- If any 'stripPrefix' fails, we fail and return the unaltered text - case List.stripPrefix (replicate leadingSpaces ' ') line of - Just stripped -> Just stripped - Nothing -> - -- If it was a line with all white-space, just use an empty line, - -- this can happen easily in editors which trim trailing whitespace. - if all isSpace line - then Just "" - else Nothing - --- Trim leading/trailing whitespace from around delimiters, e.g. --- --- {{ --- '''___ <- whitespace here including newline --- text block --- 👇 or here --- __''' --- }} --- >>> trimAroundDelimiters " \n text block \n " --- " text block " --- --- Should leave leading and trailing line untouched if it contains non-whitespace, e.g.: --- --- ''' leading whitespace --- text block --- trailing whitespace: ''' --- >>> trimAroundDelimiters " leading whitespace\n text block \ntrailing whitespace: " --- " leading whitespace\n text block \ntrailing whitespace: " --- --- Should keep trailing newline if it's the only thing on the line, e.g.: --- --- ''' --- newline below --- --- ''' --- >>> trimAroundDelimiters "\nnewline below\n\n" --- "newline below\n\n" -trimAroundDelimiters :: String -> String -trimAroundDelimiters txt = - txt - & ( \s -> - List.breakOn "\n" s - & \case - (prefix, suffix) - | all isSpace prefix -> drop 1 suffix - | otherwise -> prefix <> suffix - ) - & ( \s -> - List.breakOnEnd "\n" s - & \case - (_prefix, "") -> s - (prefix, suffix) - | all isSpace suffix -> dropTrailingNewline prefix - | otherwise -> prefix <> suffix - ) - where - dropTrailingNewline = \case - [] -> [] - (x : xs) -> NonEmpty.init (x NonEmpty.:| xs) - separated :: (Char -> Bool) -> P a -> P a separated ok p = P.try $ p <* P.lookAhead (void (P.satisfy ok) <|> P.eof) -open :: String -> P [Token Lexeme] -open b = do - token <- tokenP $ lit b - env <- S.get - S.put (env {opening = Just b}) - pure [Open b <$ token] - -openKw :: String -> P [Token Lexeme] -openKw s = separated wordySep $ do - token <- tokenP $ lit s - env <- S.get - S.put (env {opening = Just s}) - pure [Open <$> token] - wordySep :: Char -> Bool wordySep c = isSpace c || not (wordyIdChar c) -tok :: P a -> P [Token a] -tok p = do - token <- tokenP p - pure [token] - -- An identifier is a non-empty dot-delimited list of segments, with an optional leading dot, where each segment is -- symboly (comprised of only symbols) or wordy (comprised of only alphanums). -- @@ -1258,23 +201,6 @@ identifierP = do NameSegment.ReservedOperator s -> ReservedSymbolyId (Text.unpack s) NameSegment.ReservedWord s -> ReservedWordyId (Text.unpack s) --- An identifier is a non-empty dot-delimited list of segments, with an optional leading dot, where each segment is --- symboly (comprised of only symbols) or wordy (comprised of only alphanums). --- --- Examples: --- --- foo --- .foo.++.doc --- `.`.`..` (This is a two-segment identifier without a leading dot: "." then "..") -identifierLexemeP :: P Lexeme -identifierLexemeP = identifierLexeme <$> identifierP - -identifierLexeme :: HQ'.HashQualified Name -> Lexeme -identifierLexeme name = - if Name.isSymboly (HQ'.toName name) - then SymbolyId name - else WordyId name - wordyIdSegP :: P NameSegment wordyIdSegP = PI.withParsecT (fmap (ReservedWordyId . Text.unpack)) NameSegment.wordyP @@ -1283,59 +209,11 @@ shortHashP :: P ShortHash shortHashP = PI.withParsecT (fmap (InvalidShortHash . Text.unpack)) ShortHash.shortHashP -blockDelimiter :: [String] -> P String -> P [Token Lexeme] -blockDelimiter open closeP = do - Token close pos1 pos2 <- tokenP closeP - env <- S.get - case findClose open (layout env) of - Nothing -> err pos1 (UnexpectedDelimiter (quote close)) - where - quote s = "'" <> s <> "'" - Just (_, n) -> do - S.put (env {layout = drop (n - 1) (layout env)}) - let delims = [Token (Reserved close) pos1 pos2] - pure $ replicate (n - 1) (Token Close pos1 pos2) ++ delims - -close :: [String] -> P String -> P [Token Lexeme] -close = close' Nothing - -closeKw' :: Maybe String -> [String] -> P String -> P [Token Lexeme] -closeKw' reopenBlockname open closeP = close' reopenBlockname open (separated wordySep closeP) - -close' :: Maybe String -> [String] -> P String -> P [Token Lexeme] -close' reopenBlockname open closeP = do - Token close pos1 pos2 <- tokenP closeP - env <- S.get - case findClose open (layout env) of - Nothing -> err pos1 (CloseWithoutMatchingOpen msgOpen (quote close)) - where - msgOpen = List.intercalate " or " (quote <$> open) - quote s = "'" <> s <> "'" - Just (_, n) -> do - S.put (env {layout = drop n (layout env), opening = reopenBlockname}) - let opens = maybe [] (const $ [Token (Open close) pos1 pos2]) reopenBlockname - pure $ replicate n (Token Close pos1 pos2) ++ opens - -findClose :: [String] -> Layout -> Maybe (String, Int) -findClose _ [] = Nothing -findClose s ((h, _) : tl) = if h `elem` s then Just (h, 1) else fmap (1 +) <$> findClose s tl - -notLayout :: Token Lexeme -> Bool -notLayout t = case payload t of - Close -> False - Semi _ -> False - Open _ -> False - _ -> True - -- `True` if the tokens are adjacent, with no space separating the two touches :: Token a -> Token b -> Bool touches (end -> t) (start -> t2) = line t == line t2 && column t == column t2 -top :: Layout -> Column -top [] = 1 -top ((_, h) : _) = h - -- todo: make Layout a NonEmpty topBlockName :: Layout -> Maybe BlockName topBlockName [] = Nothing @@ -1344,122 +222,6 @@ topBlockName ((name, _) : _) = Just name pop :: [a] -> [a] pop = drop 1 -topLeftCorner :: Pos -topLeftCorner = Pos 1 1 - -data BlockTree a - = Block - -- | The token that opens the block - a - -- | “Stanzas” of nested tokens - [[BlockTree a]] - -- | The closing token, if any - (Maybe a) - | Leaf a - deriving (Functor, Foldable, Traversable) - -headToken :: BlockTree a -> a -headToken (Block a _ _) = a -headToken (Leaf a) = a - -instance (Show a) => Show (BlockTree a) where - show (Leaf a) = show a - show (Block open mid close) = - show open - ++ "\n" - ++ indent " " (intercalateMap "\n" (intercalateMap " " show) mid) - ++ "\n" - ++ maybe "" show close - where - indent by s = by ++ (s >>= go by) - go by '\n' = '\n' : by - go _ c = [c] - -reorderTree :: ([[BlockTree a]] -> [[BlockTree a]]) -> BlockTree a -> BlockTree a -reorderTree f (Block open mid close) = Block open (f (fmap (reorderTree f) <$> mid)) close -reorderTree _ l = l - -tree :: [Token Lexeme] -> BlockTree (Token Lexeme) -tree toks = one toks const - where - one (open@(payload -> Open _) : ts) k = many (Block open . stanzas) [] ts k - one (t : ts) k = k (Leaf t) ts - one [] k = k lastErr [] - where - lastErr = Leaf case drop (length toks - 1) toks of - [] -> Token (Err LayoutError) topLeftCorner topLeftCorner - (t : _) -> t {payload = Err LayoutError} - - many open acc [] k = k (open (reverse acc) Nothing) [] - many open acc (t@(payload -> Close) : ts) k = k (open (reverse acc) $ pure t) ts - many open acc ts k = one ts $ \t ts -> many open (t : acc) ts k - -stanzas :: [BlockTree (Token Lexeme)] -> [[BlockTree (Token Lexeme)]] -stanzas = - toList - . foldr - ( \tok (curr :| stanzas) -> case tok of - Leaf (Token (Semi _) _ _) -> [tok] :| curr : stanzas - _ -> (tok : curr) :| stanzas - ) - ([] :| []) - --- Moves type and ability declarations to the front of the token stream --- and move `use` statements to the front of each block -reorder :: [[BlockTree (Token Lexeme)]] -> [[BlockTree (Token Lexeme)]] -reorder = foldr fixup [] . sortWith f - where - f [] = 3 :: Int - f (t0 : _) = case payload $ headToken t0 of - Open mod | Set.member (Text.pack mod) typeModifiers -> 1 - Open typOrA | Set.member (Text.pack typOrA) typeOrAbility -> 1 - Reserved "use" -> 0 - _ -> 3 :: Int - -- after reordering can end up with trailing semicolon at the end of - -- a block, which we remove with this pass - fixup stanza [] = case Lens.unsnoc stanza of - Nothing -> [] - -- remove any trailing `Semi` from the last non-empty stanza - Just (init, Leaf (Token (Semi _) _ _)) -> [init] - -- don’t touch other stanzas - Just (_, _) -> [stanza] - fixup stanza tail = stanza : tail - --- | This turns the lexeme stream into a tree, reordering some lexeme subsequences. -preParse :: [Token Lexeme] -> BlockTree (Token Lexeme) -preParse = reorderTree reorder . tree - --- | A few transformations that happen between lexing and parsing. --- --- All of these things should move out of the lexer, and be applied in the parse. -postLex :: [Token Lexeme] -> [Token Lexeme] -postLex = toList . preParse . foldr tweak [] - -isDelayOrForce :: Char -> Bool -isDelayOrForce op = op == '\'' || op == '!' - --- Mapping between characters and their escape codes. Use parse/showEscapeChar to convert. -escapeChars :: [(Char, Char)] -escapeChars = - [ ('0', '\0'), - ('a', '\a'), - ('b', '\b'), - ('f', '\f'), - ('n', '\n'), - ('r', '\r'), - ('t', '\t'), - ('v', '\v'), - ('s', ' '), - ('\'', '\''), - ('"', '"'), - ('\\', '\\') - ] - --- Inverse of parseEscapeChar; map a character to its escaped version: -showEscapeChar :: Char -> Maybe Char -showEscapeChar c = - Map.lookup c (Map.fromList [(x, y) | (y, x) <- escapeChars]) - typeOrAbilityAlt :: (Alternative f) => (Text -> f a) -> f a typeOrAbilityAlt f = asum $ map f (toList typeOrAbility) @@ -1471,28 +233,6 @@ typeModifiersAlt f = inc :: Pos -> Pos inc (Pos line col) = Pos line (col + 1) -debugFilePreParse :: FilePath -> IO () -debugFilePreParse file = putStrLn . debugPreParse . preParse . lexer file . Text.unpack =<< readUtf8 file - -debugPreParse :: BlockTree (Token Lexeme) -> String -debugPreParse (Leaf (Token (Err (UnexpectedTokens msg)) start end)) = - (if start == end then msg1 else msg2) <> ":\n" <> msg - where - msg1 = "Error on line " <> show (line start) <> ", column " <> show (column start) - msg2 = - "Error on line " - <> show (line start) - <> ", column " - <> show (column start) - <> " - line " - <> show (line end) - <> ", column " - <> show (column end) -debugPreParse ts = show $ payload <$> ts - -debugPreParse' :: String -> String -debugPreParse' = debugPreParse . preParse . lexer "debugPreParse" - instance EP.ShowErrorComponent (Token Err) where showErrorComponent (Token err _ _) = go err where @@ -1504,35 +244,3 @@ instance EP.ShowErrorComponent (Token Err) where TextLiteralMissingClosingQuote s -> "This text literal missing a closing quote: " <> excerpt s e -> show e excerpt s = if length s < 15 then s else take 15 s <> "..." - -instance P.VisualStream [Token Lexeme] where - showTokens _ xs = - join . Nel.toList . S.evalState (traverse go xs) . end $ Nel.head xs - where - go :: Token Lexeme -> S.State Pos String - go tok = do - prev <- S.get - S.put $ end tok - pure $ pad prev (start tok) ++ pretty (payload tok) - pretty (Open s) = s - pretty (Reserved w) = w - pretty (Textual t) = '"' : t ++ ['"'] - pretty (Character c) = - case showEscapeChar c of - Just c -> "?\\" ++ [c] - Nothing -> '?' : [c] - pretty (WordyId n) = Text.unpack (HQ'.toText n) - pretty (SymbolyId n) = Text.unpack (HQ'.toText n) - pretty (Blank s) = "_" ++ s - pretty (Numeric n) = n - pretty (Hash sh) = show sh - pretty (Err e) = show e - pretty (Bytes bs) = "0xs" <> show bs - pretty Close = "" - pretty (Semi True) = "" - pretty (Semi False) = ";" - pretty (Doc d) = show d - pad (Pos line1 col1) (Pos line2 col2) = - if line1 == line2 - then replicate (col2 - col1) ' ' - else replicate (line2 - line1) '\n' ++ replicate col2 ' ' diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs new file mode 100644 index 0000000000..dcaf9ca6d3 --- /dev/null +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -0,0 +1,910 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Unison.Syntax.Lexer.Unison + ( Token (..), + Line, + Column, + Err (..), + Pos (..), + Lexeme (..), + lexer, + preParse, + escapeChars, + debugFilePreParse, + debugPreParse, + debugPreParse', + showEscapeChar, + touches, + + -- * Character classifiers + wordyIdChar, + wordyIdStartChar, + symbolyIdChar, + + -- * Error formatting + formatTrivialError, + displayLexeme, + ) +where + +import Control.Lens qualified as Lens +import Control.Monad.State qualified as S +import Data.Char (isAlphaNum, isDigit, isSpace, ord, toLower) +import Data.Foldable qualified as Foldable +import Data.List qualified as List +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.List.NonEmpty qualified as Nel +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text qualified as Text +import GHC.Exts (sortWith) +import Text.Megaparsec qualified as P +import Text.Megaparsec.Char (char) +import Text.Megaparsec.Char qualified as CP +import Text.Megaparsec.Char.Lexer qualified as LP +import Text.Megaparsec.Error qualified as EP +import Unison.HashQualifiedPrime qualified as HQ' +import Unison.Name (Name) +import Unison.Name qualified as Name +import Unison.NameSegment qualified as NameSegment (docSegment) +import Unison.NameSegment.Internal qualified as NameSegment +import Unison.Prelude +import Unison.ShortHash (ShortHash) +import Unison.ShortHash qualified as SH +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) +import Unison.Syntax.Lexer +import Unison.Syntax.Lexer.Token (posP, tokenP) +import Unison.Syntax.Name qualified as Name (isSymboly, toText, unsafeParseText) +import Unison.Syntax.Parser.Doc qualified as Doc +import Unison.Syntax.Parser.Doc.Data qualified as Doc +import Unison.Syntax.ReservedWords (delimiters, typeModifiers, typeOrAbility) +import Unison.Util.Bytes qualified as Bytes +import Unison.Util.Monoid (intercalateMap) + +-- Design principle: +-- `[Lexeme]` should be sufficient information for parsing without +-- further knowledge of spacing or indentation levels +-- any knowledge of comments +data Lexeme + = Open String -- start of a block + | Semi IsVirtual -- separator between elements of a block + | Close -- end of a block + | Reserved String -- reserved tokens such as `{`, `(`, `type`, `of`, etc + | Textual String -- text literals, `"foo bar"` + | Character Char -- character literals, `?X` + | WordyId (HQ'.HashQualified Name) -- a (non-infix) identifier. invariant: last segment is wordy + | SymbolyId (HQ'.HashQualified Name) -- an infix identifier. invariant: last segment is symboly + | Blank String -- a typed hole or placeholder + | Numeric String -- numeric literals, left unparsed + | Bytes Bytes.Bytes -- bytes literals + | Hash ShortHash -- hash literals + | Err Err + | Doc (Doc.UntitledSection (Doc.Tree [Token Lexeme])) + deriving stock (Eq, Show, Ord) + +type IsVirtual = Bool -- is it a virtual semi or an actual semi? + +token :: P Lexeme -> P [Token Lexeme] +token = token' (\a start end -> [Token a start end]) + +-- Token parser: strips trailing whitespace and comments after a +-- successful parse, and also takes care of emitting layout tokens +-- (such as virtual semicolons and closing tokens). +token' :: (a -> Pos -> Pos -> [Token Lexeme]) -> P a -> P [Token Lexeme] +token' tok p = LP.lexeme space (token'' tok p) + +-- Token parser implementation which leaves trailing whitespace and comments +-- but does emit layout tokens such as virtual semicolons and closing tokens. +token'' :: (a -> Pos -> Pos -> [Token Lexeme]) -> P a -> P [Token Lexeme] +token'' tok p = do + start <- posP + -- We save the current state so we can backtrack the state if `p` fails. + env <- S.get + layoutToks <- case opening env of + -- If we're opening a block named b, we push (b, currentColumn) onto + -- the layout stack. Example: + -- + -- blah = cases + -- {- A comment -} + -- -- A one-line comment + -- 0 -> "hi" + -- 1 -> "bye" + -- + -- After the `cases` token, the state will be opening = Just "cases", + -- meaning the parser is searching for the next non-whitespace/comment + -- character to determine the leftmost column of the `cases` block. + -- That will be the column of the `0`. + Just blockname -> + -- special case - handling of empty blocks, as in: + -- foo = + -- bar = 42 + if blockname == "=" && column start <= top l && not (null l) + then do + S.put (env {layout = (blockname, column start + 1) : l, opening = Nothing}) + pops start + else [] <$ S.put (env {layout = layout', opening = Nothing}) + where + layout' = (blockname, column start) : l + l = layout env + -- If we're not opening a block, we potentially pop from + -- the layout stack and/or emit virtual semicolons. + Nothing -> if inLayout env then pops start else pure [] + beforeTokenPos <- posP + a <- p <|> (S.put env >> fail "resetting state") + endPos <- posP + pure $ layoutToks ++ tok a beforeTokenPos endPos + where + pops :: Pos -> P [Token Lexeme] + pops p = do + env <- S.get + let l = layout env + if top l == column p && topContainsVirtualSemis l + then pure [Token (Semi True) p p] + else + if column p > top l || topHasClosePair l + then pure [] + else + if column p < top l + then S.put (env {layout = pop l}) >> ((Token Close p p :) <$> pops p) + else error "impossible" + + -- don't emit virtual semis in (, {, or [ blocks + topContainsVirtualSemis :: Layout -> Bool + topContainsVirtualSemis = \case + [] -> False + ((name, _) : _) -> name /= "(" && name /= "{" && name /= "[" + + topHasClosePair :: Layout -> Bool + topHasClosePair [] = False + topHasClosePair ((name, _) : _) = + name `elem` ["DUMMY", "{", "(", "[", "handle", "match", "if", "then"] + +showErrorFancy :: (P.ShowErrorComponent e) => P.ErrorFancy e -> String +showErrorFancy = \case + P.ErrorFail msg -> msg + P.ErrorIndentation ord ref actual -> + "incorrect indentation (got " + <> show (P.unPos actual) + <> ", should be " + <> p + <> show (P.unPos ref) + <> ")" + where + p = case ord of + LT -> "less than " + EQ -> "equal to " + GT -> "greater than " + P.ErrorCustom a -> P.showErrorComponent a + +lexer :: String -> String -> [Token Lexeme] +lexer scope rem = + case flip S.evalState env0 $ P.runParserT (lexemes eof) scope rem of + Left e -> + let errsWithSourcePos = + fst $ + P.attachSourcePos + P.errorOffset + (toList (P.bundleErrors e)) + (P.bundlePosState e) + errorToTokens :: (EP.ParseError String (Token Err), P.SourcePos) -> [Token Lexeme] + errorToTokens (err, top) = case err of + P.FancyError _ (customErrs -> es) | not (null es) -> es + P.FancyError _errOffset es -> + let msg = intercalateMap "\n" showErrorFancy es + in [Token (Err (UnexpectedTokens msg)) (toPos top) (toPos top)] + P.TrivialError _errOffset mayUnexpectedTokens expectedTokens -> + let unexpectedStr :: Set String + unexpectedStr = + mayUnexpectedTokens + & fmap errorItemToString + & maybeToList + & Set.fromList + errorLength :: Int + errorLength = case Set.toList unexpectedStr of + [] -> 0 + (x : _) -> length x + expectedStr :: Set String + expectedStr = + expectedTokens + & Set.map errorItemToString + err = UnexpectedTokens $ formatTrivialError unexpectedStr expectedStr + startPos = toPos top + -- This is just an attempt to highlight errors better in source excerpts. + -- It may not work in all cases, but should generally provide a better experience. + endPos = startPos & \(Pos l c) -> Pos l (c + errorLength) + in [Token (Err err) startPos endPos] + in errsWithSourcePos >>= errorToTokens + Right ts -> postLex $ Token (Open scope) topLeftCorner topLeftCorner : ts + where + eof :: P [Token Lexeme] + eof = P.try do + p <- P.eof >> posP + n <- maybe 0 (const 1) <$> S.gets opening + l <- S.gets layout + pure $ replicate (length l + n) (Token Close p p) + errorItemToString :: EP.ErrorItem Char -> String + errorItemToString = \case + (P.Tokens ts) -> Foldable.toList ts + (P.Label ts) -> Foldable.toList ts + (P.EndOfInput) -> "end of input" + customErrs es = [Err <$> e | P.ErrorCustom e <- toList es] + toPos (P.SourcePos _ line col) = Pos (P.unPos line) (P.unPos col) + env0 = ParsingEnv [] (Just scope) True [0] 0 + +-- | hacky postprocessing pass to do some cleanup of stuff that's annoying to +-- fix without adding more state to the lexer: +-- - 1+1 lexes as [1, +1], convert this to [1, +, 1] +-- - when a semi followed by a virtual semi, drop the virtual, lets you +-- write +-- foo x = action1; +-- 2 +-- - semi immediately after first Open is ignored +tweak :: (Token Lexeme) -> [Token Lexeme] -> [Token Lexeme] +tweak h@(Token (Semi False) _ _) (Token (Semi True) _ _ : t) = h : t +-- __NB__: This case only exists to guard against the following one +tweak h@(Token (Reserved _) _ _) t = h : t +tweak t1 (t2@(Token (Numeric num) _ _) : rem) + | notLayout t1 && touches t1 t2 && isSigned num = + t1 + : Token + (SymbolyId (HQ'.fromName (Name.unsafeParseText (Text.pack (take 1 num))))) + (start t2) + (inc $ start t2) + : Token (Numeric (drop 1 num)) (inc $ start t2) (end t2) + : rem + where + isSigned num = all (\ch -> ch == '-' || ch == '+') $ take 1 num +tweak h t = h : t + +formatTrivialError :: Set String -> Set String -> [Char] +formatTrivialError unexpectedTokens expectedTokens = + let unexpectedMsg = case Set.toList unexpectedTokens of + [] -> "I found something I didn't expect." + [x] -> + let article = case x of + (c : _) | c `elem` ("aeiou" :: String) -> "an" + _ -> "a" + in "I was surprised to find " <> article <> " " <> x <> " here." + xs -> "I was surprised to find these:\n\n* " <> List.intercalate "\n* " xs + expectedMsg = case Set.toList expectedTokens of + [] -> Nothing + xs -> Just $ "\nI was expecting one of these instead:\n\n* " <> List.intercalate "\n* " xs + in concat $ catMaybes [Just unexpectedMsg, expectedMsg] + +displayLexeme :: Lexeme -> String +displayLexeme = \case + Open o -> o + Semi True -> "end of stanza" + Semi False -> "semicolon" + Close -> "end of section" + Reserved r -> "'" <> r <> "'" + Textual t -> "\"" <> t <> "\"" + Character c -> "?" <> [c] + WordyId hq -> Text.unpack (HQ'.toTextWith Name.toText hq) + SymbolyId hq -> Text.unpack (HQ'.toTextWith Name.toText hq) + Blank b -> b + Numeric n -> n + Bytes _b -> "bytes literal" + Hash h -> Text.unpack (SH.toText h) + Err e -> show e + Doc _ -> "doc structure" + +-- | The `Doc` lexer as documented on unison-lang.org +doc2 :: P [Token Lexeme] +doc2 = do + -- Ensure we're at a doc before we start consuming tokens + P.lookAhead (lit "{{") + openStart <- posP + -- Produce any layout tokens, such as closing the last open block or virtual semicolons + -- We don't use 'token' on "{{" directly because we don't want to duplicate layout + -- tokens if we do the rewrite hack for type-docs below. + beforeStartToks <- token' ignore (pure ()) + void $ lit "{{" + openEnd <- posP + CP.space + env0 <- S.get + -- Disable layout while parsing the doc block and reset the section number + (docTok, closeTok) <- local + ( \env -> + env + { inLayout = False, + parentSections = 0 : (parentSections env0) + } + ) + do + body <- Doc.untitledSection lexemes' . P.lookAhead $ () <$ lit "}}" + closeStart <- posP + lit "}}" + closeEnd <- posP + pure (Token (Doc body) openStart closeEnd, Token Close closeStart closeEnd) + -- Parse any layout tokens after the doc block, e.g. virtual semicolon + endToks <- token' ignore (pure ()) + -- Hack to allow anonymous doc blocks before type decls + -- {{ Some docs }} Foo.doc = {{ Some docs }} + -- ability Foo where => ability Foo where + -- + -- __FIXME__: This should be done _after_ parsing, not in lexing. + tn <- subsequentTypeName + pure $ + beforeStartToks <> case (tn) of + -- If we're followed by a type, we rewrite the doc block to be a named doc block. + Just (WordyId tname) + | isTopLevel -> + Token (WordyId (HQ'.fromName (Name.snoc (HQ'.toName tname) NameSegment.docSegment))) openStart openEnd + : Token (Open "=") openStart openEnd + : docTok + -- We need an extra 'Close' here because we added an extra Open above. + : closeTok + : endToks + where + isTopLevel = length (layout env0) + maybe 0 (const 1) (opening env0) == 1 + _ -> docTok : endToks + where + -- DUPLICATED + wordyKw kw = separated wordySep (lit kw) + subsequentTypeName = P.lookAhead . P.optional $ do + let lit' s = lit s <* sp + let modifier = typeModifiersAlt (lit' . Text.unpack) + let typeOrAbility' = typeOrAbilityAlt (wordyKw . Text.unpack) + _ <- optional modifier *> typeOrAbility' *> sp + Token name start stop <- tokenP identifierP + if Name.isSymboly (HQ'.toName name) + then P.customFailure (Token (InvalidSymbolyId (Text.unpack (HQ'.toTextWith Name.toText name))) start stop) + else pure (WordyId name) + ignore _ _ _ = [] + -- DUPLICATED + sp = P.try $ do + spaces <- P.takeWhile1P (Just "space") isSpace + close <- P.optional (P.lookAhead (lit "}}")) + case close of + Nothing -> guard $ ok spaces + Just _ -> pure () + pure spaces + where + ok s = length [() | '\n' <- s] < 2 + +lexemes' :: P () -> P [Token Lexeme] +lexemes' eof = + -- NB: `postLex` requires the token stream to start with an `Open`, otherwise it can’t create a `T`, so this adds one, + -- runs `postLex`, then removes it. + fmap (tail . postLex . (Token (Open "fake") mempty mempty :)) $ + local (\env -> env {inLayout = True, opening = Just "DUMMY"}) do + p <- lexemes $ [] <$ eof + -- deals with a final "unclosed" block at the end of `p`) + unclosed <- takeWhile (("DUMMY" /=) . fst) . layout <$> S.get + let pos = end $ last p + pure $ p <> replicate (length unclosed) (Token Close pos pos) + +-- | Consumes an entire Unison “module”. +lexemes :: P [Token Lexeme] -> P [Token Lexeme] +lexemes eof = + P.optional space >> do + hd <- join <$> P.manyTill toks (P.lookAhead eof) + tl <- eof + pure $ hd <> tl + where + toks :: P [Token Lexeme] + toks = + doc2 + <|> doc + <|> token numeric + <|> token character + <|> reserved + <|> token blank + <|> token identifierLexemeP + <|> (asum . map token) [semi, textual, hash] + + doc :: P [Token Lexeme] + doc = open <+> (CP.space *> fmap fixup body) <+> (close <* space) + where + open = token'' (\t _ _ -> t) $ tok (Open <$> lit "[:") + close = tok (Close <$ lit ":]") + at = lit "@" + -- this removes some trailing whitespace from final textual segment + fixup [] = [] + fixup (Token (Textual (reverse -> txt)) start stop : []) = + [Token (Textual txt') start stop] + where + txt' = reverse (dropWhile (\c -> isSpace c && not (c == '\n')) txt) + fixup (h : t) = h : fixup t + + body :: P [Token Lexeme] + body = txt <+> (atk <|> pure []) + where + ch = (":]" <$ lit "\\:]") <|> ("@" <$ lit "\\@") <|> (pure <$> P.anySingle) + txt = tok (Textual . join <$> P.manyTill ch (P.lookAhead sep)) + sep = void at <|> void close + ref = at *> (tok identifierLexemeP <|> docTyp) + atk = (ref <|> docTyp) <+> body + docTyp = do + _ <- lit "[" + typ <- tok (P.manyTill P.anySingle (P.lookAhead (lit "]"))) + _ <- lit "]" *> CP.space + t <- tok identifierLexemeP + pure $ (fmap Reserved <$> typ) <> t + + blank = + separated wordySep do + _ <- char '_' + seg <- P.optional wordyIdSegP + pure (Blank (maybe "" (Text.unpack . NameSegment.toUnescapedText) seg)) + + semi = char ';' $> Semi False + textual = Textual <$> quoted + quoted = quotedRaw <|> quotedSingleLine + quotedRaw = do + _ <- lit "\"\"\"" + n <- many (char '"') + _ <- optional (char '\n') -- initial newline is skipped + s <- P.manyTill P.anySingle (lit (replicate (length n + 3) '"')) + col0 <- column <$> posP + let col = col0 - (length n) - 3 -- this gets us first col of closing quotes + let leading = replicate (max 0 (col - 1)) ' ' + -- a last line that's equal to `leading` is ignored, since leading + -- spaces up to `col` are not considered part of the string + let tweak l = case reverse l of + last : rest + | col > 1 && last == leading -> reverse rest + | otherwise -> l + [] -> [] + pure $ case tweak (lines s) of + [] -> s + ls + | all (\l -> List.isPrefixOf leading l || all isSpace l) ls -> List.intercalate "\n" (drop (length leading) <$> ls) + | otherwise -> s + quotedSingleLine = char '"' *> P.manyTill (LP.charLiteral <|> sp) (char '"') + where + sp = lit "\\s" $> ' ' + character = Character <$> (char '?' *> (spEsc <|> LP.charLiteral)) + where + spEsc = P.try (char '\\' *> char 's' $> ' ') + + numeric = bytes <|> otherbase <|> float <|> intOrNat + where + intOrNat = P.try $ num <$> sign <*> LP.decimal + float = do + _ <- P.try (P.lookAhead (sign >> (LP.decimal :: P Int) >> (char '.' <|> char 'e' <|> char 'E'))) -- commit after this + start <- posP + sign <- fromMaybe "" <$> sign + base <- P.takeWhile1P (Just "base") isDigit + decimals <- + P.optional $ + let missingFractional = err start (MissingFractional $ base <> ".") + in liftA2 (<>) (lit ".") (P.takeWhile1P (Just "decimals") isDigit <|> missingFractional) + exp <- P.optional $ do + e <- map toLower <$> (lit "e" <|> lit "E") + sign <- fromMaybe "" <$> optional (lit "+" <|> lit "-") + let missingExp = err start (MissingExponent $ base <> fromMaybe "" decimals <> e <> sign) + exp <- P.takeWhile1P (Just "exponent") isDigit <|> missingExp + pure $ e <> sign <> exp + pure $ Numeric (sign <> base <> fromMaybe "" decimals <> fromMaybe "" exp) + + bytes = do + start <- posP + _ <- lit "0xs" + s <- map toLower <$> P.takeWhileP (Just "hexidecimal character") isAlphaNum + case Bytes.fromBase16 $ Bytes.fromWord8s (fromIntegral . ord <$> s) of + Left _ -> err start (InvalidBytesLiteral $ "0xs" <> s) + Right bs -> pure (Bytes bs) + otherbase = octal <|> hex + octal = do + start <- posP + commitAfter2 sign (lit "0o") $ \sign _ -> + fmap (num sign) LP.octal <|> err start InvalidOctalLiteral + hex = do + start <- posP + commitAfter2 sign (lit "0x") $ \sign _ -> + fmap (num sign) LP.hexadecimal <|> err start InvalidHexLiteral + + num :: Maybe String -> Integer -> Lexeme + num sign n = Numeric (fromMaybe "" sign <> show n) + sign = P.optional (lit "+" <|> lit "-") + + hash = Hash <$> P.try shortHashP + + reserved :: P [Token Lexeme] + reserved = + token' (\ts _ _ -> ts) $ + braces + <|> parens + <|> brackets + <|> commaSeparator + <|> delim + <|> delayOrForce + <|> keywords + <|> layoutKeywords + where + keywords = + -- yes "wordy" - just like a wordy keyword like "true", the literal "." (as in the dot in + -- "forall a. a -> a") is considered the keyword "." so long as it is either followed by EOF, a space, or some + -- non-wordy character (because ".foo" is a single identifier lexeme) + wordyKw "." + <|> symbolyKw ":" + <|> openKw "@rewrite" + <|> symbolyKw "@" + <|> symbolyKw "||" + <|> symbolyKw "|" + <|> symbolyKw "&&" + <|> wordyKw "true" + <|> wordyKw "false" + <|> wordyKw "use" + <|> wordyKw "forall" + <|> wordyKw "∀" + <|> wordyKw "termLink" + <|> wordyKw "typeLink" + + wordyKw s = separated wordySep (kw s) + symbolyKw s = separated (not . symbolyIdChar) (kw s) + + kw :: String -> P [Token Lexeme] + kw s = tokenP (lit s) <&> \token -> [Reserved <$> token] + + layoutKeywords :: P [Token Lexeme] + layoutKeywords = + ifElse + <|> withKw + <|> openKw "match" + <|> openKw "handle" + <|> typ + <|> arr + <|> rewriteArr + <|> eq + <|> openKw "cases" + <|> openKw "where" + <|> openKw "let" + <|> openKw "do" + where + ifElse = + openKw "if" + <|> closeKw' (Just "then") ["if"] (lit "then") + <|> closeKw' (Just "else") ["then"] (lit "else") + modKw = typeModifiersAlt (openKw1 wordySep . Text.unpack) + typeOrAbilityKw = typeOrAbilityAlt (openTypeKw1 . Text.unpack) + typ = modKw <|> typeOrAbilityKw + + withKw = do + [Token _ pos1 pos2] <- wordyKw "with" + env <- S.get + let l = layout env + case findClose ["handle", "match"] l of + Nothing -> err pos1 (CloseWithoutMatchingOpen msgOpen "'with'") + where + msgOpen = "'handle' or 'match'" + Just (withBlock, n) -> do + let b = withBlock <> "-with" + S.put (env {layout = drop n l, opening = Just b}) + let opens = [Token (Open "with") pos1 pos2] + pure $ replicate n (Token Close pos1 pos2) ++ opens + + -- In `structural/unique type` and `structural/unique ability`, + -- only the `structural` or `unique` opens a layout block, + -- and `ability` and `type` are just keywords. + openTypeKw1 t = do + b <- S.gets (topBlockName . layout) + case b of + Just mod | Set.member (Text.pack mod) typeModifiers -> wordyKw t + _ -> openKw1 wordySep t + + -- layout keyword which bumps the layout column by 1, rather than looking ahead + -- to the next token to determine the layout column + openKw1 :: (Char -> Bool) -> String -> P [Token Lexeme] + openKw1 sep kw = do + Token kw pos0 pos1 <- tokenP $ separated sep (lit kw) + S.modify (\env -> env {layout = (kw, column $ inc pos0) : layout env}) + pure [Token (Open kw) pos0 pos1] + + eq = do + [Token _ start end] <- symbolyKw "=" + env <- S.get + case topBlockName (layout env) of + -- '=' does not open a layout block if within a type declaration + Just t | t == "type" || Set.member (Text.pack t) typeModifiers -> pure [Token (Reserved "=") start end] + Just _ -> S.put (env {opening = Just "="}) >> pure [Token (Open "=") start end] + _ -> err start LayoutError + + rewriteArr = do + [Token _ start end] <- symbolyKw "==>" + env <- S.get + S.put (env {opening = Just "==>"}) >> pure [Token (Open "==>") start end] + + arr = do + [Token _ start end] <- symbolyKw "->" + env <- S.get + -- -> introduces a layout block if we're inside a `match with` or `cases` + case topBlockName (layout env) of + Just match | match `elem` matchWithBlocks -> do + S.put (env {opening = Just "->"}) + pure [Token (Open "->") start end] + _ -> pure [Token (Reserved "->") start end] + + -- a bit of lookahead here to reserve }} for closing a documentation block + braces = open "{" <|> close ["{"] p + where + p = do + l <- lit "}" + -- if we're within an existing {{ }} block, inLayout will be false + -- so we can actually allow }} to appear in normal code + inLayout <- S.gets inLayout + when (not inLayout) $ void $ P.lookAhead (P.satisfy (/= '}')) + pure l + matchWithBlocks = ["match-with", "cases"] + parens = open "(" <|> close ["("] (lit ")") + brackets = open "[" <|> close ["["] (lit "]") + -- `allowCommaToClose` determines if a comma should close inner blocks. + -- Currently there is a set of blocks where `,` is not treated specially + -- and it just emits a Reserved ",". There are currently only three: + -- `cases`, `match-with`, and `{` + allowCommaToClose match = not $ match `elem` ("{" : matchWithBlocks) + commaSeparator = do + env <- S.get + case topBlockName (layout env) of + Just match + | allowCommaToClose match -> + blockDelimiter ["[", "("] (lit ",") + _ -> fail "this comma is a pattern separator" + + delim = P.try $ do + ch <- P.satisfy (\ch -> ch /= ';' && Set.member ch delimiters) + pos <- posP + pure [Token (Reserved [ch]) pos (inc pos)] + + delayOrForce = separated ok $ do + token <- tokenP $ P.satisfy isDelayOrForce + pure [token <&> \op -> Reserved [op]] + where + ok c = isDelayOrForce c || isSpace c || isAlphaNum c || Set.member c delimiters || c == '\"' + +open :: String -> P [Token Lexeme] +open b = do + token <- tokenP $ lit b + env <- S.get + S.put (env {opening = Just b}) + pure [Open b <$ token] + +openKw :: String -> P [Token Lexeme] +openKw s = separated wordySep $ do + token <- tokenP $ lit s + env <- S.get + S.put (env {opening = Just s}) + pure [Open <$> token] + +tok :: P a -> P [Token a] +tok p = do + token <- tokenP p + pure [token] + +-- An identifier is a non-empty dot-delimited list of segments, with an optional leading dot, where each segment is +-- symboly (comprised of only symbols) or wordy (comprised of only alphanums). +-- +-- Examples: +-- +-- foo +-- .foo.++.doc +-- `.`.`..` (This is a two-segment identifier without a leading dot: "." then "..") +identifierLexemeP :: P Lexeme +identifierLexemeP = identifierLexeme <$> identifierP + +identifierLexeme :: HQ'.HashQualified Name -> Lexeme +identifierLexeme name = + if Name.isSymboly (HQ'.toName name) + then SymbolyId name + else WordyId name + +blockDelimiter :: [String] -> P String -> P [Token Lexeme] +blockDelimiter open closeP = do + Token close pos1 pos2 <- tokenP closeP + env <- S.get + case findClose open (layout env) of + Nothing -> err pos1 (UnexpectedDelimiter (quote close)) + where + quote s = "'" <> s <> "'" + Just (_, n) -> do + S.put (env {layout = drop (n - 1) (layout env)}) + let delims = [Token (Reserved close) pos1 pos2] + pure $ replicate (n - 1) (Token Close pos1 pos2) ++ delims + +close :: [String] -> P String -> P [Token Lexeme] +close = close' Nothing + +closeKw' :: Maybe String -> [String] -> P String -> P [Token Lexeme] +closeKw' reopenBlockname open closeP = close' reopenBlockname open (separated wordySep closeP) + +close' :: Maybe String -> [String] -> P String -> P [Token Lexeme] +close' reopenBlockname open closeP = do + Token close pos1 pos2 <- tokenP closeP + env <- S.get + case findClose open (layout env) of + Nothing -> err pos1 (CloseWithoutMatchingOpen msgOpen (quote close)) + where + msgOpen = List.intercalate " or " (quote <$> open) + quote s = "'" <> s <> "'" + Just (_, n) -> do + S.put (env {layout = drop n (layout env), opening = reopenBlockname}) + let opens = maybe [] (const $ [Token (Open close) pos1 pos2]) reopenBlockname + pure $ replicate n (Token Close pos1 pos2) ++ opens + +findClose :: [String] -> Layout -> Maybe (String, Int) +findClose _ [] = Nothing +findClose s ((h, _) : tl) = if h `elem` s then Just (h, 1) else fmap (1 +) <$> findClose s tl + +notLayout :: Token Lexeme -> Bool +notLayout t = case payload t of + Close -> False + Semi _ -> False + Open _ -> False + _ -> True + +top :: Layout -> Column +top [] = 1 +top ((_, h) : _) = h + +topLeftCorner :: Pos +topLeftCorner = Pos 1 1 + +data BlockTree a + = Block + -- | The token that opens the block + a + -- | “Stanzas” of nested tokens + [[BlockTree a]] + -- | The closing token, if any + (Maybe a) + | Leaf a + deriving (Functor, Foldable, Traversable) + +headToken :: BlockTree a -> a +headToken (Block a _ _) = a +headToken (Leaf a) = a + +instance (Show a) => Show (BlockTree a) where + show (Leaf a) = show a + show (Block open mid close) = + show open + ++ "\n" + ++ indent " " (intercalateMap "\n" (intercalateMap " " show) mid) + ++ "\n" + ++ maybe "" show close + where + indent by s = by ++ (s >>= go by) + go by '\n' = '\n' : by + go _ c = [c] + +reorderTree :: ([[BlockTree a]] -> [[BlockTree a]]) -> BlockTree a -> BlockTree a +reorderTree f (Block open mid close) = Block open (f (fmap (reorderTree f) <$> mid)) close +reorderTree _ l = l + +tree :: [Token Lexeme] -> BlockTree (Token Lexeme) +tree toks = one toks const + where + one (open@(payload -> Open _) : ts) k = many (Block open . stanzas) [] ts k + one (t : ts) k = k (Leaf t) ts + one [] k = k lastErr [] + where + lastErr = Leaf case drop (length toks - 1) toks of + [] -> Token (Err LayoutError) topLeftCorner topLeftCorner + (t : _) -> t {payload = Err LayoutError} + + many open acc [] k = k (open (reverse acc) Nothing) [] + many open acc (t@(payload -> Close) : ts) k = k (open (reverse acc) $ pure t) ts + many open acc ts k = one ts $ \t ts -> many open (t : acc) ts k + +stanzas :: [BlockTree (Token Lexeme)] -> [[BlockTree (Token Lexeme)]] +stanzas = + toList + . foldr + ( \tok (curr :| stanzas) -> case tok of + Leaf (Token (Semi _) _ _) -> [tok] :| curr : stanzas + _ -> (tok : curr) :| stanzas + ) + ([] :| []) + +-- Moves type and ability declarations to the front of the token stream +-- and move `use` statements to the front of each block +reorder :: [[BlockTree (Token Lexeme)]] -> [[BlockTree (Token Lexeme)]] +reorder = foldr fixup [] . sortWith f + where + f [] = 3 :: Int + f (t0 : _) = case payload $ headToken t0 of + Open mod | Set.member (Text.pack mod) typeModifiers -> 1 + Open typOrA | Set.member (Text.pack typOrA) typeOrAbility -> 1 + Reserved "use" -> 0 + _ -> 3 :: Int + -- after reordering can end up with trailing semicolon at the end of + -- a block, which we remove with this pass + fixup stanza [] = case Lens.unsnoc stanza of + Nothing -> [] + -- remove any trailing `Semi` from the last non-empty stanza + Just (init, Leaf (Token (Semi _) _ _)) -> [init] + -- don’t touch other stanzas + Just (_, _) -> [stanza] + fixup stanza tail = stanza : tail + +-- | This turns the lexeme stream into a tree, reordering some lexeme subsequences. +preParse :: [Token Lexeme] -> BlockTree (Token Lexeme) +preParse = reorderTree reorder . tree + +-- | A few transformations that happen between lexing and parsing. +-- +-- All of these things should move out of the lexer, and be applied in the parse. +postLex :: [Token Lexeme] -> [Token Lexeme] +postLex = toList . preParse . foldr tweak [] + +isDelayOrForce :: Char -> Bool +isDelayOrForce op = op == '\'' || op == '!' + +-- Mapping between characters and their escape codes. Use parse/showEscapeChar to convert. +escapeChars :: [(Char, Char)] +escapeChars = + [ ('0', '\0'), + ('a', '\a'), + ('b', '\b'), + ('f', '\f'), + ('n', '\n'), + ('r', '\r'), + ('t', '\t'), + ('v', '\v'), + ('s', ' '), + ('\'', '\''), + ('"', '"'), + ('\\', '\\') + ] + +-- Inverse of parseEscapeChar; map a character to its escaped version: +showEscapeChar :: Char -> Maybe Char +showEscapeChar c = + Map.lookup c (Map.fromList [(x, y) | (y, x) <- escapeChars]) + +debugFilePreParse :: FilePath -> IO () +debugFilePreParse file = putStrLn . debugPreParse . preParse . lexer file . Text.unpack =<< readUtf8 file + +debugPreParse :: BlockTree (Token Lexeme) -> String +debugPreParse (Leaf (Token (Err (UnexpectedTokens msg)) start end)) = + (if start == end then msg1 else msg2) <> ":\n" <> msg + where + msg1 = "Error on line " <> show (line start) <> ", column " <> show (column start) + msg2 = + "Error on line " + <> show (line start) + <> ", column " + <> show (column start) + <> " - line " + <> show (line end) + <> ", column " + <> show (column end) +debugPreParse ts = show $ payload <$> ts + +debugPreParse' :: String -> String +debugPreParse' = debugPreParse . preParse . lexer "debugPreParse" + +instance P.VisualStream [Token Lexeme] where + showTokens _ xs = + join . Nel.toList . S.evalState (traverse go xs) . end $ Nel.head xs + where + go :: Token Lexeme -> S.State Pos String + go tok = do + prev <- S.get + S.put $ end tok + pure $ pad prev (start tok) ++ pretty (payload tok) + pretty (Open s) = s + pretty (Reserved w) = w + pretty (Textual t) = '"' : t ++ ['"'] + pretty (Character c) = + case showEscapeChar c of + Just c -> "?\\" ++ [c] + Nothing -> '?' : [c] + pretty (WordyId n) = Text.unpack (HQ'.toText n) + pretty (SymbolyId n) = Text.unpack (HQ'.toText n) + pretty (Blank s) = "_" ++ s + pretty (Numeric n) = n + pretty (Hash sh) = show sh + pretty (Err e) = show e + pretty (Bytes bs) = "0xs" <> show bs + pretty Close = "" + pretty (Semi True) = "" + pretty (Semi False) = ";" + pretty (Doc d) = show d + pad (Pos line1 col1) (Pos line2 col2) = + if line1 == line2 + then replicate (col2 - col1) ' ' + else replicate (line2 - line1) '\n' ++ replicate col2 ' ' diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 1bee4d08f4..098caab1b6 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -88,8 +88,9 @@ import Unison.Pattern qualified as Pattern import Unison.Prelude import Unison.Reference (Reference) import Unison.Referent (Referent) -import Unison.Syntax.Lexer qualified as L +import Unison.Syntax.Lexer.Unison qualified as L import Unison.Syntax.Name qualified as Name (toVar, unsafeParseText) +import Unison.Syntax.Parser.Doc qualified as Doc import Unison.Syntax.Parser.Doc.Data qualified as Doc import Unison.Term (MatchCase (..)) import Unison.UnisonFile.Error qualified as UF @@ -400,7 +401,7 @@ string = queryToken getString getString (L.Textual s) = Just (Text.pack s) getString _ = Nothing -doc :: (Ord v) => P v m (L.Token (Doc.UntitledSection L.DocTree)) +doc :: (Ord v) => P v m (L.Token (Doc.UntitledSection (Doc.Tree [L.Token L.Lexeme]))) doc = queryToken \case L.Doc d -> pure d _ -> Nothing diff --git a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs new file mode 100644 index 0000000000..5ca747f204 --- /dev/null +++ b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs @@ -0,0 +1,476 @@ +module Unison.Syntax.Parser.Doc where + +import Control.Comonad.Cofree (Cofree ((:<))) +import Control.Monad.State qualified as S +import Data.Char (isControl, isSpace) +import Data.List qualified as List +import Data.List.Extra qualified as List +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.List.NonEmpty qualified as NonEmpty +import Data.Text qualified as Text +import Text.Megaparsec qualified as P +import Text.Megaparsec.Char (char) +import Text.Megaparsec.Char qualified as CP +import Text.Megaparsec.Char.Lexer qualified as LP +import Unison.Parser.Ann (Ann, Annotated (..)) +import Unison.Prelude +import Unison.Syntax.Lexer + ( P, + ParsingEnv (..), + column, + identifierP, + line, + lit, + local, + sepBy1', + separated, + some', + someTill', + typeOrAbilityAlt, + wordySep, + (<+>), + ) +import Unison.Syntax.Lexer.Token (Token (Token), posP, tokenP) +import Unison.Syntax.Parser.Doc.Data + +type Tree code = Cofree (Top code) Ann + +-- | This is the actual `Doc` lexer. Unlike `doc2`, it doesn’t do any Unison-side lexing (i.e., it doesn’t know that +-- Unison wraps `Doc` literals in `}}`). +untitledSection :: forall code. (Annotated code) => (P () -> P code) -> P () -> P (UntitledSection (Tree code)) +untitledSection code docClose = UntitledSection <$> P.many (sectionElem <* CP.space) + where + wordyKw kw = separated wordySep (lit kw) + sectionElem = section <|> fencedBlock <|> list <|> paragraph + paragraph = wrap' . Paragraph <$> spaced leaf + reserved word = List.isPrefixOf "}}" word || all (== '#') word + + wordy :: P end -> P (Leaf code void) + wordy closing = fmap Word . tokenP . P.try $ do + let end = + P.lookAhead $ + docClose + <|> void (P.satisfy isSpace) + <|> void closing + word <- P.manyTill (P.satisfy (\ch -> not (isSpace ch))) end + guard (not $ reserved word || null word) + pure word + + leafy closing = groupy closing gs + where + gs = + link + <|> externalLink + <|> exampleInline + <|> expr + <|> boldOrItalicOrStrikethrough closing + <|> verbatim + <|> atDoc + <|> wordy closing + + leaf = leafy mzero + + atDoc = src <|> evalInline <|> signature <|> signatureInline + where + comma = lit "," <* CP.space + src = + src' Source "@source" + <|> src' FoldedSource "@foldedSource" + srcElem = + SourceElement + <$> (typeLink <|> termLink) + <*> ( fmap (fromMaybe []) . P.optional $ + (lit "@") *> (CP.space *> annotations) + ) + where + annotation = fmap Left (tokenP identifierP) <|> fmap Right expr <* CP.space + annotations = + P.some (EmbedAnnotation <$> annotation) + src' name atName = fmap name $ do + _ <- lit atName *> (lit " {" <|> lit "{") *> CP.space + s <- sepBy1' srcElem comma + _ <- lit "}" + pure s + signature = fmap Signature $ do + _ <- (lit "@signatures" <|> lit "@signature") *> (lit " {" <|> lit "{") *> CP.space + s <- sepBy1' signatureLink comma + _ <- lit "}" + pure s + signatureInline = fmap SignatureInline $ do + _ <- lit "@inlineSignature" *> (lit " {" <|> lit "{") *> CP.space + s <- signatureLink + _ <- lit "}" + pure s + evalInline = fmap EvalInline $ do + _ <- lit "@eval" *> (lit " {" <|> lit "{") *> CP.space + let inlineEvalClose = () <$ lit "}" + s <- code inlineEvalClose + pure s + + typeLink = fmap EmbedTypeLink $ do + _ <- typeOrAbilityAlt (wordyKw . Text.unpack) <* CP.space + tokenP identifierP <* CP.space + + termLink = + fmap EmbedTermLink $ + tokenP identifierP <* CP.space + + signatureLink = + fmap EmbedSignatureLink $ + tokenP identifierP <* CP.space + + groupy closing p = do + Token p _ _ <- tokenP p + after <- P.optional . P.try $ leafy closing + pure $ case after of + Nothing -> p + Just after -> + Group + . Join + $ p + :| pure after + + verbatim = + P.label "code (examples: ''**unformatted**'', `words` or '''_words_''')" $ do + Token originalText start stop <- tokenP do + -- a single backtick followed by a non-backtick is treated as monospaced + let tick = P.try (lit "`" <* P.lookAhead (P.satisfy (/= '`'))) + -- also two or more ' followed by that number of closing ' + quotes <- tick <|> (lit "''" <+> P.takeWhileP Nothing (== '\'')) + P.someTill P.anySingle (lit quotes) + let isMultiLine = line start /= line stop + if isMultiLine + then do + let trimmed = (trimAroundDelimiters originalText) + let txt = trimIndentFromVerbatimBlock (column start - 1) trimmed + -- If it's a multi-line verbatim block we trim any whitespace representing + -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' + pure . Verbatim $ + Word $ + Token txt start stop + else + pure . Code $ + Word $ + Token originalText start stop + + exampleInline = + P.label "inline code (examples: ``List.map f xs``, ``[1] :+ 2``)" $ + fmap Example $ do + n <- P.try $ do + _ <- lit "`" + length <$> P.takeWhile1P (Just "backticks") (== '`') + let end = () <$ lit (replicate (n + 1) '`') + ex <- CP.space *> code end + pure ex + + link = + P.label "link (examples: {type List}, {Nat.+})" $ + fmap Link $ + P.try $ + lit "{" *> (typeLink <|> termLink) <* lit "}" + + expr :: P (Leaf code x) + expr = + fmap Transclude . P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ + lit "{{" *> code (() <$ lit "}}") + + nonNewlineSpace ch = isSpace ch && ch /= '\n' && ch /= '\r' + nonNewlineSpaces = P.takeWhileP Nothing nonNewlineSpace + + -- Allows whitespace or a newline, but not more than two newlines in a row. + whitespaceWithoutParagraphBreak :: P () + whitespaceWithoutParagraphBreak = void do + void nonNewlineSpaces + optional newline >>= \case + Just _ -> void nonNewlineSpaces + Nothing -> pure () + + fencedBlock = + P.label "block eval (syntax: a fenced code block)" $ + evalUnison <|> exampleBlock <|> other + where + evalUnison = fmap (wrap' . Eval) $ do + -- commit after seeing that ``` is on its own line + fence <- P.try $ do + fence <- lit "```" <+> P.takeWhileP Nothing (== '`') + b <- all isSpace <$> P.lookAhead (P.takeWhileP Nothing (/= '\n')) + fence <$ guard b + CP.space + *> code (() <$ lit fence) + + exampleBlock = fmap (wrap' . ExampleBlock) $ do + void $ lit "@typecheck" <* CP.space + fence <- lit "```" <+> P.takeWhileP Nothing (== '`') + code (() <$ lit fence) + + uncolumn column tabWidth s = + let skip col r | col < 1 = r + skip col s@('\t' : _) | col < tabWidth = s + skip col ('\t' : r) = skip (col - tabWidth) r + skip col (c : r) + | isSpace c && (not $ isControl c) = + skip (col - 1) r + skip _ s = s + in List.intercalate "\n" $ skip column <$> lines s + + other = fmap (uncurry $ wrapSimple2 CodeBlock) $ do + column <- (\x -> x - 1) . toInteger . P.unPos <$> LP.indentLevel + let tabWidth = toInteger . P.unPos $ P.defaultTabWidth + fence <- lit "```" <+> P.takeWhileP Nothing (== '`') + name <- + P.takeWhileP Nothing nonNewlineSpace + *> tokenP (P.takeWhile1P Nothing (not . isSpace)) + <* P.takeWhileP Nothing nonNewlineSpace + _ <- void CP.eol + verbatim <- + tokenP $ + uncolumn column tabWidth . trimAroundDelimiters + <$> P.someTill P.anySingle ([] <$ lit fence) + pure (name, verbatim) + + boldOrItalicOrStrikethrough closing = do + let start = + some (P.satisfy (== '*')) + <|> some (P.satisfy (== '_')) + <|> some + (P.satisfy (== '~')) + name s = + if take 1 s == "~" + then Strikethrough + else if take 1 s == "*" then Bold else Italic + end <- P.try $ do + end <- start + P.lookAhead (P.satisfy (not . isSpace)) + pure end + name end . wrap' . Paragraph + <$> someTill' + (leafy (closing <|> (void $ lit end)) <* whitespaceWithoutParagraphBreak) + (lit end) + + externalLink = + P.label "hyperlink (example: [link name](https://destination.com))" $ + fmap (uncurry NamedLink) $ do + _ <- lit "[" + p <- leafies (void $ char ']') + _ <- lit "]" + _ <- lit "(" + target <- + fmap (Group . Join) $ + fmap pure link <|> some' (expr <|> wordy (char ')')) + _ <- lit ")" + pure (p, target) + + -- newline = P.optional (lit "\r") *> lit "\n" + + sp = P.try $ do + spaces <- P.takeWhile1P (Just "space") isSpace + close <- P.optional (P.lookAhead (lit "}}")) + case close of + Nothing -> guard $ ok spaces + Just _ -> pure () + pure spaces + where + ok s = length [() | '\n' <- s] < 2 + + spaced p = some' (p <* P.optional sp) + leafies close = wrap' . Paragraph <$> spaced (leafy close) + + list = bulletedList <|> numberedList + + bulletedList = wrap' . BulletedList <$> sepBy1' bullet listSep + numberedList = wrap' . NumberedList <$> sepBy1' numberedItem listSep + + listSep = P.try $ newline *> nonNewlineSpaces *> P.lookAhead (void bulletedStart <|> void numberedStart) + + bulletedStart = P.try $ do + r <- listItemStart' $ [] <$ P.satisfy bulletChar + P.lookAhead (P.satisfy isSpace) + pure r + where + bulletChar ch = ch == '*' || ch == '-' || ch == '+' + + listItemStart' :: P a -> P (Int, a) + listItemStart' gutter = P.try $ do + nonNewlineSpaces + col <- column <$> posP + parentCol <- S.gets parentListColumn + guard (col > parentCol) + (col,) <$> gutter + + numberedStart = + listItemStart' $ P.try (tokenP $ LP.decimal <* lit ".") + + listItemParagraph = fmap (wrap' . Paragraph) $ do + col <- column <$> posP + some' (leaf <* sep col) + where + -- Trickiness here to support hard line breaks inside of + -- a bulleted list, so for instance this parses as expected: + -- + -- * uno dos + -- tres quatro + -- * alice bob + -- carol dave eve + sep col = do + _ <- nonNewlineSpaces + _ <- + P.optional . P.try $ + newline + *> nonNewlineSpaces + *> do + col2 <- column <$> posP + guard $ col2 >= col + (P.notFollowedBy $ void numberedStart <|> void bulletedStart) + pure () + + numberedItem = P.label msg $ do + (col, s) <- numberedStart + (s,) + <$> ( fmap (uncurry Column) $ do + p <- nonNewlineSpaces *> listItemParagraph + subList <- + local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> list) + pure (p, subList) + ) + where + msg = "numbered list (examples: 1. item1, 8. start numbering at '8')" + + bullet = fmap (uncurry Column) . P.label "bullet (examples: * item1, - item2)" $ do + (col, _) <- bulletedStart + p <- nonNewlineSpaces *> listItemParagraph + subList <- + local + (\e -> e {parentListColumn = col}) + (P.optional $ listSep *> list) + pure (p, subList) + + newline = P.label "newline" $ lit "\n" <|> lit "\r\n" + + -- ## Section title + -- + -- A paragraph under this section. + -- Part of the same paragraph. Blanklines separate paragraphs. + -- + -- ### A subsection title + -- + -- A paragraph under this subsection. + + -- # A section title (not a subsection) + section :: P (Tree code) + section = fmap (wrap' . uncurry Section) $ do + ns <- S.gets parentSections + hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp + title <- paragraph <* CP.space + let m = length hashes + head ns + body <- + local (\env -> env {parentSections = (m : (tail ns))}) $ + P.many (sectionElem <* CP.space) + pure $ (title, body) + + wrap' :: Top code (Tree code) -> Tree code + wrap' doc = ann doc :< doc + + wrapSimple2 :: (Annotated a, Annotated b) => (a -> b -> Top code (Tree code)) -> a -> b -> Tree code + wrapSimple2 fn a b = ann a <> ann b :< fn a b + +-- | If it's a multi-line verbatim block we trim any whitespace representing +-- indentation from the pretty-printer. +-- +-- E.g. +-- +-- @@ +-- {{ +-- # Heading +-- ''' +-- code +-- indented +-- ''' +-- }} +-- @@ +-- +-- Should lex to the text literal "code\n indented". +-- +-- If there's text in the literal that has LESS trailing whitespace than the +-- opening delimiters, we don't trim it at all. E.g. +-- +-- @@ +-- {{ +-- # Heading +-- ''' +-- code +-- ''' +-- }} +-- @@ +-- +-- Is parsed as " code". +-- +-- Trim the expected amount of whitespace from a text literal: +-- >>> trimIndentFromVerbatimBlock 2 " code\n indented" +-- "code\n indented" +-- +-- If the text literal has less leading whitespace than the opening delimiters, +-- leave it as-is +-- >>> trimIndentFromVerbatimBlock 2 "code\n indented" +-- "code\n indented" +trimIndentFromVerbatimBlock :: Int -> String -> String +trimIndentFromVerbatimBlock leadingSpaces txt = fromMaybe txt $ do + List.intercalate "\n" <$> for (lines txt) \line -> do + -- If any 'stripPrefix' fails, we fail and return the unaltered text + case List.stripPrefix (replicate leadingSpaces ' ') line of + Just stripped -> Just stripped + Nothing -> + -- If it was a line with all white-space, just use an empty line, + -- this can happen easily in editors which trim trailing whitespace. + if all isSpace line + then Just "" + else Nothing + +-- Trim leading/trailing whitespace from around delimiters, e.g. +-- +-- {{ +-- '''___ <- whitespace here including newline +-- text block +-- 👇 or here +-- __''' +-- }} +-- >>> trimAroundDelimiters " \n text block \n " +-- " text block " +-- +-- Should leave leading and trailing line untouched if it contains non-whitespace, e.g.: +-- +-- ''' leading whitespace +-- text block +-- trailing whitespace: ''' +-- >>> trimAroundDelimiters " leading whitespace\n text block \ntrailing whitespace: " +-- " leading whitespace\n text block \ntrailing whitespace: " +-- +-- Should keep trailing newline if it's the only thing on the line, e.g.: +-- +-- ''' +-- newline below +-- +-- ''' +-- >>> trimAroundDelimiters "\nnewline below\n\n" +-- "newline below\n\n" +trimAroundDelimiters :: String -> String +trimAroundDelimiters txt = + txt + & ( \s -> + List.breakOn "\n" s + & \case + (prefix, suffix) + | all isSpace prefix -> drop 1 suffix + | otherwise -> prefix <> suffix + ) + & ( \s -> + List.breakOnEnd "\n" s + & \case + (_prefix, "") -> s + (prefix, suffix) + | all isSpace suffix -> dropTrailingNewline prefix + | otherwise -> prefix <> suffix + ) + where + dropTrailingNewline = \case + [] -> [] + (x : xs) -> NonEmpty.init (x NonEmpty.:| xs) diff --git a/unison-syntax/test/Main.hs b/unison-syntax/test/Main.hs index 5c13940b0a..b7235f299b 100644 --- a/unison-syntax/test/Main.hs +++ b/unison-syntax/test/Main.hs @@ -10,7 +10,7 @@ import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as ShortHash import Unison.Syntax.HashQualifiedPrime qualified as HQ' (unsafeParseText) -import Unison.Syntax.Lexer +import Unison.Syntax.Lexer.Unison main :: IO () main = diff --git a/unison-syntax/unison-syntax.cabal b/unison-syntax/unison-syntax.cabal index 853da4c817..0da37d0036 100644 --- a/unison-syntax/unison-syntax.cabal +++ b/unison-syntax/unison-syntax.cabal @@ -23,9 +23,11 @@ library Unison.Syntax.HashQualifiedPrime Unison.Syntax.Lexer Unison.Syntax.Lexer.Token + Unison.Syntax.Lexer.Unison Unison.Syntax.Name Unison.Syntax.NameSegment Unison.Syntax.Parser + Unison.Syntax.Parser.Doc Unison.Syntax.Parser.Doc.Data Unison.Syntax.ReservedWords Unison.Syntax.ShortHash From e9512a69ce03e137758f8adc81dae04c422260d9 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 26 Jul 2024 12:07:05 -0600 Subject: [PATCH 518/631] Split the Doc parser into multiple functions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit In general, they map to the constructors of the Doc types, with some wiggle room for now. It’s probably beneficial to review this commit by ignoring whitespace. --- .../src/Unison/Syntax/Lexer/Unison.hs | 2 +- unison-syntax/src/Unison/Syntax/Parser/Doc.hs | 672 ++++++++++-------- 2 files changed, 375 insertions(+), 299 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs index dcaf9ca6d3..86e75b1afe 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -313,7 +313,7 @@ doc2 = do } ) do - body <- Doc.untitledSection lexemes' . P.lookAhead $ () <$ lit "}}" + body <- Doc.untitledSection . Doc.sectionElem lexemes' . P.lookAhead $ () <$ lit "}}" closeStart <- posP lit "}}" closeEnd <- posP diff --git a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs index 5ca747f204..99122bd5ff 100644 --- a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs +++ b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs @@ -1,4 +1,44 @@ -module Unison.Syntax.Parser.Doc where +module Unison.Syntax.Parser.Doc + ( Tree, + untitledSection, + sectionElem, + leaf, + + -- * section elements + section, + eval, + exampleBlock, + codeBlock, + list, + bulletedList, + numberedList, + paragraph, + + -- * leaves + link, + namedLink, + example, + transclude, + bold, + italic, + strikethrough, + verbatim, + source, + foldedSource, + evalInline, + signatures, + signatureInline, + group, + word, + + -- * other components + column', + embedTypeLink, + embedTermLink, + embedSignatureLink, + join, + ) +where import Control.Comonad.Cofree (Cofree ((:<))) import Control.Monad.State qualified as S @@ -13,7 +53,7 @@ import Text.Megaparsec.Char (char) import Text.Megaparsec.Char qualified as CP import Text.Megaparsec.Char.Lexer qualified as LP import Unison.Parser.Ann (Ann, Annotated (..)) -import Unison.Prelude +import Unison.Prelude hiding (join) import Unison.Syntax.Lexer ( P, ParsingEnv (..), @@ -37,146 +77,221 @@ type Tree code = Cofree (Top code) Ann -- | This is the actual `Doc` lexer. Unlike `doc2`, it doesn’t do any Unison-side lexing (i.e., it doesn’t know that -- Unison wraps `Doc` literals in `}}`). -untitledSection :: forall code. (Annotated code) => (P () -> P code) -> P () -> P (UntitledSection (Tree code)) -untitledSection code docClose = UntitledSection <$> P.many (sectionElem <* CP.space) +untitledSection :: P a -> P (UntitledSection a) +untitledSection a = UntitledSection <$> P.many (a <* CP.space) + +wordyKw :: String -> P String +wordyKw kw = separated wordySep (lit kw) + +sectionElem :: (Annotated code) => (P () -> P code) -> P () -> P (Tree code) +sectionElem code docClose = + fmap wrap' $ + section code docClose + <|> P.label "block eval (syntax: a fenced code block)" (eval code <|> exampleBlock code <|> codeBlock) + <|> list code docClose + <|> paragraph code docClose + +paragraph :: (Annotated code) => (P () -> P code) -> P () -> P (Top code (Tree code)) +paragraph code = fmap Paragraph . spaced . leafy code + +word :: P end -> P (Leaf code void) +word closing = fmap Word . tokenP . P.try $ do + let end = P.lookAhead $ void (P.satisfy isSpace) <|> void closing + word <- P.manyTill (P.satisfy (\ch -> not (isSpace ch))) end + guard (not $ reserved word || null word) + pure word where - wordyKw kw = separated wordySep (lit kw) - sectionElem = section <|> fencedBlock <|> list <|> paragraph - paragraph = wrap' . Paragraph <$> spaced leaf reserved word = List.isPrefixOf "}}" word || all (== '#') word - wordy :: P end -> P (Leaf code void) - wordy closing = fmap Word . tokenP . P.try $ do - let end = - P.lookAhead $ - docClose - <|> void (P.satisfy isSpace) - <|> void closing - word <- P.manyTill (P.satisfy (\ch -> not (isSpace ch))) end - guard (not $ reserved word || null word) - pure word - - leafy closing = groupy closing gs - where - gs = - link - <|> externalLink - <|> exampleInline - <|> expr - <|> boldOrItalicOrStrikethrough closing - <|> verbatim - <|> atDoc - <|> wordy closing - - leaf = leafy mzero - - atDoc = src <|> evalInline <|> signature <|> signatureInline +leaf :: (Annotated code) => (P () -> P code) -> P () -> P (Leaf code (Tree code)) +leaf code closing = + do + link + <|> namedLink code closing + <|> example code + <|> transclude code + <|> bold code closing + <|> italic code closing + <|> strikethrough code closing + <|> verbatim + <|> source code + <|> foldedSource code + <|> evalInline code + <|> signatures + <|> signatureInline + <|> word closing + +leafy :: (Annotated code) => (P () -> P code) -> P () -> P (Leaf code (Tree code)) +leafy code closing = do + p <- leaf code closing + after <- P.optional . P.try $ leafy code closing + case after of + Nothing -> pure p + Just after -> group . pure $ p :| pure after + +comma :: P String +comma = lit "," <* CP.space + +source :: (P () -> P code) -> P (Leaf code a) +source = fmap Source . (lit "@source" *>) . sourceElements + +foldedSource :: (P () -> P code) -> P (Leaf code a) +foldedSource = fmap FoldedSource . (lit "@foldedSource" *>) . sourceElements + +sourceElements :: (P () -> P code) -> P (NonEmpty (SourceElement (Leaf code Void))) +sourceElements code = do + _ <- (lit " {" <|> lit "{") *> CP.space + s <- sepBy1' srcElem comma + _ <- lit "}" + pure s + where + srcElem = + SourceElement + <$> embedLink + <*> ( fmap (fromMaybe []) . P.optional $ + (lit "@") *> (CP.space *> annotations) + ) where - comma = lit "," <* CP.space - src = - src' Source "@source" - <|> src' FoldedSource "@foldedSource" - srcElem = - SourceElement - <$> (typeLink <|> termLink) - <*> ( fmap (fromMaybe []) . P.optional $ - (lit "@") *> (CP.space *> annotations) - ) - where - annotation = fmap Left (tokenP identifierP) <|> fmap Right expr <* CP.space - annotations = - P.some (EmbedAnnotation <$> annotation) - src' name atName = fmap name $ do - _ <- lit atName *> (lit " {" <|> lit "{") *> CP.space - s <- sepBy1' srcElem comma - _ <- lit "}" - pure s - signature = fmap Signature $ do - _ <- (lit "@signatures" <|> lit "@signature") *> (lit " {" <|> lit "{") *> CP.space - s <- sepBy1' signatureLink comma - _ <- lit "}" - pure s - signatureInline = fmap SignatureInline $ do - _ <- lit "@inlineSignature" *> (lit " {" <|> lit "{") *> CP.space - s <- signatureLink - _ <- lit "}" - pure s - evalInline = fmap EvalInline $ do - _ <- lit "@eval" *> (lit " {" <|> lit "{") *> CP.space - let inlineEvalClose = () <$ lit "}" - s <- code inlineEvalClose - pure s - - typeLink = fmap EmbedTypeLink $ do - _ <- typeOrAbilityAlt (wordyKw . Text.unpack) <* CP.space - tokenP identifierP <* CP.space - - termLink = - fmap EmbedTermLink $ - tokenP identifierP <* CP.space - - signatureLink = - fmap EmbedSignatureLink $ - tokenP identifierP <* CP.space - - groupy closing p = do - Token p _ _ <- tokenP p - after <- P.optional . P.try $ leafy closing - pure $ case after of - Nothing -> p - Just after -> - Group - . Join - $ p - :| pure after - - verbatim = - P.label "code (examples: ''**unformatted**'', `words` or '''_words_''')" $ do - Token originalText start stop <- tokenP do - -- a single backtick followed by a non-backtick is treated as monospaced - let tick = P.try (lit "`" <* P.lookAhead (P.satisfy (/= '`'))) - -- also two or more ' followed by that number of closing ' - quotes <- tick <|> (lit "''" <+> P.takeWhileP Nothing (== '\'')) - P.someTill P.anySingle (lit quotes) - let isMultiLine = line start /= line stop - if isMultiLine - then do - let trimmed = (trimAroundDelimiters originalText) - let txt = trimIndentFromVerbatimBlock (column start - 1) trimmed - -- If it's a multi-line verbatim block we trim any whitespace representing - -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' - pure . Verbatim $ - Word $ - Token txt start stop - else - pure . Code $ - Word $ - Token originalText start stop - - exampleInline = - P.label "inline code (examples: ``List.map f xs``, ``[1] :+ 2``)" $ - fmap Example $ do - n <- P.try $ do - _ <- lit "`" - length <$> P.takeWhile1P (Just "backticks") (== '`') - let end = () <$ lit (replicate (n + 1) '`') - ex <- CP.space *> code end - pure ex - - link = - P.label "link (examples: {type List}, {Nat.+})" $ - fmap Link $ - P.try $ - lit "{" *> (typeLink <|> termLink) <* lit "}" - - expr :: P (Leaf code x) - expr = - fmap Transclude . P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ - lit "{{" *> code (() <$ lit "}}") - + annotation = fmap Left (tokenP identifierP) <|> fmap Right (transclude code) <* CP.space + annotations = + P.some (EmbedAnnotation <$> annotation) + +signatures :: P (Leaf code a) +signatures = fmap Signature $ do + _ <- (lit "@signatures" <|> lit "@signature") *> (lit " {" <|> lit "{") *> CP.space + s <- sepBy1' embedSignatureLink comma + _ <- lit "}" + pure s + +signatureInline :: P (Leaf code a) +signatureInline = fmap SignatureInline $ do + _ <- lit "@inlineSignature" *> (lit " {" <|> lit "{") *> CP.space + s <- embedSignatureLink + _ <- lit "}" + pure s + +evalInline :: (P () -> P a1) -> P (Leaf a1 a2) +evalInline code = fmap EvalInline $ do + _ <- lit "@eval" *> (lit " {" <|> lit "{") *> CP.space + let inlineEvalClose = void $ lit "}" + s <- code inlineEvalClose + pure s + +embedTypeLink :: P EmbedLink +embedTypeLink = + EmbedTypeLink <$> do + _ <- typeOrAbilityAlt (wordyKw . Text.unpack) <* CP.space + tokenP identifierP <* CP.space + +embedTermLink :: P EmbedLink +embedTermLink = EmbedTermLink <$> tokenP identifierP <* CP.space + +embedSignatureLink :: P EmbedSignatureLink +embedSignatureLink = EmbedSignatureLink <$> tokenP identifierP <* CP.space + +verbatim :: P (Leaf code a) +verbatim = + P.label "code (examples: ''**unformatted**'', `words` or '''_words_''')" $ do + Token originalText start stop <- tokenP do + -- a single backtick followed by a non-backtick is treated as monospaced + let tick = P.try (lit "`" <* P.lookAhead (P.satisfy (/= '`'))) + -- also two or more ' followed by that number of closing ' + quotes <- tick <|> (lit "''" <+> P.takeWhileP Nothing (== '\'')) + P.someTill P.anySingle (lit quotes) + let isMultiLine = line start /= line stop + if isMultiLine + then do + let trimmed = (trimAroundDelimiters originalText) + let txt = trimIndentFromVerbatimBlock (column start - 1) trimmed + -- If it's a multi-line verbatim block we trim any whitespace representing + -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' + pure . Verbatim $ + Word $ + Token txt start stop + else + pure . Code $ + Word $ + Token originalText start stop + +example :: (P () -> P code) -> P (Leaf code void) +example code = + P.label "inline code (examples: ``List.map f xs``, ``[1] :+ 2``)" $ + fmap Example $ do + n <- P.try $ do + _ <- lit "`" + length <$> P.takeWhile1P (Just "backticks") (== '`') + let end = void . lit $ replicate (n + 1) '`' + CP.space *> code end + +link :: P (Leaf a b) +link = P.label "link (examples: {type List}, {Nat.+})" $ Link <$> P.try (lit "{" *> embedLink <* lit "}") + +transclude :: (P () -> P code) -> P (Leaf code x) +transclude code = + fmap Transclude . P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ + lit "{{" *> code (void $ lit "}}") + +nonNewlineSpaces :: P String +nonNewlineSpaces = P.takeWhileP Nothing nonNewlineSpace + where nonNewlineSpace ch = isSpace ch && ch /= '\n' && ch /= '\r' - nonNewlineSpaces = P.takeWhileP Nothing nonNewlineSpace +eval :: (Annotated code) => (P () -> P code) -> P (Top code (Tree code)) +eval code = + Eval <$> do + -- commit after seeing that ``` is on its own line + fence <- P.try $ do + fence <- lit "```" <+> P.takeWhileP Nothing (== '`') + b <- all isSpace <$> P.lookAhead (P.takeWhileP Nothing (/= '\n')) + fence <$ guard b + CP.space *> code (void $ lit fence) + +exampleBlock :: (Annotated code) => (P () -> P code) -> P (Top code (Tree code)) +exampleBlock code = + ExampleBlock + <$> do + void $ lit "@typecheck" <* CP.space + fence <- lit "```" <+> P.takeWhileP Nothing (== '`') + code . void $ lit fence + +codeBlock :: P (Top code (Tree code)) +codeBlock = do + column <- (\x -> x - 1) . toInteger . P.unPos <$> LP.indentLevel + let tabWidth = toInteger . P.unPos $ P.defaultTabWidth + fence <- lit "```" <+> P.takeWhileP Nothing (== '`') + name <- + nonNewlineSpaces + *> tokenP (P.takeWhile1P Nothing (not . isSpace)) + <* nonNewlineSpaces + _ <- void CP.eol + verbatim <- + tokenP $ + uncolumn column tabWidth . trimAroundDelimiters + <$> P.someTill P.anySingle ([] <$ lit fence) + pure $ CodeBlock name verbatim + where + uncolumn column tabWidth s = + let skip col r | col < 1 = r + skip col s@('\t' : _) | col < tabWidth = s + skip col ('\t' : r) = skip (col - tabWidth) r + skip col (c : r) + | isSpace c && (not $ isControl c) = + skip (col - 1) r + skip _ s = s + in List.intercalate "\n" $ skip column <$> lines s + +emphasis :: (Annotated code) => Char -> (P () -> P code) -> P () -> P (Tree code) +emphasis delimiter code closing = do + let start = some (P.satisfy (== delimiter)) + end <- P.try $ do + end <- start + P.lookAhead (P.satisfy (not . isSpace)) + pure end + wrap' . Paragraph + <$> someTill' + (leafy code (closing <|> (void $ lit end)) <* void whitespaceWithoutParagraphBreak) + (lit end) + where -- Allows whitespace or a newline, but not more than two newlines in a row. whitespaceWithoutParagraphBreak :: P () whitespaceWithoutParagraphBreak = void do @@ -185,124 +300,92 @@ untitledSection code docClose = UntitledSection <$> P.many (sectionElem <* CP.sp Just _ -> void nonNewlineSpaces Nothing -> pure () - fencedBlock = - P.label "block eval (syntax: a fenced code block)" $ - evalUnison <|> exampleBlock <|> other - where - evalUnison = fmap (wrap' . Eval) $ do - -- commit after seeing that ``` is on its own line - fence <- P.try $ do - fence <- lit "```" <+> P.takeWhileP Nothing (== '`') - b <- all isSpace <$> P.lookAhead (P.takeWhileP Nothing (/= '\n')) - fence <$ guard b - CP.space - *> code (() <$ lit fence) - - exampleBlock = fmap (wrap' . ExampleBlock) $ do - void $ lit "@typecheck" <* CP.space - fence <- lit "```" <+> P.takeWhileP Nothing (== '`') - code (() <$ lit fence) - - uncolumn column tabWidth s = - let skip col r | col < 1 = r - skip col s@('\t' : _) | col < tabWidth = s - skip col ('\t' : r) = skip (col - tabWidth) r - skip col (c : r) - | isSpace c && (not $ isControl c) = - skip (col - 1) r - skip _ s = s - in List.intercalate "\n" $ skip column <$> lines s - - other = fmap (uncurry $ wrapSimple2 CodeBlock) $ do - column <- (\x -> x - 1) . toInteger . P.unPos <$> LP.indentLevel - let tabWidth = toInteger . P.unPos $ P.defaultTabWidth - fence <- lit "```" <+> P.takeWhileP Nothing (== '`') - name <- - P.takeWhileP Nothing nonNewlineSpace - *> tokenP (P.takeWhile1P Nothing (not . isSpace)) - <* P.takeWhileP Nothing nonNewlineSpace - _ <- void CP.eol - verbatim <- - tokenP $ - uncolumn column tabWidth . trimAroundDelimiters - <$> P.someTill P.anySingle ([] <$ lit fence) - pure (name, verbatim) - - boldOrItalicOrStrikethrough closing = do - let start = - some (P.satisfy (== '*')) - <|> some (P.satisfy (== '_')) - <|> some - (P.satisfy (== '~')) - name s = - if take 1 s == "~" - then Strikethrough - else if take 1 s == "*" then Bold else Italic - end <- P.try $ do - end <- start - P.lookAhead (P.satisfy (not . isSpace)) - pure end - name end . wrap' . Paragraph - <$> someTill' - (leafy (closing <|> (void $ lit end)) <* whitespaceWithoutParagraphBreak) - (lit end) - - externalLink = - P.label "hyperlink (example: [link name](https://destination.com))" $ - fmap (uncurry NamedLink) $ do - _ <- lit "[" - p <- leafies (void $ char ']') - _ <- lit "]" - _ <- lit "(" - target <- - fmap (Group . Join) $ - fmap pure link <|> some' (expr <|> wordy (char ')')) - _ <- lit ")" - pure (p, target) - - -- newline = P.optional (lit "\r") *> lit "\n" - - sp = P.try $ do - spaces <- P.takeWhile1P (Just "space") isSpace - close <- P.optional (P.lookAhead (lit "}}")) - case close of - Nothing -> guard $ ok spaces - Just _ -> pure () - pure spaces - where - ok s = length [() | '\n' <- s] < 2 +bold :: (Annotated code) => (P () -> P code) -> P () -> P (Leaf code (Tree code)) +bold code = fmap Bold . emphasis '*' code + +italic :: (Annotated code) => (P () -> P code) -> P () -> P (Leaf code (Tree code)) +italic code = fmap Italic . emphasis '_' code + +strikethrough :: (Annotated code) => (P () -> P code) -> P () -> P (Leaf code (Tree code)) +strikethrough code = fmap Strikethrough . emphasis '~' code + +namedLink :: (Annotated code) => (P () -> P code) -> P () -> P (Leaf code (Tree code)) +namedLink code docClose = + P.label "hyperlink (example: [link name](https://destination.com))" do + _ <- lit "[" + p <- spaced . leafy code . void $ char ']' + _ <- lit "]" + _ <- lit "(" + target <- group $ fmap pure link <|> some' (transclude code <|> word (docClose <|> void (char ')'))) + _ <- lit ")" + pure $ NamedLink (wrap' $ Paragraph p) target + +sp :: P String +sp = P.try $ do + spaces <- P.takeWhile1P (Just "space") isSpace + close <- P.optional (P.lookAhead (lit "}}")) + case close of + Nothing -> guard $ ok spaces + Just _ -> pure () + pure spaces + where + ok s = length [() | '\n' <- s] < 2 + +spaced :: P a -> P (NonEmpty a) +spaced p = some' (p <* P.optional sp) - spaced p = some' (p <* P.optional sp) - leafies close = wrap' . Paragraph <$> spaced (leafy close) +-- | Not an actual node, but this pattern is referenced in multiple places +list :: (Annotated code) => (P () -> P code) -> P () -> P (Top code (Tree code)) +list code docClose = bulletedList code docClose <|> numberedList code docClose - list = bulletedList <|> numberedList +listSep :: P () +listSep = P.try $ newline *> nonNewlineSpaces *> P.lookAhead (void bulletedStart <|> void numberedStart) - bulletedList = wrap' . BulletedList <$> sepBy1' bullet listSep - numberedList = wrap' . NumberedList <$> sepBy1' numberedItem listSep +bulletedStart :: P (Int, [a]) +bulletedStart = P.try $ do + r <- listItemStart $ [] <$ P.satisfy bulletChar + P.lookAhead (P.satisfy isSpace) + pure r + where + bulletChar ch = ch == '*' || ch == '-' || ch == '+' + +listItemStart :: P a -> P (Int, a) +listItemStart gutter = P.try $ do + nonNewlineSpaces + col <- column <$> posP + parentCol <- S.gets parentListColumn + guard (col > parentCol) + (col,) <$> gutter + +numberedStart :: P (Int, Token Word64) +numberedStart = listItemStart $ P.try (tokenP $ LP.decimal <* lit ".") + +-- | FIXME: This should take a @`P` a@ +numberedList :: (Annotated code) => (P () -> P code) -> P () -> P (Top code (Tree code)) +numberedList code docClose = NumberedList <$> sepBy1' numberedItem listSep + where + numberedItem = P.label "numbered list (examples: 1. item1, 8. start numbering at '8')" do + (col, s) <- numberedStart + (s,) <$> column' code docClose col - listSep = P.try $ newline *> nonNewlineSpaces *> P.lookAhead (void bulletedStart <|> void numberedStart) +-- | FIXME: This should take a @`P` a@ +bulletedList :: (Annotated code) => (P () -> P code) -> P () -> P (Top code (Tree code)) +bulletedList code docClose = BulletedList <$> sepBy1' bullet listSep + where + bullet = P.label "bullet (examples: * item1, - item2)" do + (col, _) <- bulletedStart + column' code docClose col - bulletedStart = P.try $ do - r <- listItemStart' $ [] <$ P.satisfy bulletChar - P.lookAhead (P.satisfy isSpace) - pure r - where - bulletChar ch = ch == '*' || ch == '-' || ch == '+' - - listItemStart' :: P a -> P (Int, a) - listItemStart' gutter = P.try $ do - nonNewlineSpaces - col <- column <$> posP - parentCol <- S.gets parentListColumn - guard (col > parentCol) - (col,) <$> gutter - - numberedStart = - listItemStart' $ P.try (tokenP $ LP.decimal <* lit ".") - - listItemParagraph = fmap (wrap' . Paragraph) $ do - col <- column <$> posP - some' (leaf <* sep col) +column' :: (Annotated code) => (P () -> P code) -> P () -> Int -> P (Column (Tree code)) +column' code docClose col = + Column . wrap' + <$> (nonNewlineSpaces *> listItemParagraph) + <*> local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> fmap wrap' (list code docClose)) + where + listItemParagraph = + Paragraph <$> do + col <- column <$> posP + some' (leafy code docClose <* sep col) where -- Trickiness here to support hard line breaks inside of -- a bulleted list, so for instance this parses as expected: @@ -323,55 +406,48 @@ untitledSection code docClose = UntitledSection <$> P.many (sectionElem <* CP.sp (P.notFollowedBy $ void numberedStart <|> void bulletedStart) pure () - numberedItem = P.label msg $ do - (col, s) <- numberedStart - (s,) - <$> ( fmap (uncurry Column) $ do - p <- nonNewlineSpaces *> listItemParagraph - subList <- - local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> list) - pure (p, subList) - ) - where - msg = "numbered list (examples: 1. item1, 8. start numbering at '8')" +newline :: P String +newline = P.label "newline" $ lit "\n" <|> lit "\r\n" - bullet = fmap (uncurry Column) . P.label "bullet (examples: * item1, - item2)" $ do - (col, _) <- bulletedStart - p <- nonNewlineSpaces *> listItemParagraph - subList <- - local - (\e -> e {parentListColumn = col}) - (P.optional $ listSep *> list) - pure (p, subList) - - newline = P.label "newline" $ lit "\n" <|> lit "\r\n" - - -- ## Section title - -- - -- A paragraph under this section. - -- Part of the same paragraph. Blanklines separate paragraphs. - -- - -- ### A subsection title - -- - -- A paragraph under this subsection. - - -- # A section title (not a subsection) - section :: P (Tree code) - section = fmap (wrap' . uncurry Section) $ do - ns <- S.gets parentSections - hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp - title <- paragraph <* CP.space - let m = length hashes + head ns - body <- - local (\env -> env {parentSections = (m : (tail ns))}) $ - P.many (sectionElem <* CP.space) - pure $ (title, body) - - wrap' :: Top code (Tree code) -> Tree code - wrap' doc = ann doc :< doc - - wrapSimple2 :: (Annotated a, Annotated b) => (a -> b -> Top code (Tree code)) -> a -> b -> Tree code - wrapSimple2 fn a b = ann a <> ann b :< fn a b +-- | +-- +-- > ## Section title +-- > +-- > A paragraph under this section. +-- > Part of the same paragraph. Blanklines separate paragraphs. +-- > +-- > ### A subsection title +-- > +-- > A paragraph under this subsection. +-- > +-- > # A section title (not a subsection) +section :: (Annotated code) => (P () -> P code) -> P () -> P (Top code (Tree code)) +section code docClose = do + ns <- S.gets parentSections + hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp + title <- paragraph code docClose <* CP.space + let m = length hashes + head ns + body <- + local (\env -> env {parentSections = (m : (tail ns))}) $ + P.many (sectionElem code docClose <* CP.space) + pure $ Section (wrap' title) body + +-- | Not an actual node, but this pattern is referenced in multiple places +embedLink :: P EmbedLink +embedLink = embedTypeLink <|> embedTermLink + +-- | FIXME: This should just take a @`P` code@ and @`P` a@. +group :: P (NonEmpty (Leaf code a)) -> P (Leaf code a) +group = fmap Group . join + +-- | FIXME: This should just take a @`P` a@ +join :: P (NonEmpty a) -> P (Join a) +join = fmap Join + +-- * utility functions + +wrap' :: (Annotated code) => Top code (Tree code) -> Tree code +wrap' doc = ann doc :< doc -- | If it's a multi-line verbatim block we trim any whitespace representing -- indentation from the pretty-printer. @@ -425,7 +501,7 @@ trimIndentFromVerbatimBlock leadingSpaces txt = fromMaybe txt $ do then Just "" else Nothing --- Trim leading/trailing whitespace from around delimiters, e.g. +-- | Trim leading/trailing whitespace from around delimiters, e.g. -- -- {{ -- '''___ <- whitespace here including newline From a6528ac351c1b8f7e51363040d2f710e75a4a1ee Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 26 Jul 2024 22:56:22 -0600 Subject: [PATCH 519/631] Generalize the Doc parser MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit It is now completely[^1] independent of the Unison language. The parser takes a few parsers as arguments: one for identifiers, one for code, and one to indicate the end of the Doc block. [^1]: There is one last bit to be removed in the next commit – Doc still looks for `type` or `ability` to identify type links. --- .../src/Unison/Syntax/TermParser.hs | 16 +- unison-syntax/src/Unison/Parser/Ann.hs | 4 + unison-syntax/src/Unison/Syntax/Lexer.hs | 170 +------- .../src/Unison/Syntax/Lexer/Token.hs | 6 +- .../src/Unison/Syntax/Lexer/Unison.hs | 117 +++++- unison-syntax/src/Unison/Syntax/Parser.hs | 2 +- unison-syntax/src/Unison/Syntax/Parser/Doc.hs | 364 +++++++++++------- .../src/Unison/Syntax/Parser/Doc/Data.hs | 72 ++-- 8 files changed, 412 insertions(+), 339 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 4c3069b9ff..8d0195410a 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -530,7 +530,7 @@ doc2Block = do docUntitledSection ann (Doc.UntitledSection tops) = Term.app ann (f ann "UntitledSection") $ Term.list (gann tops) tops - docTop :: Doc.Top [L.Token L.Lexeme] (Term v Ann) -> TermP v m + docTop :: Doc.Top (HQ'.HashQualified Name) [L.Token L.Lexeme] (Term v Ann) -> TermP v m docTop d = case d of Doc.Section title body -> pure $ Term.apps' (f d "Section") [title, Term.list (gann body) body] Doc.Eval code -> @@ -558,7 +558,7 @@ doc2Block = do docColumn d@(Doc.Column para sublist) = Term.app (gann d) (f d "Column") . Term.list (gann d) $ para : toList sublist - docLeaf :: Doc.Leaf [L.Token L.Lexeme] (Term v Ann) -> TermP v m + docLeaf :: Doc.Leaf (HQ'.HashQualified Name) [L.Token L.Lexeme] (Term v Ann) -> TermP v m docLeaf d = case d of Doc.Link link -> Term.app (gann d) (f d "Link") <$> docEmbedLink link Doc.NamedLink para target -> Term.apps' (f d "NamedLink") . (para :) . pure <$> docLeaf (vacuous target) @@ -590,7 +590,7 @@ doc2Block = do Term.app (gann d) (f d "Group") . Term.app (gann d) (f d "Join") . Term.list (ann leaves) . toList <$> traverse docLeaf leaves - docEmbedLink :: Doc.EmbedLink -> TermP v m + docEmbedLink :: Doc.EmbedLink (HQ'.HashQualified Name) -> TermP v m docEmbedLink d = case d of Doc.EmbedTypeLink ident -> Term.app (gann d) (f d "EmbedTypeLink") . Term.typeLink (ann d) . L.payload @@ -598,17 +598,21 @@ doc2Block = do Doc.EmbedTermLink ident -> Term.app (gann d) (f d "EmbedTermLink") . addDelay <$> resolveHashQualified (HQ'.toHQ <$> ident) - docSourceElement :: Doc.SourceElement (Doc.Leaf [L.Token L.Lexeme] Void) -> TermP v m + docSourceElement :: + Doc.SourceElement (HQ'.HashQualified Name) (Doc.Leaf (HQ'.HashQualified Name) [L.Token L.Lexeme] Void) -> + TermP v m docSourceElement d@(Doc.SourceElement link anns) = do link' <- docEmbedLink link anns' <- traverse docEmbedAnnotation anns pure $ Term.apps' (f d "SourceElement") [link', Term.list (ann anns) anns'] - docEmbedSignatureLink :: Doc.EmbedSignatureLink -> TermP v m + docEmbedSignatureLink :: Doc.EmbedSignatureLink (HQ'.HashQualified Name) -> TermP v m docEmbedSignatureLink d@(Doc.EmbedSignatureLink ident) = Term.app (gann d) (f d "EmbedSignatureLink") . addDelay <$> resolveHashQualified (HQ'.toHQ <$> ident) - docEmbedAnnotation :: Doc.EmbedAnnotation (Doc.Leaf [L.Token L.Lexeme] Void) -> TermP v m + docEmbedAnnotation :: + Doc.EmbedAnnotation (HQ'.HashQualified Name) (Doc.Leaf (HQ'.HashQualified Name) [L.Token L.Lexeme] Void) -> + TermP v m docEmbedAnnotation d@(Doc.EmbedAnnotation a) = -- This is the only place I’m not sure we’re doing the right thing. In the lexer, this can be an identifier or a -- DocLeaf, but here it could be either /text/ or a Doc element. And I don’t think there’s any way the lexemes diff --git a/unison-syntax/src/Unison/Parser/Ann.hs b/unison-syntax/src/Unison/Parser/Ann.hs index 961bbcb30c..e4b361d148 100644 --- a/unison-syntax/src/Unison/Parser/Ann.hs +++ b/unison-syntax/src/Unison/Parser/Ann.hs @@ -4,6 +4,7 @@ module Unison.Parser.Ann where +import Control.Comonad.Cofree (Cofree ((:<))) import Data.List.NonEmpty (NonEmpty) import Data.Void (absurd) import Unison.Lexer.Pos qualified as L @@ -100,3 +101,6 @@ instance (Annotated a) => Annotated (Maybe a) where instance Annotated Void where ann = absurd + +instance (Annotated a) => Annotated (Cofree f a) where + ann (a :< _) = ann a diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index cfd932cd7e..5e6d18293f 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -1,12 +1,8 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -Wno-orphans #-} - -- | This currently contains a mix of general lexing utilities and identifier-y lexers. module Unison.Syntax.Lexer ( Token (..), Line, Column, - Err (..), Pos (..), touches, @@ -15,16 +11,10 @@ module Unison.Syntax.Lexer wordyIdStartChar, symbolyIdChar, - -- * new exports - BlockName, - Layout, - ParsingEnv (..), - P, + -- * other utils local, - parseFailure, space, lit, - err, commitAfter2, (<+>), some', @@ -32,99 +22,35 @@ module Unison.Syntax.Lexer sepBy1', separated, wordySep, - identifierP, - wordyIdSegP, - shortHashP, - topBlockName, pop, typeOrAbilityAlt, - typeModifiersAlt, inc, ) where -import Control.Comonad.Cofree (Cofree ((:<))) import Control.Monad.State qualified as S import Data.Char (isSpace) import Data.List.NonEmpty (NonEmpty ((:|))) -import Data.Text qualified as Text import Text.Megaparsec qualified as P import Text.Megaparsec.Char qualified as CP import Text.Megaparsec.Char.Lexer qualified as LP -import Text.Megaparsec.Error qualified as EP -import Text.Megaparsec.Internal qualified as PI -import Unison.HashQualifiedPrime qualified as HQ' import Unison.Lexer.Pos (Column, Line, Pos (Pos), column, line) -import Unison.Name (Name) -import Unison.NameSegment (NameSegment) -import Unison.Parser.Ann (Annotated (..)) import Unison.Prelude -import Unison.ShortHash (ShortHash) -import Unison.Syntax.Lexer.Token (Token (..), posP) -import Unison.Syntax.Name qualified as Name (nameP) +import Unison.Syntax.Lexer.Token (Token (..)) import Unison.Syntax.NameSegment (symbolyIdChar, wordyIdChar, wordyIdStartChar) -import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..), wordyP) -import Unison.Syntax.ReservedWords (typeModifiers, typeOrAbility) -import Unison.Syntax.ShortHash qualified as ShortHash (shortHashP) - -instance (Annotated a) => Annotated (Cofree f a) where - ann (a :< _) = ann a - -type BlockName = String - -type Layout = [(BlockName, Column)] - -data ParsingEnv = ParsingEnv - { -- | layout stack - layout :: !Layout, - -- | `Just b` if a block of type `b` is being opened - opening :: Maybe BlockName, - -- | are we inside a construct that uses layout? - inLayout :: Bool, - -- | Use a stack to remember the parent section and allow docSections within docSections. - -- - 1 means we are inside a # Heading 1 - parentSections :: [Int], - -- | 4 means we are inside a list starting at the fourth column - parentListColumn :: Int - } - deriving (Show) - -type P = P.ParsecT (Token Err) String (S.State ParsingEnv) - -local :: (ParsingEnv -> ParsingEnv) -> P a -> P a +import Unison.Syntax.ReservedWords (typeOrAbility) + +local :: (P.MonadParsec e s' m, S.MonadState s m) => (s -> s) -> m a -> m a local f p = do env0 <- S.get S.put (f env0) e <- P.observing p S.put env0 case e of - Left e -> parseFailure e + Left e -> P.parseError e Right a -> pure a -parseFailure :: EP.ParseError [Char] (Token Err) -> P a -parseFailure e = PI.ParsecT $ \s _ _ _ eerr -> eerr e s - -data Err - = ReservedWordyId String - | InvalidSymbolyId String - | ReservedSymbolyId String - | InvalidShortHash String - | InvalidBytesLiteral String - | InvalidHexLiteral - | InvalidOctalLiteral - | Both Err Err - | MissingFractional String -- ex `1.` rather than `1.04` - | MissingExponent String -- ex `1e` rather than `1e3` - | UnknownLexeme - | TextLiteralMissingClosingQuote String - | InvalidEscapeCharacter Char - | LayoutError - | CloseWithoutMatchingOpen String String -- open, close - | UnexpectedDelimiter String - | UnexpectedTokens String -- Catch-all for all other lexer errors, representing some unexpected tokens. - deriving stock (Eq, Ord, Show) -- richer algebra - -space :: P () +space :: (P.MonadParsec e String m) => m () space = LP.space CP.space1 @@ -133,92 +59,42 @@ space = where fold = P.try $ lit "---" *> P.takeRest *> pure () -lit :: String -> P String +lit :: (P.MonadParsec e String m) => String -> m String lit = P.try . LP.symbol (pure ()) --- Committed failure -err :: Pos -> Err -> P x -err start t = do - stop <- posP - -- This consumes a character and therefore produces committed failure, - -- so `err s t <|> p2` won't try `p2` - _ <- void P.anySingle <|> P.eof - P.customFailure (Token t start stop) - -{- -commitAfter :: P a -> (a -> P b) -> P b -commitAfter a f = do - a <- P.try a - f a --} - -commitAfter2 :: P a -> P b -> (a -> b -> P c) -> P c +commitAfter2 :: (P.MonadParsec e s m) => m a -> m b -> (a -> b -> m c) -> m c commitAfter2 a b f = do (a, b) <- P.try $ liftA2 (,) a b f a b infixl 2 <+> -(<+>) :: (Monoid a) => P a -> P a -> P a -p1 <+> p2 = do a1 <- p1; a2 <- p2; pure (a1 <> a2) +(<+>) :: (Applicative f, Monoid a) => f a -> f a -> f a +(<+>) = liftA2 (<>) -- | Like `P.some`, but returns an actual `NonEmpty`. -some' :: P a -> P (NonEmpty a) +some' :: (P.MonadParsec e s m) => m a -> m (NonEmpty a) some' p = liftA2 (:|) p $ many p -- | Like `P.someTill`, but returns an actual `NonEmpty`. -someTill' :: P a -> P end -> P (NonEmpty a) +someTill' :: (P.MonadParsec e s m) => m a -> m end -> m (NonEmpty a) someTill' p end = liftA2 (:|) p $ P.manyTill p end -- | Like `P.sepBy1`, but returns an actual `NonEmpty`. -sepBy1' :: P a -> P sep -> P (NonEmpty a) +sepBy1' :: (P.MonadParsec e s m) => m a -> m sep -> m (NonEmpty a) sepBy1' p sep = liftA2 (:|) p . many $ sep *> p -separated :: (Char -> Bool) -> P a -> P a +separated :: (P.MonadParsec e s m) => (P.Token s -> Bool) -> m a -> m a separated ok p = P.try $ p <* P.lookAhead (void (P.satisfy ok) <|> P.eof) wordySep :: Char -> Bool wordySep c = isSpace c || not (wordyIdChar c) --- An identifier is a non-empty dot-delimited list of segments, with an optional leading dot, where each segment is --- symboly (comprised of only symbols) or wordy (comprised of only alphanums). --- --- Examples: --- --- foo --- .foo.++.doc --- `.`.`..` (This is a two-segment identifier without a leading dot: "." then "..") -identifierP :: P (HQ'.HashQualified Name) -identifierP = do - P.label "identifier (ex: abba1, snake_case, .foo.bar#xyz, .foo.++#xyz, or 🌻)" do - name <- PI.withParsecT (fmap nameSegmentParseErrToErr) Name.nameP - P.optional shortHashP <&> \case - Nothing -> HQ'.fromName name - Just shorthash -> HQ'.HashQualified name shorthash - where - nameSegmentParseErrToErr :: NameSegment.ParseErr -> Err - nameSegmentParseErrToErr = \case - NameSegment.ReservedOperator s -> ReservedSymbolyId (Text.unpack s) - NameSegment.ReservedWord s -> ReservedWordyId (Text.unpack s) - -wordyIdSegP :: P NameSegment -wordyIdSegP = - PI.withParsecT (fmap (ReservedWordyId . Text.unpack)) NameSegment.wordyP - -shortHashP :: P ShortHash -shortHashP = - PI.withParsecT (fmap (InvalidShortHash . Text.unpack)) ShortHash.shortHashP - -- `True` if the tokens are adjacent, with no space separating the two touches :: Token a -> Token b -> Bool touches (end -> t) (start -> t2) = line t == line t2 && column t == column t2 --- todo: make Layout a NonEmpty -topBlockName :: Layout -> Maybe BlockName -topBlockName [] = Nothing -topBlockName ((name, _) : _) = Just name - pop :: [a] -> [a] pop = drop 1 @@ -226,21 +102,5 @@ typeOrAbilityAlt :: (Alternative f) => (Text -> f a) -> f a typeOrAbilityAlt f = asum $ map f (toList typeOrAbility) -typeModifiersAlt :: (Alternative f) => (Text -> f a) -> f a -typeModifiersAlt f = - asum $ map f (toList typeModifiers) - inc :: Pos -> Pos inc (Pos line col) = Pos line (col + 1) - -instance EP.ShowErrorComponent (Token Err) where - showErrorComponent (Token err _ _) = go err - where - go = \case - UnexpectedTokens msg -> msg - CloseWithoutMatchingOpen open close -> "I found a closing " <> close <> " but no matching " <> open <> "." - Both e1 e2 -> go e1 <> "\n" <> go e2 - LayoutError -> "Indentation error" - TextLiteralMissingClosingQuote s -> "This text literal missing a closing quote: " <> excerpt s - e -> show e - excerpt s = if length s < 15 then s else take 15 s <> "..." diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Token.hs b/unison-syntax/src/Unison/Syntax/Lexer/Token.hs index e29f276c5e..f778dd66c0 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Token.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Token.hs @@ -6,7 +6,7 @@ module Unison.Syntax.Lexer.Token where import Data.Text qualified as Text -import Text.Megaparsec (ParsecT, TraversableStream) +import Text.Megaparsec (MonadParsec, TraversableStream) import Text.Megaparsec qualified as P import Unison.Lexer.Pos (Pos (Pos)) import Unison.Parser.Ann (Ann (Ann), Annotated (..)) @@ -43,14 +43,14 @@ instance Applicative Token where instance P.ShowErrorComponent (Token Text) where showErrorComponent = Text.unpack . payload -tokenP :: (Ord e, TraversableStream s) => ParsecT e s m a -> ParsecT e s m (Token a) +tokenP :: (Ord e, TraversableStream s, MonadParsec e s m) => m a -> m (Token a) tokenP p = do start <- posP payload <- p end <- posP pure Token {payload, start, end} -posP :: (Ord e, TraversableStream s) => ParsecT e s m Pos +posP :: (Ord e, TraversableStream s, MonadParsec e s m) => m Pos posP = do p <- P.getSourcePos pure (Pos (P.unPos (P.sourceLine p)) (P.unPos (P.sourceColumn p))) diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs index 86e75b1afe..98112c2124 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -Wno-orphans #-} - module Unison.Syntax.Lexer.Unison ( Token (..), Line, @@ -44,9 +41,11 @@ import Text.Megaparsec.Char (char) import Text.Megaparsec.Char qualified as CP import Text.Megaparsec.Char.Lexer qualified as LP import Text.Megaparsec.Error qualified as EP +import Text.Megaparsec.Internal qualified as PI import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name +import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment (docSegment) import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude @@ -55,13 +54,51 @@ import Unison.ShortHash qualified as SH import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) import Unison.Syntax.Lexer import Unison.Syntax.Lexer.Token (posP, tokenP) -import Unison.Syntax.Name qualified as Name (isSymboly, toText, unsafeParseText) +import Unison.Syntax.Name qualified as Name (isSymboly, nameP, toText, unsafeParseText) +import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..), wordyP) import Unison.Syntax.Parser.Doc qualified as Doc import Unison.Syntax.Parser.Doc.Data qualified as Doc import Unison.Syntax.ReservedWords (delimiters, typeModifiers, typeOrAbility) +import Unison.Syntax.ShortHash qualified as ShortHash (shortHashP) import Unison.Util.Bytes qualified as Bytes import Unison.Util.Monoid (intercalateMap) +type BlockName = String + +type Layout = [(BlockName, Column)] + +data ParsingEnv = ParsingEnv + { -- | layout stack + layout :: !Layout, + -- | `Just b` if a block of type `b` is being opened + opening :: Maybe BlockName, + -- | are we inside a construct that uses layout? + inLayout :: Bool + } + deriving (Show) + +type P = P.ParsecT (Token Err) String (S.State ParsingEnv) + +data Err + = ReservedWordyId String + | InvalidSymbolyId String + | ReservedSymbolyId String + | InvalidShortHash String + | InvalidBytesLiteral String + | InvalidHexLiteral + | InvalidOctalLiteral + | Both Err Err + | MissingFractional String -- ex `1.` rather than `1.04` + | MissingExponent String -- ex `1e` rather than `1e3` + | UnknownLexeme + | TextLiteralMissingClosingQuote String + | InvalidEscapeCharacter Char + | LayoutError + | CloseWithoutMatchingOpen String String -- open, close + | UnexpectedDelimiter String + | UnexpectedTokens String -- Catch-all for all other lexer errors, representing some unexpected tokens. + deriving stock (Eq, Ord, Show) -- richer algebra + -- Design principle: -- `[Lexeme]` should be sufficient information for parsing without -- further knowledge of spacing or indentation levels @@ -80,11 +117,20 @@ data Lexeme | Bytes Bytes.Bytes -- bytes literals | Hash ShortHash -- hash literals | Err Err - | Doc (Doc.UntitledSection (Doc.Tree [Token Lexeme])) + | Doc (Doc.UntitledSection (Doc.Tree (HQ'.HashQualified Name) [Token Lexeme])) deriving stock (Eq, Show, Ord) type IsVirtual = Bool -- is it a virtual semi or an actual semi? +-- Committed failure +err :: (P.TraversableStream s, P.MonadParsec (Token Err) s m) => Pos -> Err -> m x +err start t = do + stop <- posP + -- This consumes a character and therefore produces committed failure, + -- so `err s t <|> p2` won't try `p2` + _ <- void P.anySingle <|> P.eof + P.customFailure (Token t start stop) + token :: P Lexeme -> P [Token Lexeme] token = token' (\a start end -> [Token a start end]) @@ -230,7 +276,7 @@ lexer scope rem = (P.EndOfInput) -> "end of input" customErrs es = [Err <$> e | P.ErrorCustom e <- toList es] toPos (P.SourcePos _ line col) = Pos (P.unPos line) (P.unPos col) - env0 = ParsingEnv [] (Just scope) True [0] 0 + env0 = ParsingEnv [] (Just scope) True -- | hacky postprocessing pass to do some cleanup of stuff that's annoying to -- fix without adding more state to the lexer: @@ -306,14 +352,9 @@ doc2 = do env0 <- S.get -- Disable layout while parsing the doc block and reset the section number (docTok, closeTok) <- local - ( \env -> - env - { inLayout = False, - parentSections = 0 : (parentSections env0) - } - ) + (\env -> env {inLayout = False}) do - body <- Doc.untitledSection . Doc.sectionElem lexemes' . P.lookAhead $ () <$ lit "}}" + body <- Doc.doc identifierP lexemes' . P.lookAhead $ () <$ lit "}}" closeStart <- posP lit "}}" closeEnd <- posP @@ -674,6 +715,27 @@ tok p = do token <- tokenP p pure [token] +-- An identifier is a non-empty dot-delimited list of segments, with an optional leading dot, where each segment is +-- symboly (comprised of only symbols) or wordy (comprised of only alphanums). +-- +-- Examples: +-- +-- foo +-- .foo.++.doc +-- `.`.`..` (This is a two-segment identifier without a leading dot: "." then "..") +identifierP :: (Monad m) => P.ParsecT (Token Err) String m (HQ'.HashQualified Name) +identifierP = do + P.label "identifier (ex: abba1, snake_case, .foo.bar#xyz, .foo.++#xyz, or 🌻)" do + name <- PI.withParsecT (fmap nameSegmentParseErrToErr) Name.nameP + P.optional shortHashP <&> \case + Nothing -> HQ'.fromName name + Just shorthash -> HQ'.HashQualified name shorthash + where + nameSegmentParseErrToErr :: NameSegment.ParseErr -> Err + nameSegmentParseErrToErr = \case + NameSegment.ReservedOperator s -> ReservedSymbolyId (Text.unpack s) + NameSegment.ReservedWord s -> ReservedWordyId (Text.unpack s) + -- An identifier is a non-empty dot-delimited list of segments, with an optional leading dot, where each segment is -- symboly (comprised of only symbols) or wordy (comprised of only alphanums). -- @@ -691,6 +753,14 @@ identifierLexeme name = then SymbolyId name else WordyId name +wordyIdSegP :: P.ParsecT (Token Err) String m NameSegment +wordyIdSegP = + PI.withParsecT (fmap (ReservedWordyId . Text.unpack)) NameSegment.wordyP + +shortHashP :: P.ParsecT (Token Err) String m ShortHash +shortHashP = + PI.withParsecT (fmap (InvalidShortHash . Text.unpack)) ShortHash.shortHashP + blockDelimiter :: [String] -> P String -> P [Token Lexeme] blockDelimiter open closeP = do Token close pos1 pos2 <- tokenP closeP @@ -739,6 +809,11 @@ top :: Layout -> Column top [] = 1 top ((_, h) : _) = h +-- todo: make Layout a NonEmpty +topBlockName :: Layout -> Maybe BlockName +topBlockName [] = Nothing +topBlockName ((name, _) : _) = Just name + topLeftCorner :: Pos topLeftCorner = Pos 1 1 @@ -855,6 +930,10 @@ showEscapeChar :: Char -> Maybe Char showEscapeChar c = Map.lookup c (Map.fromList [(x, y) | (y, x) <- escapeChars]) +typeModifiersAlt :: (Alternative f) => (Text -> f a) -> f a +typeModifiersAlt f = + asum $ map f (toList typeModifiers) + debugFilePreParse :: FilePath -> IO () debugFilePreParse file = putStrLn . debugPreParse . preParse . lexer file . Text.unpack =<< readUtf8 file @@ -877,6 +956,18 @@ debugPreParse ts = show $ payload <$> ts debugPreParse' :: String -> String debugPreParse' = debugPreParse . preParse . lexer "debugPreParse" +instance EP.ShowErrorComponent (Token Err) where + showErrorComponent (Token err _ _) = go err + where + go = \case + UnexpectedTokens msg -> msg + CloseWithoutMatchingOpen open close -> "I found a closing " <> close <> " but no matching " <> open <> "." + Both e1 e2 -> go e1 <> "\n" <> go e2 + LayoutError -> "Indentation error" + TextLiteralMissingClosingQuote s -> "This text literal missing a closing quote: " <> excerpt s + e -> show e + excerpt s = if length s < 15 then s else take 15 s <> "..." + instance P.VisualStream [Token Lexeme] where showTokens _ xs = join . Nel.toList . S.evalState (traverse go xs) . end $ Nel.head xs diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 098caab1b6..fac55142de 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -401,7 +401,7 @@ string = queryToken getString getString (L.Textual s) = Just (Text.pack s) getString _ = Nothing -doc :: (Ord v) => P v m (L.Token (Doc.UntitledSection (Doc.Tree [L.Token L.Lexeme]))) +doc :: (Ord v) => P v m (L.Token (Doc.UntitledSection (Doc.Tree (HQ'.HashQualified Name) [L.Token L.Lexeme]))) doc = queryToken \case L.Doc d -> pure d _ -> Nothing diff --git a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs index 99122bd5ff..4009c30dec 100644 --- a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs +++ b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs @@ -1,5 +1,17 @@ +-- | The parser for Unison’s @Doc@ syntax. +-- +-- This is completely independent of the Unison language, and requires a couple parsers to be passed in to then +-- provide a parser for @Doc@ applied to any host language. +-- +-- - an identifer parser +-- - a code parser (that accepts a termination parser) +-- - a termination parser (only used for lookahead), for this parser to know when to give up +-- +-- Each of those parsers is expected to satisfy @(`Ord` e, `P.MonadParsec` e `String` m)@. module Unison.Syntax.Parser.Doc ( Tree, + initialState, + doc, untitledSection, sectionElem, leaf, @@ -55,10 +67,7 @@ import Text.Megaparsec.Char.Lexer qualified as LP import Unison.Parser.Ann (Ann, Annotated (..)) import Unison.Prelude hiding (join) import Unison.Syntax.Lexer - ( P, - ParsingEnv (..), - column, - identifierP, + ( column, line, lit, local, @@ -73,28 +82,58 @@ import Unison.Syntax.Lexer import Unison.Syntax.Lexer.Token (Token (Token), posP, tokenP) import Unison.Syntax.Parser.Doc.Data -type Tree code = Cofree (Top code) Ann +type Tree ident code = Cofree (Top ident code) Ann + +data ParsingEnv = ParsingEnv + { -- | Use a stack to remember the parent section and allow docSections within docSections. + -- - 1 means we are inside a # Heading 1 + parentSections :: [Int], + -- | 4 means we are inside a list starting at the fourth column + parentListColumn :: Int + } + deriving (Show) + +initialState :: ParsingEnv +initialState = ParsingEnv [0] 0 + +doc :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + m (UntitledSection (Tree ident code)) +doc ident code = flip S.evalStateT initialState . untitledSection . sectionElem ident code -- | This is the actual `Doc` lexer. Unlike `doc2`, it doesn’t do any Unison-side lexing (i.e., it doesn’t know that -- Unison wraps `Doc` literals in `}}`). -untitledSection :: P a -> P (UntitledSection a) +untitledSection :: (P.MonadParsec e String m) => m a -> m (UntitledSection a) untitledSection a = UntitledSection <$> P.many (a <* CP.space) -wordyKw :: String -> P String +wordyKw :: (P.MonadParsec e String m) => String -> m String wordyKw kw = separated wordySep (lit kw) -sectionElem :: (Annotated code) => (P () -> P code) -> P () -> P (Tree code) -sectionElem code docClose = +sectionElem :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + S.StateT ParsingEnv m (Tree ident code) +sectionElem ident code docClose = fmap wrap' $ - section code docClose - <|> P.label "block eval (syntax: a fenced code block)" (eval code <|> exampleBlock code <|> codeBlock) - <|> list code docClose - <|> paragraph code docClose - -paragraph :: (Annotated code) => (P () -> P code) -> P () -> P (Top code (Tree code)) -paragraph code = fmap Paragraph . spaced . leafy code - -word :: P end -> P (Leaf code void) + section ident code docClose + <|> lift (P.label "block eval (syntax: a fenced code block)" (eval code <|> exampleBlock code <|> codeBlock)) + <|> list ident code docClose + <|> lift (paragraph ident code docClose) + +paragraph :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + m (Top ident code (Tree ident code)) +paragraph ident code = fmap Paragraph . spaced . leafy ident code + +word :: (Ord e, P.MonadParsec e String m) => m end -> m (Leaf ident code void) word closing = fmap Word . tokenP . P.try $ do let end = P.lookAhead $ void (P.satisfy isSpace) <|> void closing word <- P.manyTill (P.satisfy (\ch -> not (isSpace ch))) end @@ -103,43 +142,56 @@ word closing = fmap Word . tokenP . P.try $ do where reserved word = List.isPrefixOf "}}" word || all (== '#') word -leaf :: (Annotated code) => (P () -> P code) -> P () -> P (Leaf code (Tree code)) -leaf code closing = - do - link - <|> namedLink code closing - <|> example code - <|> transclude code - <|> bold code closing - <|> italic code closing - <|> strikethrough code closing +leaf :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + m (Leaf ident code (Tree ident code)) +leaf ident code closing = + link ident + <|> namedLink ident code closing + <|> example code + <|> transclude code + <|> bold ident code closing + <|> italic ident code closing + <|> strikethrough ident code closing <|> verbatim - <|> source code - <|> foldedSource code + <|> source ident code + <|> foldedSource ident code <|> evalInline code - <|> signatures - <|> signatureInline + <|> signatures ident + <|> signatureInline ident <|> word closing -leafy :: (Annotated code) => (P () -> P code) -> P () -> P (Leaf code (Tree code)) -leafy code closing = do - p <- leaf code closing - after <- P.optional . P.try $ leafy code closing +leafy :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + m (Leaf ident code (Tree ident code)) +leafy ident code closing = do + p <- leaf ident code closing + after <- P.optional . P.try $ leafy ident code closing case after of Nothing -> pure p Just after -> group . pure $ p :| pure after -comma :: P String +comma :: (P.MonadParsec e String m) => m String comma = lit "," <* CP.space -source :: (P () -> P code) -> P (Leaf code a) -source = fmap Source . (lit "@source" *>) . sourceElements +source :: (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m (Leaf ident code a) +source ident = fmap Source . (lit "@source" *>) . sourceElements ident -foldedSource :: (P () -> P code) -> P (Leaf code a) -foldedSource = fmap FoldedSource . (lit "@foldedSource" *>) . sourceElements +foldedSource :: (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m (Leaf ident code a) +foldedSource ident = fmap FoldedSource . (lit "@foldedSource" *>) . sourceElements ident -sourceElements :: (P () -> P code) -> P (NonEmpty (SourceElement (Leaf code Void))) -sourceElements code = do +sourceElements :: + (Ord e, P.MonadParsec e String m) => + m ident -> + (m () -> m code) -> + m (NonEmpty (SourceElement ident (Leaf ident code Void))) +sourceElements ident code = do _ <- (lit " {" <|> lit "{") *> CP.space s <- sepBy1' srcElem comma _ <- lit "}" @@ -147,49 +199,48 @@ sourceElements code = do where srcElem = SourceElement - <$> embedLink + <$> embedLink ident <*> ( fmap (fromMaybe []) . P.optional $ (lit "@") *> (CP.space *> annotations) ) where - annotation = fmap Left (tokenP identifierP) <|> fmap Right (transclude code) <* CP.space - annotations = - P.some (EmbedAnnotation <$> annotation) + annotation = fmap Left (tokenP ident) <|> fmap Right (transclude code) <* CP.space + annotations = P.some (EmbedAnnotation <$> annotation) -signatures :: P (Leaf code a) -signatures = fmap Signature $ do +signatures :: (Ord e, P.MonadParsec e String m) => m ident -> m (Leaf ident code a) +signatures ident = fmap Signature $ do _ <- (lit "@signatures" <|> lit "@signature") *> (lit " {" <|> lit "{") *> CP.space - s <- sepBy1' embedSignatureLink comma + s <- sepBy1' (embedSignatureLink ident) comma _ <- lit "}" pure s -signatureInline :: P (Leaf code a) -signatureInline = fmap SignatureInline $ do +signatureInline :: (Ord e, P.MonadParsec e String m) => m ident -> m (Leaf ident code a) +signatureInline ident = fmap SignatureInline $ do _ <- lit "@inlineSignature" *> (lit " {" <|> lit "{") *> CP.space - s <- embedSignatureLink + s <- embedSignatureLink ident _ <- lit "}" pure s -evalInline :: (P () -> P a1) -> P (Leaf a1 a2) +evalInline :: (P.MonadParsec e String m) => (m () -> m code) -> m (Leaf ident code a) evalInline code = fmap EvalInline $ do _ <- lit "@eval" *> (lit " {" <|> lit "{") *> CP.space let inlineEvalClose = void $ lit "}" s <- code inlineEvalClose pure s -embedTypeLink :: P EmbedLink -embedTypeLink = +embedTypeLink :: (Ord e, P.MonadParsec e String m) => m ident -> m (EmbedLink ident) +embedTypeLink ident = EmbedTypeLink <$> do _ <- typeOrAbilityAlt (wordyKw . Text.unpack) <* CP.space - tokenP identifierP <* CP.space + tokenP ident <* CP.space -embedTermLink :: P EmbedLink -embedTermLink = EmbedTermLink <$> tokenP identifierP <* CP.space +embedTermLink :: (Ord e, P.MonadParsec e String m) => m ident -> m (EmbedLink ident) +embedTermLink ident = EmbedTermLink <$> tokenP ident <* CP.space -embedSignatureLink :: P EmbedSignatureLink -embedSignatureLink = EmbedSignatureLink <$> tokenP identifierP <* CP.space +embedSignatureLink :: (Ord e, P.MonadParsec e String m) => m ident -> m (EmbedSignatureLink ident) +embedSignatureLink ident = EmbedSignatureLink <$> tokenP ident <* CP.space -verbatim :: P (Leaf code a) +verbatim :: (Ord e, P.MonadParsec e String m) => m (Leaf ident code a) verbatim = P.label "code (examples: ''**unformatted**'', `words` or '''_words_''')" $ do Token originalText start stop <- tokenP do @@ -199,21 +250,17 @@ verbatim = quotes <- tick <|> (lit "''" <+> P.takeWhileP Nothing (== '\'')) P.someTill P.anySingle (lit quotes) let isMultiLine = line start /= line stop - if isMultiLine - then do - let trimmed = (trimAroundDelimiters originalText) - let txt = trimIndentFromVerbatimBlock (column start - 1) trimmed - -- If it's a multi-line verbatim block we trim any whitespace representing - -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' - pure . Verbatim $ - Word $ - Token txt start stop - else - pure . Code $ - Word $ - Token originalText start stop - -example :: (P () -> P code) -> P (Leaf code void) + pure + if isMultiLine + then + let trimmed = (trimAroundDelimiters originalText) + txt = trimIndentFromVerbatimBlock (column start - 1) trimmed + in -- If it's a multi-line verbatim block we trim any whitespace representing + -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' + Verbatim . Word $ Token txt start stop + else Code . Word $ Token originalText start stop + +example :: (P.MonadParsec e String m) => (m () -> m code) -> m (Leaf ident code void) example code = P.label "inline code (examples: ``List.map f xs``, ``[1] :+ 2``)" $ fmap Example $ do @@ -223,20 +270,20 @@ example code = let end = void . lit $ replicate (n + 1) '`' CP.space *> code end -link :: P (Leaf a b) -link = P.label "link (examples: {type List}, {Nat.+})" $ Link <$> P.try (lit "{" *> embedLink <* lit "}") +link :: (Ord e, P.MonadParsec e String m) => m ident -> m (Leaf ident code a) +link ident = P.label "link (examples: {type List}, {Nat.+})" $ Link <$> P.try (lit "{" *> embedLink ident <* lit "}") -transclude :: (P () -> P code) -> P (Leaf code x) +transclude :: (P.MonadParsec e String m) => (m () -> m code) -> m (Leaf ident code a) transclude code = fmap Transclude . P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ lit "{{" *> code (void $ lit "}}") -nonNewlineSpaces :: P String +nonNewlineSpaces :: (P.MonadParsec e String m) => m String nonNewlineSpaces = P.takeWhileP Nothing nonNewlineSpace where nonNewlineSpace ch = isSpace ch && ch /= '\n' && ch /= '\r' -eval :: (Annotated code) => (P () -> P code) -> P (Top code (Tree code)) +eval :: (P.MonadParsec e String m, Annotated code) => (m () -> m code) -> m (Top ident code (Tree ident code)) eval code = Eval <$> do -- commit after seeing that ``` is on its own line @@ -246,7 +293,7 @@ eval code = fence <$ guard b CP.space *> code (void $ lit fence) -exampleBlock :: (Annotated code) => (P () -> P code) -> P (Top code (Tree code)) +exampleBlock :: (P.MonadParsec e String m, Annotated code) => (m () -> m code) -> m (Top ident code (Tree ident code)) exampleBlock code = ExampleBlock <$> do @@ -254,7 +301,7 @@ exampleBlock code = fence <- lit "```" <+> P.takeWhileP Nothing (== '`') code . void $ lit fence -codeBlock :: P (Top code (Tree code)) +codeBlock :: (Ord e, P.MonadParsec e String m) => m (Top ident code (Tree ident code)) codeBlock = do column <- (\x -> x - 1) . toInteger . P.unPos <$> LP.indentLevel let tabWidth = toInteger . P.unPos $ P.defaultTabWidth @@ -280,8 +327,14 @@ codeBlock = do skip _ s = s in List.intercalate "\n" $ skip column <$> lines s -emphasis :: (Annotated code) => Char -> (P () -> P code) -> P () -> P (Tree code) -emphasis delimiter code closing = do +emphasis :: + (Ord e, P.MonadParsec e String m, Annotated code) => + Char -> + m ident -> + (m () -> m code) -> + m () -> + m (Tree ident code) +emphasis delimiter ident code closing = do let start = some (P.satisfy (== delimiter)) end <- P.try $ do end <- start @@ -289,38 +342,57 @@ emphasis delimiter code closing = do pure end wrap' . Paragraph <$> someTill' - (leafy code (closing <|> (void $ lit end)) <* void whitespaceWithoutParagraphBreak) + (leafy ident code (closing <|> (void $ lit end)) <* void whitespaceWithoutParagraphBreak) (lit end) where - -- Allows whitespace or a newline, but not more than two newlines in a row. - whitespaceWithoutParagraphBreak :: P () + -- Allows whitespace including up to one newline whitespaceWithoutParagraphBreak = void do void nonNewlineSpaces optional newline >>= \case Just _ -> void nonNewlineSpaces Nothing -> pure () -bold :: (Annotated code) => (P () -> P code) -> P () -> P (Leaf code (Tree code)) -bold code = fmap Bold . emphasis '*' code - -italic :: (Annotated code) => (P () -> P code) -> P () -> P (Leaf code (Tree code)) -italic code = fmap Italic . emphasis '_' code - -strikethrough :: (Annotated code) => (P () -> P code) -> P () -> P (Leaf code (Tree code)) -strikethrough code = fmap Strikethrough . emphasis '~' code - -namedLink :: (Annotated code) => (P () -> P code) -> P () -> P (Leaf code (Tree code)) -namedLink code docClose = +bold :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + m (Leaf ident code (Tree ident code)) +bold ident code = fmap Bold . emphasis '*' ident code + +italic :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + m (Leaf ident code (Tree ident code)) +italic ident code = fmap Italic . emphasis '_' ident code + +strikethrough :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + m (Leaf ident code (Tree ident code)) +strikethrough ident code = fmap Strikethrough . emphasis '~' ident code + +namedLink :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + m (Leaf ident code (Tree ident code)) +namedLink ident code docClose = P.label "hyperlink (example: [link name](https://destination.com))" do _ <- lit "[" - p <- spaced . leafy code . void $ char ']' + p <- spaced . leafy ident code . void $ char ']' _ <- lit "]" _ <- lit "(" - target <- group $ fmap pure link <|> some' (transclude code <|> word (docClose <|> void (char ')'))) + target <- group $ fmap pure (link ident) <|> some' (transclude code <|> word (docClose <|> void (char ')'))) _ <- lit ")" pure $ NamedLink (wrap' $ Paragraph p) target -sp :: P String +sp :: (P.MonadParsec e String m) => m String sp = P.try $ do spaces <- P.takeWhile1P (Just "space") isSpace close <- P.optional (P.lookAhead (lit "}}")) @@ -331,17 +403,22 @@ sp = P.try $ do where ok s = length [() | '\n' <- s] < 2 -spaced :: P a -> P (NonEmpty a) +spaced :: (P.MonadParsec e String m) => m a -> m (NonEmpty a) spaced p = some' (p <* P.optional sp) -- | Not an actual node, but this pattern is referenced in multiple places -list :: (Annotated code) => (P () -> P code) -> P () -> P (Top code (Tree code)) -list code docClose = bulletedList code docClose <|> numberedList code docClose - -listSep :: P () +list :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + S.StateT ParsingEnv m (Top ident code (Tree ident code)) +list ident code docClose = bulletedList ident code docClose <|> numberedList ident code docClose + +listSep :: (Ord e, S.MonadState ParsingEnv m, P.MonadParsec e String m) => m () listSep = P.try $ newline *> nonNewlineSpaces *> P.lookAhead (void bulletedStart <|> void numberedStart) -bulletedStart :: P (Int, [a]) +bulletedStart :: (Ord e, S.MonadState ParsingEnv m, P.MonadParsec e String m) => m (Int, [a]) bulletedStart = P.try $ do r <- listItemStart $ [] <$ P.satisfy bulletChar P.lookAhead (P.satisfy isSpace) @@ -349,43 +426,59 @@ bulletedStart = P.try $ do where bulletChar ch = ch == '*' || ch == '-' || ch == '+' -listItemStart :: P a -> P (Int, a) -listItemStart gutter = P.try $ do +listItemStart :: (Ord e, S.MonadState ParsingEnv m, P.MonadParsec e String m) => m a -> m (Int, a) +listItemStart gutter = P.try do nonNewlineSpaces col <- column <$> posP parentCol <- S.gets parentListColumn guard (col > parentCol) (col,) <$> gutter -numberedStart :: P (Int, Token Word64) +numberedStart :: (Ord e, S.MonadState ParsingEnv m, P.MonadParsec e String m) => m (Int, Token Word64) numberedStart = listItemStart $ P.try (tokenP $ LP.decimal <* lit ".") -- | FIXME: This should take a @`P` a@ -numberedList :: (Annotated code) => (P () -> P code) -> P () -> P (Top code (Tree code)) -numberedList code docClose = NumberedList <$> sepBy1' numberedItem listSep +numberedList :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + S.StateT ParsingEnv m (Top ident code (Tree ident code)) +numberedList ident code docClose = NumberedList <$> sepBy1' numberedItem listSep where numberedItem = P.label "numbered list (examples: 1. item1, 8. start numbering at '8')" do (col, s) <- numberedStart - (s,) <$> column' code docClose col + (s,) <$> column' ident code docClose col -- | FIXME: This should take a @`P` a@ -bulletedList :: (Annotated code) => (P () -> P code) -> P () -> P (Top code (Tree code)) -bulletedList code docClose = BulletedList <$> sepBy1' bullet listSep +bulletedList :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + S.StateT ParsingEnv m (Top ident code (Tree ident code)) +bulletedList ident code docClose = BulletedList <$> sepBy1' bullet listSep where bullet = P.label "bullet (examples: * item1, - item2)" do (col, _) <- bulletedStart - column' code docClose col - -column' :: (Annotated code) => (P () -> P code) -> P () -> Int -> P (Column (Tree code)) -column' code docClose col = + column' ident code docClose col + +column' :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + Int -> + S.StateT ParsingEnv m (Column (Tree ident code)) +column' ident code docClose col = Column . wrap' <$> (nonNewlineSpaces *> listItemParagraph) - <*> local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> fmap wrap' (list code docClose)) + <*> local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> fmap wrap' (list ident code docClose)) where listItemParagraph = Paragraph <$> do col <- column <$> posP - some' (leafy code docClose <* sep col) + some' (lift (leafy ident code docClose) <* sep col) where -- Trickiness here to support hard line breaks inside of -- a bulleted list, so for instance this parses as expected: @@ -406,7 +499,7 @@ column' code docClose col = (P.notFollowedBy $ void numberedStart <|> void bulletedStart) pure () -newline :: P String +newline :: (P.MonadParsec e String m) => m String newline = P.label "newline" $ lit "\n" <|> lit "\r\n" -- | @@ -421,32 +514,37 @@ newline = P.label "newline" $ lit "\n" <|> lit "\r\n" -- > A paragraph under this subsection. -- > -- > # A section title (not a subsection) -section :: (Annotated code) => (P () -> P code) -> P () -> P (Top code (Tree code)) -section code docClose = do +section :: + (Ord e, P.MonadParsec e String m, Annotated code) => + m ident -> + (m () -> m code) -> + m () -> + S.StateT ParsingEnv m (Top ident code (Tree ident code)) +section ident code docClose = do ns <- S.gets parentSections hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp - title <- paragraph code docClose <* CP.space + title <- lift $ paragraph ident code docClose <* CP.space let m = length hashes + head ns body <- local (\env -> env {parentSections = (m : (tail ns))}) $ - P.many (sectionElem code docClose <* CP.space) + P.many (sectionElem ident code docClose <* CP.space) pure $ Section (wrap' title) body -- | Not an actual node, but this pattern is referenced in multiple places -embedLink :: P EmbedLink -embedLink = embedTypeLink <|> embedTermLink +embedLink :: (Ord e, P.MonadParsec e String m) => m ident -> m (EmbedLink ident) +embedLink ident = embedTypeLink ident <|> embedTermLink ident -- | FIXME: This should just take a @`P` code@ and @`P` a@. -group :: P (NonEmpty (Leaf code a)) -> P (Leaf code a) +group :: (P.MonadParsec e s m) => m (NonEmpty (Leaf ident code a)) -> m (Leaf ident code a) group = fmap Group . join -- | FIXME: This should just take a @`P` a@ -join :: P (NonEmpty a) -> P (Join a) +join :: (P.MonadParsec e s m) => m (NonEmpty a) -> m (Join a) join = fmap Join -- * utility functions -wrap' :: (Annotated code) => Top code (Tree code) -> Tree code +wrap' :: (Annotated code) => Top ident code (Tree ident code) -> Tree ident code wrap' doc = ann doc :< doc -- | If it's a multi-line verbatim block we trim any whitespace representing diff --git a/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs b/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs index 5167b2bcf6..56a14939b6 100644 --- a/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs +++ b/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs @@ -1,7 +1,11 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- | Haskell parallel to @unison/base.Doc@. -- +-- These types have two significant parameters: @ident@ and @code@ that are expected to be parameterized by some +-- representation of identifiers and source code of the host language. +-- -- This is much more restricted than @unison/base.Doc@, but it covers everything we can parse from Haskell. The -- mismatch with Unison is a problem, as someone can create a Unison Doc with explicit constructors or function calls, -- have it rendered to a scratch file, and then we can’t parse it. Changing the types here to match Unison wouldn’t @@ -13,8 +17,6 @@ import Data.Eq.Deriving (deriveEq1, deriveEq2) import Data.List.NonEmpty (NonEmpty) import Data.Ord.Deriving (deriveOrd1, deriveOrd2) import Text.Show.Deriving (deriveShow1, deriveShow2) -import Unison.HashQualifiedPrime qualified as HQ' -import Unison.Name (Name) import Unison.Parser.Ann (Annotated (..)) import Unison.Prelude import Unison.Syntax.Lexer.Token (Token (..)) @@ -22,7 +24,7 @@ import Unison.Syntax.Lexer.Token (Token (..)) newtype UntitledSection a = UntitledSection [a] deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -data Top code a +data Top ident code a = -- | The first argument is always a `Paragraph` Section a [a] | Eval code @@ -30,7 +32,7 @@ data Top code a | CodeBlock (Token String) (Token String) | BulletedList (NonEmpty (Column a)) | NumberedList (NonEmpty (Token Word64, Column a)) - | Paragraph (NonEmpty (Leaf code a)) + | Paragraph (NonEmpty (Leaf ident code a)) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) data Column a @@ -38,11 +40,11 @@ data Column a Column a (Maybe a) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -data Leaf code a - = Link EmbedLink +data Leaf ident code a + = Link (EmbedLink ident) | -- | first is a Paragraph, second is always a Group (which contains either a single Term/Type link or list of -- `Transclude`s & `Word`s) - NamedLink a (Leaf code Void) + NamedLink a (Leaf ident code Void) | Example code | Transclude code | -- | Always a Paragraph @@ -52,21 +54,21 @@ data Leaf code a | -- | Always a Paragraph Strikethrough a | -- | Always a Word - Verbatim (Leaf Void Void) + Verbatim (Leaf ident Void Void) | -- | Always a Word - Code (Leaf Void Void) + Code (Leaf ident Void Void) | -- | Always a Transclude - Source (NonEmpty (SourceElement (Leaf code Void))) + Source (NonEmpty (SourceElement ident (Leaf ident code Void))) | -- | Always a Transclude - FoldedSource (NonEmpty (SourceElement (Leaf code Void))) + FoldedSource (NonEmpty (SourceElement ident (Leaf ident code Void))) | EvalInline code - | Signature (NonEmpty EmbedSignatureLink) - | SignatureInline EmbedSignatureLink + | Signature (NonEmpty (EmbedSignatureLink ident)) + | SignatureInline (EmbedSignatureLink ident) | Word (Token String) - | Group (Join (Leaf code a)) + | Group (Join (Leaf ident code a)) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -instance Bifunctor Leaf where +instance Bifunctor (Leaf ident) where bimap f g = \case Link x -> Link x NamedLink a leaf -> NamedLink (g a) $ first f leaf @@ -85,25 +87,25 @@ instance Bifunctor Leaf where Word x -> Word x Group join -> Group $ bimap f g <$> join -data EmbedLink - = EmbedTypeLink (Token (HQ'.HashQualified Name)) - | EmbedTermLink (Token (HQ'.HashQualified Name)) +data EmbedLink ident + = EmbedTypeLink (Token ident) + | EmbedTermLink (Token ident) deriving (Eq, Ord, Show) -data SourceElement a = SourceElement EmbedLink [EmbedAnnotation a] +data SourceElement ident a = SourceElement (EmbedLink ident) [EmbedAnnotation ident a] deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -newtype EmbedSignatureLink = EmbedSignatureLink (Token (HQ'.HashQualified Name)) +newtype EmbedSignatureLink ident = EmbedSignatureLink (Token ident) deriving (Eq, Ord, Show) newtype Join a = Join (NonEmpty a) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -newtype EmbedAnnotation a - = EmbedAnnotation (Either (Token (HQ'.HashQualified Name)) a) +newtype EmbedAnnotation ident a + = EmbedAnnotation (Either (Token ident) a) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -instance (Annotated code, Annotated a) => Annotated (Top code a) where +instance (Annotated code, Annotated a) => Annotated (Top ident code a) where ann = \case Section title body -> ann title <> ann body Eval code -> ann code @@ -116,7 +118,7 @@ instance (Annotated code, Annotated a) => Annotated (Top code a) where instance (Annotated a) => Annotated (Column a) where ann (Column para list) = ann para <> ann list -instance (Annotated code, Annotated a) => Annotated (Leaf code a) where +instance (Annotated code, Annotated a) => Annotated (Leaf ident code a) where ann = \case Link link -> ann link NamedLink label target -> ann label <> ann target @@ -135,31 +137,45 @@ instance (Annotated code, Annotated a) => Annotated (Leaf code a) where Word text -> ann text Group (Join leaves) -> ann leaves -instance Annotated EmbedLink where +instance Annotated (EmbedLink ident) where ann = \case EmbedTypeLink name -> ann name EmbedTermLink name -> ann name -instance (Annotated code) => Annotated (SourceElement code) where +instance (Annotated code) => Annotated (SourceElement ident code) where ann (SourceElement link target) = ann link <> ann target -instance Annotated EmbedSignatureLink where +instance Annotated (EmbedSignatureLink ident) where ann (EmbedSignatureLink name) = ann name -instance (Annotated code) => Annotated (EmbedAnnotation code) where +instance (Annotated code) => Annotated (EmbedAnnotation ident code) where ann (EmbedAnnotation a) = either ann ann a $(deriveEq1 ''Column) $(deriveOrd1 ''Column) $(deriveShow1 ''Column) +$(deriveEq1 ''Token) +$(deriveOrd1 ''Token) +$(deriveShow1 ''Token) + $(deriveEq1 ''EmbedAnnotation) $(deriveOrd1 ''EmbedAnnotation) $(deriveShow1 ''EmbedAnnotation) +$(deriveEq2 ''EmbedAnnotation) +$(deriveOrd2 ''EmbedAnnotation) +$(deriveShow2 ''EmbedAnnotation) + +$(deriveEq1 ''EmbedLink) +$(deriveOrd1 ''EmbedLink) +$(deriveShow1 ''EmbedLink) $(deriveEq1 ''SourceElement) $(deriveOrd1 ''SourceElement) $(deriveShow1 ''SourceElement) +$(deriveEq2 ''SourceElement) +$(deriveOrd2 ''SourceElement) +$(deriveShow2 ''SourceElement) $(deriveEq1 ''Join) $(deriveOrd1 ''Join) From 9a941a389079373465ecdd6b6baad8936f3561b1 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 26 Jul 2024 23:53:49 -0600 Subject: [PATCH 520/631] Caught a hardcoded `}}` in the Doc parser MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The Doc parser shouldn’t know how Unison terminates Doc blocks. --- unison-syntax/src/Unison/Syntax/Parser/Doc.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs index 4009c30dec..cecf2ca6a2 100644 --- a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs +++ b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs @@ -131,7 +131,7 @@ paragraph :: (m () -> m code) -> m () -> m (Top ident code (Tree ident code)) -paragraph ident code = fmap Paragraph . spaced . leafy ident code +paragraph ident code docClose = fmap Paragraph . spaced docClose $ leafy ident code docClose word :: (Ord e, P.MonadParsec e String m) => m end -> m (Leaf ident code void) word closing = fmap Word . tokenP . P.try $ do @@ -385,17 +385,17 @@ namedLink :: namedLink ident code docClose = P.label "hyperlink (example: [link name](https://destination.com))" do _ <- lit "[" - p <- spaced . leafy ident code . void $ char ']' + p <- spaced docClose . leafy ident code . void $ char ']' _ <- lit "]" _ <- lit "(" target <- group $ fmap pure (link ident) <|> some' (transclude code <|> word (docClose <|> void (char ')'))) _ <- lit ")" pure $ NamedLink (wrap' $ Paragraph p) target -sp :: (P.MonadParsec e String m) => m String -sp = P.try $ do +sp :: (P.MonadParsec e String m) => m () -> m String +sp docClose = P.try $ do spaces <- P.takeWhile1P (Just "space") isSpace - close <- P.optional (P.lookAhead (lit "}}")) + close <- P.optional (P.lookAhead docClose) case close of Nothing -> guard $ ok spaces Just _ -> pure () @@ -403,8 +403,8 @@ sp = P.try $ do where ok s = length [() | '\n' <- s] < 2 -spaced :: (P.MonadParsec e String m) => m a -> m (NonEmpty a) -spaced p = some' (p <* P.optional sp) +spaced :: (P.MonadParsec e String m) => m () -> m a -> m (NonEmpty a) +spaced docClose p = some' $ p <* P.optional (sp docClose) -- | Not an actual node, but this pattern is referenced in multiple places list :: @@ -522,7 +522,7 @@ section :: S.StateT ParsingEnv m (Top ident code (Tree ident code)) section ident code docClose = do ns <- S.gets parentSections - hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp + hashes <- lift $ P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp docClose title <- lift $ paragraph ident code docClose <* CP.space let m = length hashes + head ns body <- From beecaa9be715f2090b01577e12b2e541a60404b6 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Fri, 26 Jul 2024 23:54:54 -0600 Subject: [PATCH 521/631] Make Doc parser ignorant of type/term distinctions This was the last thing tying Doc to Unison. --- parser-typechecker/src/Unison/PrintError.hs | 8 ++++ .../src/Unison/Syntax/TermParser.hs | 43 +++++++++++++------ .../src/Unison/Syntax/Lexer/Unison.hs | 12 ++++-- unison-syntax/src/Unison/Syntax/Parser.hs | 6 ++- unison-syntax/src/Unison/Syntax/Parser/Doc.hs | 36 +++------------- .../src/Unison/Syntax/Parser/Doc/Data.hs | 10 ++--- 6 files changed, 59 insertions(+), 56 deletions(-) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index dd796c0159..691d7cd3ef 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -1861,6 +1861,14 @@ renderParseErrors s = \case <> structuralVsUniqueDocsLink ] in (msg, rangeForToken <$> [void keyword, void name]) + go (Parser.TypeNotAllowed tok) = + let msg = + Pr.lines + [ Pr.wrap "I expected to see a term here, but instead it’s a type:", + "", + tokenAsErrorSite s $ HQ.toText <$> tok + ] + in (msg, [rangeForToken tok]) unknownConstructor :: String -> L.Token (HashQualified Name) -> Pretty ColorText diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 8d0195410a..642ed0e339 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -27,6 +27,7 @@ import Data.Text qualified as Text import Data.Tuple.Extra qualified as TupleE import Data.Void (absurd, vacuous) import Text.Megaparsec qualified as P +import U.Codebase.Reference (ReferenceType (..)) import U.Core.ABT qualified as ABT import Unison.ABT qualified as ABT import Unison.Builtin.Decls qualified as DD @@ -530,7 +531,7 @@ doc2Block = do docUntitledSection ann (Doc.UntitledSection tops) = Term.app ann (f ann "UntitledSection") $ Term.list (gann tops) tops - docTop :: Doc.Top (HQ'.HashQualified Name) [L.Token L.Lexeme] (Term v Ann) -> TermP v m + docTop :: Doc.Top (ReferenceType, HQ'.HashQualified Name) [L.Token L.Lexeme] (Term v Ann) -> TermP v m docTop d = case d of Doc.Section title body -> pure $ Term.apps' (f d "Section") [title, Term.list (gann body) body] Doc.Eval code -> @@ -558,7 +559,7 @@ doc2Block = do docColumn d@(Doc.Column para sublist) = Term.app (gann d) (f d "Column") . Term.list (gann d) $ para : toList sublist - docLeaf :: Doc.Leaf (HQ'.HashQualified Name) [L.Token L.Lexeme] (Term v Ann) -> TermP v m + docLeaf :: Doc.Leaf (ReferenceType, HQ'.HashQualified Name) [L.Token L.Lexeme] (Term v Ann) -> TermP v m docLeaf d = case d of Doc.Link link -> Term.app (gann d) (f d "Link") <$> docEmbedLink link Doc.NamedLink para target -> Term.apps' (f d "NamedLink") . (para :) . pure <$> docLeaf (vacuous target) @@ -590,35 +591,49 @@ doc2Block = do Term.app (gann d) (f d "Group") . Term.app (gann d) (f d "Join") . Term.list (ann leaves) . toList <$> traverse docLeaf leaves - docEmbedLink :: Doc.EmbedLink (HQ'.HashQualified Name) -> TermP v m - docEmbedLink d = case d of - Doc.EmbedTypeLink ident -> + docEmbedLink :: Doc.EmbedLink (ReferenceType, HQ'.HashQualified Name) -> TermP v m + docEmbedLink d@(Doc.EmbedLink (L.Token (level, ident) start end)) = case level of + RtType -> Term.app (gann d) (f d "EmbedTypeLink") . Term.typeLink (ann d) . L.payload - <$> findUniqueType (HQ'.toHQ <$> ident) - Doc.EmbedTermLink ident -> - Term.app (gann d) (f d "EmbedTermLink") . addDelay <$> resolveHashQualified (HQ'.toHQ <$> ident) + <$> findUniqueType (L.Token (HQ'.toHQ ident) start end) + RtTerm -> + Term.app (gann d) (f d "EmbedTermLink") . addDelay <$> resolveHashQualified (L.Token (HQ'.toHQ ident) start end) docSourceElement :: - Doc.SourceElement (HQ'.HashQualified Name) (Doc.Leaf (HQ'.HashQualified Name) [L.Token L.Lexeme] Void) -> + Doc.SourceElement + (ReferenceType, HQ'.HashQualified Name) + (Doc.Leaf (ReferenceType, HQ'.HashQualified Name) [L.Token L.Lexeme] Void) -> TermP v m docSourceElement d@(Doc.SourceElement link anns) = do link' <- docEmbedLink link anns' <- traverse docEmbedAnnotation anns pure $ Term.apps' (f d "SourceElement") [link', Term.list (ann anns) anns'] - docEmbedSignatureLink :: Doc.EmbedSignatureLink (HQ'.HashQualified Name) -> TermP v m - docEmbedSignatureLink d@(Doc.EmbedSignatureLink ident) = - Term.app (gann d) (f d "EmbedSignatureLink") . addDelay <$> resolveHashQualified (HQ'.toHQ <$> ident) + docEmbedSignatureLink :: Doc.EmbedSignatureLink (ReferenceType, HQ'.HashQualified Name) -> TermP v m + docEmbedSignatureLink d@(Doc.EmbedSignatureLink (L.Token (level, ident) start end)) = case level of + RtType -> P.customFailure . TypeNotAllowed $ L.Token (HQ'.toHQ ident) start end + RtTerm -> + Term.app (gann d) (f d "EmbedSignatureLink") . addDelay + <$> resolveHashQualified (L.Token (HQ'.toHQ ident) start end) docEmbedAnnotation :: - Doc.EmbedAnnotation (HQ'.HashQualified Name) (Doc.Leaf (HQ'.HashQualified Name) [L.Token L.Lexeme] Void) -> + Doc.EmbedAnnotation + (ReferenceType, HQ'.HashQualified Name) + (Doc.Leaf (ReferenceType, HQ'.HashQualified Name) [L.Token L.Lexeme] Void) -> TermP v m docEmbedAnnotation d@(Doc.EmbedAnnotation a) = -- This is the only place I’m not sure we’re doing the right thing. In the lexer, this can be an identifier or a -- DocLeaf, but here it could be either /text/ or a Doc element. And I don’t think there’s any way the lexemes -- produced for an identifier and the lexemes consumed for text line up. So, I think this is a bugfix I can’t -- avoid. - Term.app (gann d) (f d "EmbedAnnotation") <$> either (resolveHashQualified . fmap HQ'.toHQ) (docLeaf . vacuous) a + Term.app (gann d) (f d "EmbedAnnotation") + <$> either + ( \(L.Token (level, ident) start end) -> case level of + RtType -> P.customFailure . TypeNotAllowed $ L.Token (HQ'.toHQ ident) start end + RtTerm -> resolveHashQualified $ L.Token (HQ'.toHQ ident) start end + ) + (docLeaf . vacuous) + a docBlock :: (Monad m, Var v) => TermP v m docBlock = do diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs index 98112c2124..8a6c20d1a8 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -42,6 +42,7 @@ import Text.Megaparsec.Char qualified as CP import Text.Megaparsec.Char.Lexer qualified as LP import Text.Megaparsec.Error qualified as EP import Text.Megaparsec.Internal qualified as PI +import U.Codebase.Reference (ReferenceType (..)) import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name @@ -117,7 +118,7 @@ data Lexeme | Bytes Bytes.Bytes -- bytes literals | Hash ShortHash -- hash literals | Err Err - | Doc (Doc.UntitledSection (Doc.Tree (HQ'.HashQualified Name) [Token Lexeme])) + | Doc (Doc.UntitledSection (Doc.Tree (ReferenceType, HQ'.HashQualified Name) [Token Lexeme])) deriving stock (Eq, Show, Ord) type IsVirtual = Bool -- is it a virtual semi or an actual semi? @@ -354,7 +355,7 @@ doc2 = do (docTok, closeTok) <- local (\env -> env {inLayout = False}) do - body <- Doc.doc identifierP lexemes' . P.lookAhead $ () <$ lit "}}" + body <- Doc.doc typeOrTerm lexemes' . P.lookAhead $ () <$ lit "}}" closeStart <- posP lit "}}" closeEnd <- posP @@ -382,12 +383,15 @@ doc2 = do isTopLevel = length (layout env0) + maybe 0 (const 1) (opening env0) == 1 _ -> docTok : endToks where - -- DUPLICATED wordyKw kw = separated wordySep (lit kw) + typeOrAbility' = typeOrAbilityAlt (wordyKw . Text.unpack) + typeOrTerm = do + mtype <- P.optional $ typeOrAbility' <* CP.space + ident <- identifierP <* CP.space + pure (maybe RtTerm (const RtType) mtype, ident) subsequentTypeName = P.lookAhead . P.optional $ do let lit' s = lit s <* sp let modifier = typeModifiersAlt (lit' . Text.unpack) - let typeOrAbility' = typeOrAbilityAlt (wordyKw . Text.unpack) _ <- optional modifier *> typeOrAbility' *> sp Token name start stop <- tokenP identifierP if Name.isSymboly (HQ'.toName name) diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index fac55142de..6c4aa74b95 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -72,6 +72,7 @@ import Data.Set qualified as Set import Data.Text qualified as Text import Text.Megaparsec (runParserT) import Text.Megaparsec qualified as P +import U.Codebase.Reference (ReferenceType (..)) import U.Util.Base32Hex qualified as Base32Hex import Unison.ABT qualified as ABT import Unison.ConstructorReference (ConstructorReference) @@ -170,6 +171,8 @@ data Error v | TypeDeclarationErrors [UF.Error v Ann] | -- | MissingTypeModifier (type|ability) name MissingTypeModifier (L.Token String) (L.Token v) + | -- | A type was found in a position that requires a term + TypeNotAllowed (L.Token (HQ.HashQualified Name)) | ResolutionFailures [Names.ResolutionFailure v Ann] | DuplicateTypeNames [(v, [Ann])] | DuplicateTermNames [(v, [Ann])] @@ -401,7 +404,8 @@ string = queryToken getString getString (L.Textual s) = Just (Text.pack s) getString _ = Nothing -doc :: (Ord v) => P v m (L.Token (Doc.UntitledSection (Doc.Tree (HQ'.HashQualified Name) [L.Token L.Lexeme]))) +doc :: + (Ord v) => P v m (L.Token (Doc.UntitledSection (Doc.Tree (ReferenceType, HQ'.HashQualified Name) [L.Token L.Lexeme]))) doc = queryToken \case L.Doc d -> pure d _ -> Nothing diff --git a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs index cecf2ca6a2..8ba6840dd2 100644 --- a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs +++ b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs @@ -45,8 +45,7 @@ module Unison.Syntax.Parser.Doc -- * other components column', - embedTypeLink, - embedTermLink, + embedLink, embedSignatureLink, join, ) @@ -59,26 +58,13 @@ import Data.List qualified as List import Data.List.Extra qualified as List import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as NonEmpty -import Data.Text qualified as Text import Text.Megaparsec qualified as P import Text.Megaparsec.Char (char) import Text.Megaparsec.Char qualified as CP import Text.Megaparsec.Char.Lexer qualified as LP import Unison.Parser.Ann (Ann, Annotated (..)) import Unison.Prelude hiding (join) -import Unison.Syntax.Lexer - ( column, - line, - lit, - local, - sepBy1', - separated, - some', - someTill', - typeOrAbilityAlt, - wordySep, - (<+>), - ) +import Unison.Syntax.Lexer (column, line, lit, local, sepBy1', some', someTill', (<+>)) import Unison.Syntax.Lexer.Token (Token (Token), posP, tokenP) import Unison.Syntax.Parser.Doc.Data @@ -109,9 +95,6 @@ doc ident code = flip S.evalStateT initialState . untitledSection . sectionElem untitledSection :: (P.MonadParsec e String m) => m a -> m (UntitledSection a) untitledSection a = UntitledSection <$> P.many (a <* CP.space) -wordyKw :: (P.MonadParsec e String m) => String -> m String -wordyKw kw = separated wordySep (lit kw) - sectionElem :: (Ord e, P.MonadParsec e String m, Annotated code) => m ident -> @@ -228,14 +211,9 @@ evalInline code = fmap EvalInline $ do s <- code inlineEvalClose pure s -embedTypeLink :: (Ord e, P.MonadParsec e String m) => m ident -> m (EmbedLink ident) -embedTypeLink ident = - EmbedTypeLink <$> do - _ <- typeOrAbilityAlt (wordyKw . Text.unpack) <* CP.space - tokenP ident <* CP.space - -embedTermLink :: (Ord e, P.MonadParsec e String m) => m ident -> m (EmbedLink ident) -embedTermLink ident = EmbedTermLink <$> tokenP ident <* CP.space +-- | Not an actual node, but this pattern is referenced in multiple places +embedLink :: (Ord e, P.MonadParsec e s m, P.TraversableStream s) => m ident -> m (EmbedLink ident) +embedLink = fmap EmbedLink . tokenP embedSignatureLink :: (Ord e, P.MonadParsec e String m) => m ident -> m (EmbedSignatureLink ident) embedSignatureLink ident = EmbedSignatureLink <$> tokenP ident <* CP.space @@ -530,10 +508,6 @@ section ident code docClose = do P.many (sectionElem ident code docClose <* CP.space) pure $ Section (wrap' title) body --- | Not an actual node, but this pattern is referenced in multiple places -embedLink :: (Ord e, P.MonadParsec e String m) => m ident -> m (EmbedLink ident) -embedLink ident = embedTypeLink ident <|> embedTermLink ident - -- | FIXME: This should just take a @`P` code@ and @`P` a@. group :: (P.MonadParsec e s m) => m (NonEmpty (Leaf ident code a)) -> m (Leaf ident code a) group = fmap Group . join diff --git a/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs b/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs index 56a14939b6..75bc3a621e 100644 --- a/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs +++ b/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs @@ -87,9 +87,9 @@ instance Bifunctor (Leaf ident) where Word x -> Word x Group join -> Group $ bimap f g <$> join -data EmbedLink ident - = EmbedTypeLink (Token ident) - | EmbedTermLink (Token ident) +-- | This is a deviation from the Unison Doc data model – in Unison, Doc distinguishes between type and term links, but +-- here Doc knows nothing about what namespaces may exist. +data EmbedLink ident = EmbedLink (Token ident) deriving (Eq, Ord, Show) data SourceElement ident a = SourceElement (EmbedLink ident) [EmbedAnnotation ident a] @@ -138,9 +138,7 @@ instance (Annotated code, Annotated a) => Annotated (Leaf ident code a) where Group (Join leaves) -> ann leaves instance Annotated (EmbedLink ident) where - ann = \case - EmbedTypeLink name -> ann name - EmbedTermLink name -> ann name + ann (EmbedLink name) = ann name instance (Annotated code) => Annotated (SourceElement ident code) where ann (SourceElement link target) = ann link <> ann target From 43bfa09e43791ef97e12c25891b6d7b4d2881639 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 29 Jul 2024 13:25:52 -0400 Subject: [PATCH 522/631] make a Unison.Merge module that re-exports most of the merge API --- .../Codebase/Editor/HandleInput/Merge2.hs | 189 ++++++++---------- .../Codebase/Editor/HandleInput/Update2.hs | 4 +- unison-merge/src/Unison/Merge.hs | 65 ++++++ .../src/Unison/Merge/DeclCoherencyCheck.hs | 20 +- unison-merge/src/Unison/Merge/Diff.hs | 12 +- unison-merge/unison-merge.cabal | 1 + 6 files changed, 171 insertions(+), 120 deletions(-) create mode 100644 unison-merge/src/Unison/Merge.hs diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 6696c21831..85f830db06 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -71,29 +71,14 @@ import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration import Unison.Debug qualified as Debug import Unison.Hash qualified as Hash -import Unison.Merge.CombineDiffs (CombinedDiffOp (..), combineDiffs) +import Unison.Merge qualified as Merge import Unison.Merge.Database (MergeDatabase (..), makeMergeDatabase, referent2to1) -import Unison.Merge.DeclCoherencyCheck (checkDeclCoherency, lenientCheckDeclCoherency) -import Unison.Merge.DeclNameLookup (DeclNameLookup (..), expectConstructorNames) -import Unison.Merge.Diff qualified as Merge -import Unison.Merge.DiffOp (DiffOp (..)) -import Unison.Merge.EitherWay (EitherWay (..)) -import Unison.Merge.EitherWayI (EitherWayI (..)) +import Unison.Merge.DeclNameLookup (expectConstructorNames) import Unison.Merge.EitherWayI qualified as EitherWayI -import Unison.Merge.Libdeps qualified as Merge -import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) -import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs) -import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.Synhashed qualified as Synhashed -import Unison.Merge.ThreeWay (ThreeWay (..)) import Unison.Merge.ThreeWay qualified as ThreeWay -import Unison.Merge.TwoOrThreeWay (TwoOrThreeWay (..)) -import Unison.Merge.TwoWay (TwoWay (..)) import Unison.Merge.TwoWay qualified as TwoWay -import Unison.Merge.TwoWayI qualified as TwoWayI -import Unison.Merge.Unconflicts (Unconflicts (..)) import Unison.Merge.Unconflicts qualified as Unconflicts -import Unison.Merge.Updated (Updated (..)) import Unison.Name (Name) import Unison.NameSegment qualified as NameSegment import Unison.NameSegment.Internal (NameSegment (NameSegment)) @@ -158,7 +143,7 @@ handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do let bobProjectAndBranch = ProjectAndBranch bobProject bobProjectBranch doMergeLocalBranch - TwoWay + Merge.TwoWay { alice = aliceProjectAndBranch, bob = bobProjectAndBranch } @@ -218,7 +203,7 @@ doMerge info = do causals <- Cli.runTransaction do traverse Operations.expectCausalBranchByCausalHash - TwoOrThreeWay + Merge.TwoOrThreeWay { alice = info.alice.causalHash, bob = info.bob.causalHash, lca = info.lca.causalHash @@ -232,7 +217,7 @@ doMerge info = do alice <- causals.alice.value bob <- causals.bob.value lca <- for causals.lca \causal -> causal.value - pure TwoOrThreeWay {lca, alice, bob} + pure Merge.TwoOrThreeWay {lca, alice, bob} -- Assert that neither Alice nor Bob have defns in lib for_ [(mergeTarget, branches.alice), (mergeSource, branches.bob)] \(who, branch) -> do @@ -246,21 +231,21 @@ doMerge info = do Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) & onLeftM (done . Output.ConflictedDefn "merge") let load = \case - Nothing -> pure (emptyNametree, DeclNameLookup Map.empty Map.empty) + Nothing -> pure (emptyNametree, Merge.DeclNameLookup Map.empty Map.empty) Just (who, branch) -> do defns <- loadDefns branch declNameLookup <- - Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) + Cli.runTransaction (Merge.oldCheckDeclCoherency db.loadDeclNumConstructors defns) & onLeftM (done . Output.IncoherentDeclDuringMerge who) pure (defns, declNameLookup) (aliceDefns0, aliceDeclNameLookup) <- load (Just (mergeTarget, branches.alice)) (bobDefns0, bobDeclNameLookup) <- load (Just (mergeSource, branches.bob)) lcaDefns0 <- maybe (pure emptyNametree) loadDefns branches.lca - lcaDeclNameLookup <- Cli.runTransaction (lenientCheckDeclCoherency db.loadDeclNumConstructors lcaDefns0) + lcaDeclNameLookup <- Cli.runTransaction (Merge.oldLenientCheckDeclCoherency db.loadDeclNumConstructors lcaDefns0) - let defns3 = flattenNametrees <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} - let declNameLookups = TwoWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup} + let defns3 = flattenNametrees <$> Merge.ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} + let declNameLookups = Merge.TwoWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup} pure (defns3, declNameLookups, lcaDeclNameLookup) @@ -269,23 +254,23 @@ doMerge info = do liftIO (debugFunctions.debugDefns defns3 declNameLookups lcaDeclNameLookup) -- Diff LCA->Alice and LCA->Bob - diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns3) + diffs <- Cli.runTransaction (Merge.oldNameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns3) liftIO (debugFunctions.debugDiffs diffs) -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias - for_ ((,) <$> TwoWay mergeTarget mergeSource <*> diffs) \(who, diff) -> + for_ ((,) <$> Merge.TwoWay mergeTarget mergeSource <*> diffs) \(who, diff) -> whenJust (findConflictedAlias defns3.lca diff) \(name1, name2) -> done (Output.MergeConflictedAliases who name1 name2) -- Combine the LCA->Alice and LCA->Bob diffs together - let diff = combineDiffs diffs + let diff = Merge.combineDiffs diffs liftIO (debugFunctions.debugCombinedDiff diff) -- Partition the combined diff into the conflicted things and the unconflicted things (conflicts, unconflicts) <- - partitionCombinedDiffs defns declNameLookups diff & onLeft \name -> + Merge.partitionCombinedDiffs defns declNameLookups diff & onLeft \name -> done (Output.MergeConflictInvolvingBuiltin name) liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts) @@ -314,7 +299,7 @@ doMerge info = do libdepsToBranch0 db (Merge.mergeLibdeps getTwoFreshNames libdeps) -- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names - let mkPpes :: TwoWay Names -> Names -> TwoWay PrettyPrintEnvDecl + let mkPpes :: Merge.TwoWay Names -> Names -> Merge.TwoWay PrettyPrintEnvDecl mkPpes defnsNames libdepsNames = defnsNames <&> \names -> PPED.makePPED (PPE.namer (names <> libdepsNames)) suffixifier where @@ -339,7 +324,7 @@ doMerge info = do let prettyUnisonFile = makePrettyUnisonFile - TwoWay + Merge.TwoWay { alice = into @Text aliceBranchNames, bob = case info.bob.source of @@ -398,7 +383,7 @@ doMerge info = do Cli.respond finalOutput -doMergeLocalBranch :: TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () +doMergeLocalBranch :: Merge.TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () doMergeLocalBranch branches = do (aliceCausalHash, bobCausalHash, lcaCausalHash) <- Cli.runTransaction do @@ -432,8 +417,8 @@ doMergeLocalBranch branches = do -- Loading basic info out of the database loadLibdeps :: - TwoOrThreeWay (V2.Branch Transaction) -> - Transaction (ThreeWay (Map NameSegment (V2.CausalBranch Transaction))) + Merge.TwoOrThreeWay (V2.Branch Transaction) -> + Transaction (Merge.ThreeWay (Map NameSegment (V2.CausalBranch Transaction))) loadLibdeps branches = do lca <- case branches.lca of @@ -441,7 +426,7 @@ loadLibdeps branches = do Just lcaBranch -> load lcaBranch alice <- load branches.alice bob <- load branches.bob - pure ThreeWay {lca, alice, bob} + pure Merge.ThreeWay {lca, alice, bob} where load :: V2.Branch Transaction -> Transaction (Map NameSegment (V2.CausalBranch Transaction)) load branch = @@ -466,9 +451,9 @@ hasDefnsInLib branch = do -- Creating Unison files makePrettyUnisonFile :: - TwoWay Text -> - TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> - TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> + Merge.TwoWay Text -> + Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> + Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> Pretty ColorText makePrettyUnisonFile authors conflicts dependents = fold @@ -546,7 +531,7 @@ makePrettyUnisonFile authors conflicts dependents = -- terms = { "foo", "Maybe.Nothing", "Maybe.Just" } -- types = { "Maybe" } -- } -refIdsToNames :: DeclNameLookup -> DefnsF (Map Name) term typ -> DefnsF Set Name Name +refIdsToNames :: Merge.DeclNameLookup -> DefnsF (Map Name) term typ -> DefnsF Set Name Name refIdsToNames declNameLookup = bifoldMap goTerms goTypes where @@ -610,25 +595,25 @@ nametreeToBranch0 nametree = -- FIXME: let's come up with a better term for "dependencies" in the implementation of this function identifyDependents :: - TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> - DefnsF Unconflicts Referent TypeReference -> - Transaction (TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId)) + Merge.TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> + Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> + DefnsF Merge.Unconflicts Referent TypeReference -> + Transaction (Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId)) identifyDependents defns conflicts unconflicts = do let -- The other person's (i.e. with "Alice" and "Bob" swapped) solo-deleted and solo-updated names - theirSoloUpdatesAndDeletes :: TwoWay (DefnsF Set Name Name) + theirSoloUpdatesAndDeletes :: Merge.TwoWay (DefnsF Set Name Name) theirSoloUpdatesAndDeletes = TwoWay.swap (unconflictedSoloDeletedNames <> unconflictedSoloUpdatedNames) where - unconflictedSoloDeletedNames :: TwoWay (DefnsF Set Name Name) + unconflictedSoloDeletedNames :: Merge.TwoWay (DefnsF Set Name Name) unconflictedSoloDeletedNames = bitraverse Unconflicts.soloDeletedNames Unconflicts.soloDeletedNames unconflicts - unconflictedSoloUpdatedNames :: TwoWay (DefnsF Set Name Name) + unconflictedSoloUpdatedNames :: Merge.TwoWay (DefnsF Set Name Name) unconflictedSoloUpdatedNames = bitraverse Unconflicts.soloUpdatedNames Unconflicts.soloUpdatedNames unconflicts - let dependencies :: TwoWay (Set Reference) + let dependencies :: Merge.TwoWay (Set Reference) dependencies = fold [ -- One source of dependencies: Alice's versions of Bob's unconflicted deletes and updates, and vice-versa. @@ -668,7 +653,7 @@ identifyDependents defns conflicts unconflicts = do -- 1. It is Alice-conflicted (since we only want to return *unconflicted* things). -- 2. It was deleted by Bob. -- 3. It was updated by Bob and not updated by Alice. - let dependents1 :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) + let dependents1 :: Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) dependents1 = zipDefnsWith Map.withoutKeys Map.withoutKeys <$> dependents0 @@ -689,7 +674,7 @@ identifyDependents defns conflicts unconflicts = do -- -- { alice = { terms = {"foo" => #alice} } } -- { bob = { terms = {} } } - let dependents2 :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) + let dependents2 :: Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) dependents2 = dependents1 & over #bob \bob -> zipDefnsWith Map.difference Map.difference bob dependents1.alice @@ -697,20 +682,20 @@ identifyDependents defns conflicts unconflicts = do pure dependents2 makeStageOne :: - TwoWay DeclNameLookup -> - TwoWay (DefnsF (Map Name) termid typeid) -> - DefnsF Unconflicts term typ -> - TwoWay (DefnsF (Map Name) termid typeid) -> + Merge.TwoWay Merge.DeclNameLookup -> + Merge.TwoWay (DefnsF (Map Name) termid typeid) -> + DefnsF Merge.Unconflicts term typ -> + Merge.TwoWay (DefnsF (Map Name) termid typeid) -> DefnsF (Map Name) term typ -> DefnsF (Map Name) term typ makeStageOne declNameLookups conflicts unconflicts dependents = zipDefnsWith3 makeStageOneV makeStageOneV unconflicts (f conflicts <> f dependents) where - f :: TwoWay (DefnsF (Map Name) term typ) -> DefnsF Set Name Name + f :: Merge.TwoWay (DefnsF (Map Name) term typ) -> DefnsF Set Name Name f defns = fold (refIdsToNames <$> declNameLookups <*> defns) -makeStageOneV :: Unconflicts v -> Set Name -> Map Name v -> Map Name v +makeStageOneV :: Merge.Unconflicts v -> Set Name -> Map Name v -> Map Name v makeStageOneV unconflicts namesToDelete = (`Map.withoutKeys` namesToDelete) . Unconflicts.apply unconflicts @@ -786,33 +771,33 @@ findTemporaryBranchName projectId mergeSourceAndTarget = do findConflictedAlias :: (Ord term, Ord typ) => Defns (BiMultimap term Name) (BiMultimap typ Name) -> - DefnsF3 (Map Name) DiffOp Synhashed term typ -> + DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed term typ -> Maybe (Name, Name) findConflictedAlias defns diff = asum [go defns.terms diff.terms, go defns.types diff.types] where - go :: forall ref. (Ord ref) => BiMultimap ref Name -> Map Name (DiffOp (Synhashed ref)) -> Maybe (Name, Name) + go :: forall ref. (Ord ref) => BiMultimap ref Name -> Map Name (Merge.DiffOp (Merge.Synhashed ref)) -> Maybe (Name, Name) go namespace diff = asum (map f (Map.toList diff)) where - f :: (Name, DiffOp (Synhashed ref)) -> Maybe (Name, Name) + f :: (Name, Merge.DiffOp (Merge.Synhashed ref)) -> Maybe (Name, Name) f (name, op) = case op of - DiffOp'Add _ -> Nothing - DiffOp'Delete _ -> Nothing - DiffOp'Update hashed1 -> + Merge.DiffOp'Add _ -> Nothing + Merge.DiffOp'Delete _ -> Nothing + Merge.DiffOp'Update hashed1 -> BiMultimap.lookupPreimage name namespace & Set.delete name & Set.toList & map (g hashed1.new) & asum where - g :: Synhashed ref -> Name -> Maybe (Name, Name) + g :: Merge.Synhashed ref -> Name -> Maybe (Name, Name) g hashed1 alias = case Map.lookup alias diff of - Just (DiffOp'Update hashed2) | hashed1 == hashed2.new -> Nothing + Just (Merge.DiffOp'Update hashed2) | hashed1 == hashed2.new -> Nothing -- If "foo" was updated but its alias "bar" was deleted, that's ok - Just (DiffOp'Delete _) -> Nothing + Just (Merge.DiffOp'Delete _) -> Nothing _ -> Just (name, alias) -- Given a name like "base", try "base__1", then "base__2", etc, until we find a name that doesn't @@ -904,19 +889,19 @@ typecheckedUnisonFileToBranchAdds tuf = do -- Debugging by printing a bunch of stuff out data DebugFunctions = DebugFunctions - { debugCausals :: TwoOrThreeWay (V2.CausalBranch Transaction) -> IO (), + { debugCausals :: Merge.TwoOrThreeWay (V2.CausalBranch Transaction) -> IO (), debugDefns :: - ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - TwoWay DeclNameLookup -> - PartialDeclNameLookup -> + Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> + Merge.TwoWay Merge.DeclNameLookup -> + Merge.PartialDeclNameLookup -> IO (), - debugDiffs :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) -> IO (), - debugCombinedDiff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> IO (), + debugDiffs :: Merge.TwoWay (DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference) -> IO (), + debugCombinedDiff :: DefnsF2 (Map Name) Merge.CombinedDiffOp Referent TypeReference -> IO (), debugPartitionedDiff :: - TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> - DefnsF Unconflicts Referent TypeReference -> + Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> + DefnsF Merge.Unconflicts Referent TypeReference -> IO (), - debugDependents :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> IO (), + debugDependents :: Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> IO (), debugStageOne :: DefnsF (Map Name) Referent TypeReference -> IO () } @@ -936,7 +921,7 @@ fakeDebugFunctions :: DebugFunctions fakeDebugFunctions = DebugFunctions mempty mempty mempty mempty mempty mempty mempty -realDebugCausals :: TwoOrThreeWay (V2.CausalBranch Transaction) -> IO () +realDebugCausals :: Merge.TwoOrThreeWay (V2.CausalBranch Transaction) -> IO () realDebugCausals causals = do Text.putStrLn (Text.bold "\n=== Alice causal hash ===") Text.putStrLn (Hash.toBase32HexText (unCausalHash causals.alice.causalHash)) @@ -948,9 +933,9 @@ realDebugCausals causals = do Just causal -> "Just " <> Hash.toBase32HexText (unCausalHash causal.causalHash) realDebugDefns :: - ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - TwoWay DeclNameLookup -> - PartialDeclNameLookup -> + Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> + Merge.TwoWay Merge.DeclNameLookup -> + Merge.PartialDeclNameLookup -> IO () realDebugDefns defns declNameLookups _lcaDeclNameLookup = do Text.putStrLn (Text.bold "\n=== Alice definitions ===") @@ -965,19 +950,19 @@ realDebugDefns defns declNameLookups _lcaDeclNameLookup = do Text.putStrLn (Text.bold "\n=== Bob constructor names ===") debugConstructorNames declNameLookups.bob.declToConstructors -realDebugDiffs :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) -> IO () +realDebugDiffs :: Merge.TwoWay (DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference) -> IO () realDebugDiffs diffs = do Text.putStrLn (Text.bold "\n=== LCA→Alice diff ===") renderDiff diffs.alice Text.putStrLn (Text.bold "\n=== LCA→Bob diff ===") renderDiff diffs.bob where - renderDiff :: DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference -> IO () + renderDiff :: DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference -> IO () renderDiff diff = do renderThings referentLabel diff.terms renderThings (const "type") diff.types - renderThings :: (ref -> Text) -> Map Name (DiffOp (Synhashed ref)) -> IO () + renderThings :: (ref -> Text) -> Map Name (Merge.DiffOp (Merge.Synhashed ref)) -> IO () renderThings label things = for_ (Map.toList things) \(name, op) -> let go color action x = @@ -990,21 +975,21 @@ realDebugDiffs diffs = do <> " #" <> Hash.toBase32HexText (Synhashed.hash x) in Text.putStrLn case op of - DiffOp'Add x -> go Text.green "+" x - DiffOp'Delete x -> go Text.red "-" x - DiffOp'Update x -> go Text.yellow "%" x.new + Merge.DiffOp'Add x -> go Text.green "+" x + Merge.DiffOp'Delete x -> go Text.red "-" x + Merge.DiffOp'Update x -> go Text.yellow "%" x.new -realDebugCombinedDiff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> IO () +realDebugCombinedDiff :: DefnsF2 (Map Name) Merge.CombinedDiffOp Referent TypeReference -> IO () realDebugCombinedDiff diff = do Text.putStrLn (Text.bold "\n=== Combined diff ===") renderThings referentLabel Referent.toText diff.terms renderThings (const "type") Reference.toText diff.types where - renderThings :: (ref -> Text) -> (ref -> Text) -> Map Name (CombinedDiffOp ref) -> IO () + renderThings :: (ref -> Text) -> (ref -> Text) -> Map Name (Merge.CombinedDiffOp ref) -> IO () renderThings label renderRef things = for_ (Map.toList things) \(name, op) -> Text.putStrLn case op of - CombinedDiffOp'Add who -> + Merge.CombinedDiffOp'Add who -> Text.green $ "+ " <> Text.italic (label (EitherWayI.value who)) @@ -1015,7 +1000,7 @@ realDebugCombinedDiff diff = do <> " (" <> renderWho who <> ")" - CombinedDiffOp'Delete who -> + Merge.CombinedDiffOp'Delete who -> Text.red $ "- " <> Text.italic (label (EitherWayI.value who)) @@ -1026,7 +1011,7 @@ realDebugCombinedDiff diff = do <> " (" <> renderWho who <> ")" - CombinedDiffOp'Update who -> + Merge.CombinedDiffOp'Update who -> Text.yellow $ "% " <> Text.italic (label (EitherWayI.value who).new) @@ -1037,7 +1022,7 @@ realDebugCombinedDiff diff = do <> " (" <> renderWho who <> ")" - CombinedDiffOp'Conflict ref -> + Merge.CombinedDiffOp'Conflict ref -> Text.magenta $ "! " <> Text.italic (label ref.alice) @@ -1050,24 +1035,24 @@ realDebugCombinedDiff diff = do <> "/" <> renderRef ref.bob - renderWho :: EitherWayI v -> Text + renderWho :: Merge.EitherWayI v -> Text renderWho = \case - OnlyAlice _ -> "Alice" - OnlyBob _ -> "Bob" - AliceAndBob _ -> "Alice and Bob" + Merge.OnlyAlice _ -> "Alice" + Merge.OnlyBob _ -> "Bob" + Merge.AliceAndBob _ -> "Alice and Bob" realDebugPartitionedDiff :: - TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> - DefnsF Unconflicts Referent TypeReference -> + Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> + DefnsF Merge.Unconflicts Referent TypeReference -> IO () realDebugPartitionedDiff conflicts unconflicts = do Text.putStrLn (Text.bold "\n=== Alice conflicts ===") - renderConflicts "termid" conflicts.alice.terms (Alice ()) - renderConflicts "typeid" conflicts.alice.types (Alice ()) + renderConflicts "termid" conflicts.alice.terms (Merge.Alice ()) + renderConflicts "typeid" conflicts.alice.types (Merge.Alice ()) Text.putStrLn (Text.bold "\n=== Bob conflicts ===") - renderConflicts "termid" conflicts.bob.terms (Bob ()) - renderConflicts "typeid" conflicts.bob.types (Bob ()) + renderConflicts "termid" conflicts.bob.terms (Merge.Bob ()) + renderConflicts "typeid" conflicts.bob.types (Merge.Bob ()) Text.putStrLn (Text.bold "\n=== Alice unconflicts ===") renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.alice @@ -1093,7 +1078,7 @@ realDebugPartitionedDiff conflicts unconflicts = do renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.both renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.both where - renderConflicts :: Text -> Map Name Reference.Id -> EitherWay () -> IO () + renderConflicts :: Text -> Map Name Reference.Id -> Merge.EitherWay () -> IO () renderConflicts label conflicts who = for_ (Map.toList conflicts) \(name, ref) -> Text.putStrLn $ @@ -1105,7 +1090,7 @@ realDebugPartitionedDiff conflicts unconflicts = do <> " " <> Reference.idToText ref <> " (" - <> (case who of Alice () -> "Alice"; Bob () -> "Bob") + <> (case who of Merge.Alice () -> "Alice"; Merge.Bob () -> "Bob") <> ")" renderUnconflicts :: @@ -1127,7 +1112,7 @@ realDebugPartitionedDiff conflicts unconflicts = do <> " " <> renderRef ref -realDebugDependents :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> IO () +realDebugDependents :: Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> IO () realDebugDependents dependents = do Text.putStrLn (Text.bold "\n=== Alice dependents of Bob deletes, Bob updates, and Alice conflicts ===") renderThings "termid" dependents.alice.terms diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 858003c431..cfa3d73c33 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -38,7 +38,7 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.SqliteCodebase.Operations qualified as Operations import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as Decl -import Unison.Merge.DeclCoherencyCheck (checkDeclCoherency) +import Unison.Merge.DeclCoherencyCheck (oldCheckDeclCoherency) import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) import Unison.Name (Name) import Unison.Names (Names) @@ -84,7 +84,7 @@ handleUpdate2 = do -- Assert that the namespace doesn't have any incoherent decls declNameLookup <- - Cli.runTransaction (checkDeclCoherency Operations.expectDeclNumConstructors defns) + Cli.runTransaction (oldCheckDeclCoherency Operations.expectDeclNumConstructors defns) & onLeftM (Cli.returnEarly . Output.IncoherentDeclDuringUpdate) Cli.respond Output.UpdateLookingForDependents diff --git a/unison-merge/src/Unison/Merge.hs b/unison-merge/src/Unison/Merge.hs new file mode 100644 index 0000000000..ef7db6d5f5 --- /dev/null +++ b/unison-merge/src/Unison/Merge.hs @@ -0,0 +1,65 @@ +module Unison.Merge + ( -- * Decl coherency checks + DeclNameLookup (..), + PartialDeclNameLookup (..), + IncoherentDeclReason (..), + oldCheckDeclCoherency, + checkDeclCoherency, + oldLenientCheckDeclCoherency, + lenientCheckDeclCoherency, + IncoherentDeclReasons (..), + checkAllDeclCoherency, + + -- * 3-way namespace diff + DiffOp (..), + oldNameBasedNamespaceDiff, + nameBasedNamespaceDiff, + + -- * Combining namespace diffs + CombinedDiffOp (..), + combineDiffs, + + -- * Partitioning combined namespace diffs + Unconflicts (..), + partitionCombinedDiffs, + + -- * Merging libdeps + mergeLibdeps, + + -- * Utility types + EitherWay (..), + ThreeWay (..), + TwoOrThreeWay (..), + EitherWayI (..), + Synhashed (..), + TwoWay (..), + TwoWayI (..), + Updated (..), + ) +where + +import Unison.Merge.CombineDiffs (CombinedDiffOp (..), combineDiffs) +import Unison.Merge.DeclCoherencyCheck + ( IncoherentDeclReason (..), + IncoherentDeclReasons (..), + checkAllDeclCoherency, + checkDeclCoherency, + lenientCheckDeclCoherency, + oldCheckDeclCoherency, + oldLenientCheckDeclCoherency, + ) +import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) +import Unison.Merge.Diff (nameBasedNamespaceDiff, oldNameBasedNamespaceDiff) +import Unison.Merge.DiffOp (DiffOp (..)) +import Unison.Merge.EitherWay (EitherWay (..)) +import Unison.Merge.EitherWayI (EitherWayI (..)) +import Unison.Merge.Libdeps (mergeLibdeps) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) +import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs) +import Unison.Merge.Synhashed (Synhashed (..)) +import Unison.Merge.ThreeWay (ThreeWay (..)) +import Unison.Merge.TwoOrThreeWay (TwoOrThreeWay (..)) +import Unison.Merge.TwoWay (TwoWay (..)) +import Unison.Merge.TwoWayI (TwoWayI (..)) +import Unison.Merge.Unconflicts (Unconflicts (..)) +import Unison.Merge.Updated (Updated (..)) diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 2160ea5830..02bbf6ec95 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -81,10 +81,10 @@ -- machinery was invented. module Unison.Merge.DeclCoherencyCheck ( IncoherentDeclReason (..), + oldCheckDeclCoherency, checkDeclCoherency, - checkDeclCoherency2, + oldLenientCheckDeclCoherency, lenientCheckDeclCoherency, - lenientCheckDeclCoherency2, -- * Getting all failures rather than just the first IncoherentDeclReasons (..), @@ -137,12 +137,12 @@ data IncoherentDeclReason | IncoherentDeclReason'StrayConstructor !TypeReferenceId !Name deriving stock (Show) -checkDeclCoherency :: +oldCheckDeclCoherency :: (Monad m) => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m (Either IncoherentDeclReason DeclNameLookup) -checkDeclCoherency loadDeclNumConstructors nametree = +oldCheckDeclCoherency loadDeclNumConstructors nametree = Except.runExceptT $ checkDeclCoherencyWith (lift . loadDeclNumConstructors) @@ -154,12 +154,12 @@ checkDeclCoherency loadDeclNumConstructors nametree = } nametree -checkDeclCoherency2 :: +checkDeclCoherency :: (HasCallStack) => Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> Map TypeReferenceId Int -> Either IncoherentDeclReason DeclNameLookup -checkDeclCoherency2 nametree numConstructorsById = +checkDeclCoherency nametree numConstructorsById = checkDeclCoherencyWith (\refId -> Right (expectNumConstructors refId numConstructorsById)) OnIncoherentDeclReasons @@ -366,13 +366,13 @@ checkDeclCoherencyWith_DoTypes2 loadDeclNumConstructors callbacks go prefix chil -- This function exists merely to extract a best-effort name mapping for the LCA of a merge. We require Alice and Bob to -- have coherent decls, but their LCA is out of the user's control and may have incoherent decls, and whether or not it -- does, we still need to compute *some* syntactic hash for its decls. -lenientCheckDeclCoherency :: +oldLenientCheckDeclCoherency :: forall m. (Monad m) => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> m PartialDeclNameLookup -lenientCheckDeclCoherency loadDeclNumConstructors = +oldLenientCheckDeclCoherency loadDeclNumConstructors = fmap (view #declNameLookup) . (`State.execStateT` LenientDeclCoherencyCheckState Map.empty (PartialDeclNameLookup Map.empty Map.empty)) . go [] @@ -452,11 +452,11 @@ lenientCheckDeclCoherency loadDeclNumConstructors = -- This function exists merely to extract a best-effort name mapping for the LCA of a merge. We require Alice and Bob to -- have coherent decls, but their LCA is out of the user's control and may have incoherent decls, and whether or not it -- does, we still need to compute *some* syntactic hash for its decls. -lenientCheckDeclCoherency2 :: +lenientCheckDeclCoherency :: Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> Map TypeReferenceId Int -> PartialDeclNameLookup -lenientCheckDeclCoherency2 nametree numConstructorsById = +lenientCheckDeclCoherency nametree numConstructorsById = nametree & go [] & (`State.execState` LenientDeclCoherencyCheckState Map.empty (PartialDeclNameLookup Map.empty Map.empty)) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index 196a1d7e49..9bcb7ca2eb 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -1,6 +1,6 @@ module Unison.Merge.Diff - ( nameBasedNamespaceDiff, - nameBasedNamespaceDiff2, + ( oldNameBasedNamespaceDiff, + nameBasedNamespaceDiff, ) where @@ -50,13 +50,13 @@ import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith) -- -- where each name is paired with its diff-op (added, deleted, or updated), relative to the LCA between Alice and Bob's -- branches. If the hash of a name did not change, it will not appear in the map. -nameBasedNamespaceDiff :: +oldNameBasedNamespaceDiff :: MergeDatabase -> TwoWay DeclNameLookup -> PartialDeclNameLookup -> ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> Transaction (TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)) -nameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns = do +oldNameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns = do lcaHashes <- synhashLcaDefns db ppe lcaDeclNameLookup defns.lca hashes <- sequence (synhashDefns db ppe <$> declNameLookups <*> ThreeWay.forgetLca defns) pure (diffNamespaceDefns lcaHashes <$> hashes) @@ -77,13 +77,13 @@ nameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns = do -- -- where each name is paired with its diff-op (added, deleted, or updated), relative to the LCA between Alice and Bob's -- branches. If the hash of a name did not change, it will not appear in the map. -nameBasedNamespaceDiff2 :: +nameBasedNamespaceDiff :: TwoWay DeclNameLookup -> PartialDeclNameLookup -> ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) -> TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) -nameBasedNamespaceDiff2 declNameLookups lcaDeclNameLookup defns hydratedDefns = +nameBasedNamespaceDiff declNameLookups lcaDeclNameLookup defns hydratedDefns = let lcaHashes = synhashLcaDefns2 ppe lcaDeclNameLookup defns.lca hydratedDefns hashes = synhashDefns2 ppe hydratedDefns <$> declNameLookups <*> ThreeWay.forgetLca defns in diffNamespaceDefns lcaHashes <$> hashes diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index 83131b33be..a2ab14b2f6 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -17,6 +17,7 @@ source-repository head library exposed-modules: + Unison.Merge Unison.Merge.CombineDiffs Unison.Merge.Database Unison.Merge.DeclCoherencyCheck From 94209eae14bc9600d3fcdc382263f1768230d408 Mon Sep 17 00:00:00 2001 From: Travis Staton Date: Mon, 29 Jul 2024 19:45:48 -0400 Subject: [PATCH 523/631] permit empty matches --- .../src/Unison/PatternMatchCoverage.hs | 19 ++++++++++++++----- .../Unison/PatternMatchCoverage/Desugar.hs | 7 ++----- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage.hs b/parser-typechecker/src/Unison/PatternMatchCoverage.hs index 7a431a486a..62d04167ff 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage.hs @@ -35,6 +35,7 @@ module Unison.PatternMatchCoverage ) where +import Data.List.NonEmpty (nonEmpty) import Data.Set qualified as Set import Debug.Trace import Unison.Debug @@ -64,13 +65,16 @@ checkMatch :: checkMatch matchLocation scrutineeType cases = do ppe <- getPrettyPrintEnv v0 <- fresh - grdtree0 <- desugarMatch matchLocation scrutineeType v0 cases - doDebug (P.hang (title "desugared:") (prettyGrdTree (prettyPmGrd ppe) (\_ -> "") grdtree0)) (pure ()) - (uncovered, grdtree1) <- uncoverAnnotate (Set.singleton (NC.markDirty v0 $ NC.declVar v0 scrutineeType id NC.emptyNormalizedConstraints)) grdtree0 + mgrdtree0 <- traverse (desugarMatch matchLocation scrutineeType v0) (nonEmpty cases) + doDebug (P.hang (title "desugared:") (prettyGrdTreeMaybe (prettyPmGrd ppe) (\_ -> "") mgrdtree0)) (pure ()) + let initialUncovered = Set.singleton (NC.markDirty v0 $ NC.declVar v0 scrutineeType id NC.emptyNormalizedConstraints) + (uncovered, grdtree1) <- case mgrdtree0 of + Nothing -> pure (initialUncovered, Nothing) + Just grdtree0 -> fmap Just <$> uncoverAnnotate initialUncovered grdtree0 doDebug ( P.sep "\n" - [ P.hang (title "annotated:") (prettyGrdTree (NC.prettyDnf ppe) (NC.prettyDnf ppe . fst) grdtree1), + [ P.hang (title "annotated:") (prettyGrdTreeMaybe (NC.prettyDnf ppe) (NC.prettyDnf ppe . fst) grdtree1), P.hang (title "uncovered:") (NC.prettyDnf ppe uncovered) ] ) @@ -78,9 +82,14 @@ checkMatch matchLocation scrutineeType cases = do uncoveredExpanded <- concat . fmap Set.toList <$> traverse (expandSolution v0) (Set.toList uncovered) doDebug (P.hang (title "uncovered expanded:") (NC.prettyDnf ppe (Set.fromList uncoveredExpanded))) (pure ()) let sols = map (generateInhabitants v0) uncoveredExpanded - let (_accessible, inaccessible, redundant) = classify grdtree1 + let (_accessible, inaccessible, redundant) = case grdtree1 of + Nothing -> ([], [], []) + Just x -> classify x pure (redundant, inaccessible, sols) where + prettyGrdTreeMaybe prettyNode prettyLeaf = \case + Nothing -> "" + Just x -> prettyGrdTree prettyNode prettyLeaf x title = P.bold doDebug out = case shouldDebug PatternCoverage of True -> trace (P.toAnsiUnbroken out) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs index ce015cc51b..28bf29b754 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs @@ -27,12 +27,9 @@ desugarMatch :: -- | scrutinee variable v -> -- | match cases - [MatchCase loc (Term' vt v loc)] -> + NonEmpty (MatchCase loc (Term' vt v loc)) -> m (GrdTree (PmGrd vt v loc) loc) -desugarMatch loc0 scrutineeType v0 cs0 = - traverse desugarClause cs0 >>= \case - [] -> pure $ Leaf loc0 - x : xs -> pure $ Fork (x :| xs) +desugarMatch loc0 scrutineeType v0 cs0 = Fork <$> traverse desugarClause cs0 where desugarClause :: MatchCase loc (Term' vt v loc) -> m (GrdTree (PmGrd vt v loc) loc) desugarClause MatchCase {matchPattern, matchGuard} = From 72da81f18ba7204f4a3d8a2eaad83f218f65d7b6 Mon Sep 17 00:00:00 2001 From: Travis Staton Date: Mon, 29 Jul 2024 21:21:09 -0400 Subject: [PATCH 524/631] remove unused arg --- parser-typechecker/src/Unison/PatternMatchCoverage.hs | 6 ++---- .../src/Unison/PatternMatchCoverage/Desugar.hs | 4 +--- parser-typechecker/src/Unison/Typechecker/Context.hs | 2 +- 3 files changed, 4 insertions(+), 8 deletions(-) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage.hs b/parser-typechecker/src/Unison/PatternMatchCoverage.hs index 62d04167ff..30973b8256 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage.hs @@ -54,18 +54,16 @@ import Unison.Util.Pretty qualified as P checkMatch :: forall vt v loc m. (Pmc vt v loc m) => - -- | the match location - loc -> -- | scrutinee type Type.Type vt loc -> -- | match cases [Term.MatchCase loc (Term.Term' vt v loc)] -> -- | (redundant locations, inaccessible locations, inhabitants of uncovered refinement type) m ([loc], [loc], [Pattern ()]) -checkMatch matchLocation scrutineeType cases = do +checkMatch scrutineeType cases = do ppe <- getPrettyPrintEnv v0 <- fresh - mgrdtree0 <- traverse (desugarMatch matchLocation scrutineeType v0) (nonEmpty cases) + mgrdtree0 <- traverse (desugarMatch scrutineeType v0) (nonEmpty cases) doDebug (P.hang (title "desugared:") (prettyGrdTreeMaybe (prettyPmGrd ppe) (\_ -> "") mgrdtree0)) (pure ()) let initialUncovered = Set.singleton (NC.markDirty v0 $ NC.declVar v0 scrutineeType id NC.emptyNormalizedConstraints) (uncovered, grdtree1) <- case mgrdtree0 of diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs index 28bf29b754..8587d44d6c 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs @@ -20,8 +20,6 @@ import Unison.Type qualified as Type desugarMatch :: forall loc vt v m. (Pmc vt v loc m) => - -- | loc of match - loc -> -- | scrutinee type Type vt loc -> -- | scrutinee variable @@ -29,7 +27,7 @@ desugarMatch :: -- | match cases NonEmpty (MatchCase loc (Term' vt v loc)) -> m (GrdTree (PmGrd vt v loc) loc) -desugarMatch loc0 scrutineeType v0 cs0 = Fork <$> traverse desugarClause cs0 +desugarMatch scrutineeType v0 cs0 = Fork <$> traverse desugarClause cs0 where desugarClause :: MatchCase loc (Term' vt v loc) -> m (GrdTree (PmGrd vt v loc) loc) desugarClause MatchCase {matchPattern, matchGuard} = diff --git a/parser-typechecker/src/Unison/Typechecker/Context.hs b/parser-typechecker/src/Unison/Typechecker/Context.hs index 89eb193212..214fe95a0c 100644 --- a/parser-typechecker/src/Unison/Typechecker/Context.hs +++ b/parser-typechecker/src/Unison/Typechecker/Context.hs @@ -1525,7 +1525,7 @@ ensurePatternCoverage theMatch _theMatchType _scrutinee scrutineeType cases = do constructorCache = mempty } (redundant, _inaccessible, uncovered) <- flip evalStateT pmcState do - checkMatch matchLoc scrutineeType cases + checkMatch scrutineeType cases let checkUncovered = case Nel.nonEmpty uncovered of Nothing -> pure () Just xs -> failWith (UncoveredPatterns matchLoc xs) From 9e4719e408fef1251fc601a28ca0721d3a9c9f2f Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 29 Jul 2024 22:36:24 -0400 Subject: [PATCH 525/631] break up libdeps merge into diff and apply steps --- .../Codebase/Editor/HandleInput/Merge2.hs | 2 +- unison-merge/src/Unison/Merge.hs | 6 +- unison-merge/src/Unison/Merge/Libdeps.hs | 75 ++++++++++--------- 3 files changed, 45 insertions(+), 38 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 85f830db06..5dffadf5fd 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -296,7 +296,7 @@ doMerge info = do mergedLibdeps <- Cli.runTransaction do libdeps <- loadLibdeps branches - libdepsToBranch0 db (Merge.mergeLibdeps getTwoFreshNames libdeps) + libdepsToBranch0 db (Merge.applyLibdepsDiff getTwoFreshNames libdeps (Merge.diffLibdeps libdeps)) -- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names let mkPpes :: Merge.TwoWay Names -> Names -> Merge.TwoWay PrettyPrintEnvDecl diff --git a/unison-merge/src/Unison/Merge.hs b/unison-merge/src/Unison/Merge.hs index ef7db6d5f5..9ea6972712 100644 --- a/unison-merge/src/Unison/Merge.hs +++ b/unison-merge/src/Unison/Merge.hs @@ -24,7 +24,9 @@ module Unison.Merge partitionCombinedDiffs, -- * Merging libdeps - mergeLibdeps, + LibdepDiffOp (..), + diffLibdeps, + applyLibdepsDiff, -- * Utility types EitherWay (..), @@ -53,7 +55,7 @@ import Unison.Merge.Diff (nameBasedNamespaceDiff, oldNameBasedNamespaceDiff) import Unison.Merge.DiffOp (DiffOp (..)) import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.EitherWayI (EitherWayI (..)) -import Unison.Merge.Libdeps (mergeLibdeps) +import Unison.Merge.Libdeps (LibdepDiffOp (..), applyLibdepsDiff, diffLibdeps) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs) import Unison.Merge.Synhashed (Synhashed (..)) diff --git a/unison-merge/src/Unison/Merge/Libdeps.hs b/unison-merge/src/Unison/Merge/Libdeps.hs index defacf036b..c1fcb941b1 100644 --- a/unison-merge/src/Unison/Merge/Libdeps.hs +++ b/unison-merge/src/Unison/Merge/Libdeps.hs @@ -1,6 +1,8 @@ -- | An API for merging together two collections of library dependencies. module Unison.Merge.Libdeps - ( mergeLibdeps, + ( LibdepDiffOp (..), + diffLibdeps, + applyLibdepsDiff, ) where @@ -20,33 +22,29 @@ import Unison.Prelude hiding (catMaybes) import Unison.Util.Map qualified as Map import Witherable (catMaybes) --- | Perform a three-way merge on two collections of library dependencies. -mergeLibdeps :: - forall k v. +------------------------------------------------------------------------------------------------------------------------ +-- Diffing libdeps + +data LibdepDiffOp a + = AddLibdep !a + | AddBothLibdeps !a !a + | DeleteLibdep + +-- | Perform a three-way diff on two collections of library dependencies. +diffLibdeps :: (Ord k, Eq v) => - -- | Freshen a name, e.g. "base" -> ("base__4", "base__5"). - (Set k -> k -> (k, k)) -> -- | Library dependencies. ThreeWay (Map k v) -> - -- | Merged library dependencies. - Map k v -mergeLibdeps freshen libdeps = - mergeDiffs (diff libdeps.lca libdeps.alice) (diff libdeps.lca libdeps.bob) - & applyDiff (freshen usedNames) libdeps.lca - where - usedNames :: Set k - usedNames = - Set.unions - [ Map.keysSet libdeps.lca, - Map.keysSet libdeps.alice, - Map.keysSet libdeps.bob - ] + -- | Library dependencies diff. + Map k (LibdepDiffOp v) +diffLibdeps libdeps = + mergeDiffs (twoWayDiff libdeps.lca libdeps.alice) (twoWayDiff libdeps.lca libdeps.bob) --- `diff old new` computes a diff between old thing `old` and new thing `new`. +-- `twoWayDiff old new` computes a diff between old thing `old` and new thing `new`. -- -- Values present in `old` but not `new` are tagged as "deleted"; similar for "added" and "updated". -diff :: (Ord k, Eq v) => Map k v -> Map k v -> Map k (DiffOp v) -diff = +twoWayDiff :: (Ord k, Eq v) => Map k v -> Map k v -> Map k (DiffOp v) +twoWayDiff = Map.merge (Map.mapMissing \_ -> DiffOp'Delete) (Map.mapMissing \_ -> DiffOp'Add) @@ -97,20 +95,23 @@ combineDiffOps1 = \case | alice == bob -> Just (AddLibdep alice) | otherwise -> Just (AddBothLibdeps alice bob) +------------------------------------------------------------------------------------------------------------------------ +-- Applying libdeps diff + -- Apply a library dependencies diff to the LCA. -applyDiff :: +applyLibdepsDiff :: forall k v. (Ord k) => - -- Freshen a name, e.g. "base" -> ("base__4", "base__5") - (k -> (k, k)) -> - -- The LCA library dependencies. - Map k v -> - -- LCA->Alice+Bob library dependencies diff. + -- | Freshen a name, e.g. "base" -> ("base__4", "base__5"). + (Set k -> k -> (k, k)) -> + -- | Library dependencies. + ThreeWay (Map k v) -> + -- | Library dependencies diff. Map k (LibdepDiffOp v) -> - -- The merged library dependencies. + -- | Merged library dependencies. Map k v -applyDiff freshen = - Map.mergeMap Map.singleton f (\name _ -> f name) +applyLibdepsDiff freshen0 libdeps = + Map.mergeMap Map.singleton f (\name _ -> f name) libdeps.lca where f :: k -> LibdepDiffOp v -> Map k v f k = \case @@ -120,7 +121,11 @@ applyDiff freshen = in Map.fromList [(k1, v1), (k2, v2)] DeleteLibdep -> Map.empty -data LibdepDiffOp a - = AddLibdep !a - | AddBothLibdeps !a !a - | DeleteLibdep + freshen :: k -> (k, k) + freshen = + freshen0 $ + Set.unions + [ Map.keysSet libdeps.lca, + Map.keysSet libdeps.alice, + Map.keysSet libdeps.bob + ] From 03b225ccd18a3edcc418127ef1f8c0fe98741393 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jul 2024 15:58:28 -0700 Subject: [PATCH 526/631] Add ability to find over EVERY branch. --- .../src/Unison/Codebase/Editor/HandleInput.hs | 124 ++++++++++-------- .../Codebase/Editor/HandleInput/Global.hs | 22 ++++ .../src/Unison/Codebase/Editor/Input.hs | 4 +- .../src/Unison/Codebase/Editor/Output.hs | 3 +- .../src/Unison/CommandLine/InputPatterns.hs | 6 +- unison-cli/unison-cli.cabal | 1 + 6 files changed, 96 insertions(+), 64 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/Global.hs diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index e85879cc4a..65b2fb781d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -63,6 +63,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.Global qualified as Global import Unison.Codebase.Editor.HandleInput.InstallLib (handleInstallLib) import Unison.Codebase.Editor.HandleInput.LSPDebug qualified as LSPDebug import Unison.Codebase.Editor.HandleInput.Load (EvalMode (Sandboxed), evalUnisonFile, handleLoad, loadUnisonFile) @@ -1089,7 +1090,7 @@ handleFindI :: Cli () handleFindI isVerbose fscope ws input = do Cli.Env {codebase} <- ask - (pped, names, searchRoot, branch0) <- case fscope of + case fscope of FindLocal p -> do searchRoot <- Cli.resolvePath' p branch0 <- Cli.getBranch0FromProjectPath searchRoot @@ -1097,7 +1098,21 @@ handleFindI isVerbose fscope ws input = do -- Don't exclude anything from the pretty printer, since the type signatures we print for -- results may contain things in lib. pped <- Cli.currentPrettyPrintEnvDecl - pure (pped, names, Just p, branch0) + let suffixifiedPPE = PPED.suffixifiedPPE pped + results <- searchBranch0 codebase branch0 names + if (null results) + then do + Cli.respond FindNoLocalMatches + -- We've already searched everything else, so now we search JUST the + -- names in lib. + let mayOnlyLibBranch = branch0 & Branch.children %%~ \cs -> Map.singleton NameSegment.libSegment <$> Map.lookup NameSegment.libSegment cs + case mayOnlyLibBranch of + Nothing -> respondResults codebase suffixifiedPPE (Just p) [] + Just onlyLibBranch -> do + let onlyLibNames = Branch.toNames onlyLibBranch + results <- searchBranch0 codebase branch0 onlyLibNames + respondResults codebase suffixifiedPPE (Just p) results + else respondResults codebase suffixifiedPPE (Just p) results FindLocalAndDeps p -> do searchRoot <- Cli.resolvePath' p branch0 <- Cli.getBranch0FromProjectPath searchRoot @@ -1105,64 +1120,57 @@ handleFindI isVerbose fscope ws input = do -- Don't exclude anything from the pretty printer, since the type signatures we print for -- results may contain things in lib. pped <- Cli.currentPrettyPrintEnvDecl - pure (pped, names, Just p, branch0) + let suffixifiedPPE = PPED.suffixifiedPPE pped + results <- searchBranch0 codebase branch0 names + respondResults codebase suffixifiedPPE (Just p) results FindGlobal -> do - -- TODO: Rewrite to be properly global again - projectRootNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getCurrentProjectRoot0 - pped <- Cli.prettyPrintEnvDeclFromNames projectRootNames - currentBranch0 <- Cli.getCurrentBranch0 - pure (pped, projectRootNames, Nothing, currentBranch0) - let suffixifiedPPE = PPED.suffixifiedPPE pped - let getResults :: Names -> Cli [SearchResult] - getResults names = - case ws of - [] -> pure (List.sortBy SR.compareByName (SR.fromNames names)) - -- type query - ":" : ws -> do - typ <- parseSearchType (show input) (unwords ws) - let keepNamed = Set.intersection (Branch.deepReferents branch0) - (noExactTypeMatches, matches) <- do - Cli.runTransaction do - matches <- keepNamed <$> Codebase.termsOfType codebase typ - if null matches - then (True,) . keepNamed <$> Codebase.termsMentioningType codebase typ - else pure (False, matches) - when noExactTypeMatches (Cli.respond NoExactTypeMatches) - pure $ - -- in verbose mode, aliases are shown, so we collapse all - -- aliases to a single search result; in non-verbose mode, - -- a separate result may be shown for each alias - (if isVerbose then uniqueBy SR.toReferent else id) $ - searchResultsFor names (Set.toList matches) [] + Global.forAllProjectBranches \(projAndBranchNames, _ids) branch -> do + let branch0 = Branch.head branch + let projectRootNames = Names.makeAbsolute . Branch.toNames $ branch0 + pped <- Cli.prettyPrintEnvDeclFromNames projectRootNames + results <- searchBranch0 codebase branch0 projectRootNames + when (not $ null results) do + Cli.setNumberedArgs $ fmap (SA.SearchResult Nothing) results + results' <- Cli.runTransaction (Backend.loadSearchResults codebase results) + Cli.respond $ GlobalFindBranchResults projAndBranchNames (PPED.suffixifiedPPE pped) isVerbose results' + where + searchBranch0 :: Codebase.Codebase m Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult] + searchBranch0 codebase branch0 names = + case ws of + [] -> pure (List.sortBy SR.compareByName (SR.fromNames names)) + -- type query + ":" : ws -> do + typ <- parseSearchType (show input) (unwords ws) + let keepNamed = Set.intersection (Branch.deepReferents branch0) + (noExactTypeMatches, matches) <- do + Cli.runTransaction do + matches <- keepNamed <$> Codebase.termsOfType codebase typ + if null matches + then (True,) . keepNamed <$> Codebase.termsMentioningType codebase typ + else pure (False, matches) + when noExactTypeMatches (Cli.respond NoExactTypeMatches) + pure $ + -- in verbose mode, aliases are shown, so we collapse all + -- aliases to a single search result; in non-verbose mode, + -- a separate result may be shown for each alias + (if isVerbose then uniqueBy SR.toReferent else id) $ + searchResultsFor names (Set.toList matches) [] - -- name query - qs -> do - let anythingBeforeHash :: Megaparsec.Parsec (Lexer.Token Text) [Char] Text - anythingBeforeHash = Text.pack <$> Megaparsec.takeWhileP Nothing (/= '#') - let srs = - searchBranchScored - names - Find.simpleFuzzyScore - (mapMaybe (HQ.parseTextWith anythingBeforeHash . Text.pack) qs) - pure $ uniqueBy SR.toReferent srs - let respondResults results = do - Cli.setNumberedArgs $ fmap (SA.SearchResult searchRoot) results - results' <- Cli.runTransaction (Backend.loadSearchResults codebase results) - Cli.respond $ ListOfDefinitions fscope suffixifiedPPE isVerbose results' - results <- getResults names - case (results, fscope) of - ([], FindLocal {}) -> do - Cli.respond FindNoLocalMatches - -- We've already searched everything else, so now we search JUST the - -- names in lib. - let mayOnlyLibBranch = branch0 & Branch.children %%~ \cs -> Map.singleton NameSegment.libSegment <$> Map.lookup NameSegment.libSegment cs - case mayOnlyLibBranch of - Nothing -> respondResults [] - Just onlyLibBranch -> do - let onlyLibNames = Branch.toNames onlyLibBranch - results <- getResults onlyLibNames - respondResults results - _ -> respondResults results + -- name query + qs -> do + let anythingBeforeHash :: Megaparsec.Parsec (Lexer.Token Text) [Char] Text + anythingBeforeHash = Text.pack <$> Megaparsec.takeWhileP Nothing (/= '#') + let srs = + searchBranchScored + names + Find.simpleFuzzyScore + (mapMaybe (HQ.parseTextWith anythingBeforeHash . Text.pack) qs) + pure $ uniqueBy SR.toReferent srs + respondResults :: Codebase.Codebase m Symbol Ann -> PPE.PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli () + respondResults codebase ppe searchRoot results = do + Cli.setNumberedArgs $ fmap (SA.SearchResult searchRoot) results + results' <- Cli.runTransaction (Backend.loadSearchResults codebase results) + Cli.respond $ ListOfDefinitions fscope ppe isVerbose results' handleDependencies :: HQ.HashQualified Name -> Cli () handleDependencies hq = do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Global.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Global.hs new file mode 100644 index 0000000000..1306497b61 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Global.hs @@ -0,0 +1,22 @@ +module Unison.Codebase.Editor.HandleInput.Global (forAllProjectBranches) where + +import Control.Monad.Reader +import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) +import U.Codebase.Sqlite.Queries qualified as Q +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch (Branch) +import Unison.Core.Project +import Unison.Prelude +import Unison.Util.Monoid (foldMapM) + +-- | Map over ALL project branches in the codebase. +-- This is a _very_ big hammer, that you should basically never use, except for things like debugging or migrations. +forAllProjectBranches :: (Monoid r) => ((ProjectAndBranch ProjectName ProjectBranchName, ProjectAndBranch ProjectId ProjectBranchId) -> Branch IO -> Cli r) -> Cli r +forAllProjectBranches f = do + Cli.Env {codebase} <- ask + projectBranches <- Cli.runTransaction Q.loadAllProjectBranchNamePairs + projectBranches & foldMapM \(names, ids@(ProjectAndBranch projId branchId)) -> do + b <- liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId + f (names, ids) b diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index d0bc3ae9d2..e736c618bd 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -127,8 +127,8 @@ data Input | PushRemoteBranchI PushRemoteBranchInput | ResetI (BranchId2 {- namespace to reset it to -}) (Maybe UnresolvedProjectBranch {- ProjectBranch to reset -}) -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? - -- Does it make sense to fork from not-the-root of a Github repo? - | -- used in Welcome module to give directions to user + | -- Does it make sense to fork from not-the-root of a Github repo? + -- used in Welcome module to give directions to user CreateMessage (P.Pretty P.ColorText) | -- Change directory. SwitchBranchI Path' diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 6ae0b23616..b8c13900a6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -261,7 +261,6 @@ data Output | MovedOverExistingBranch Path' | DeletedEverything | ListNames - IsGlobal Int -- hq length to print References [(Reference, [HQ'.HashQualified Name])] -- type match, type names [(Referent, [HQ'.HashQualified Name])] -- term match, term names @@ -269,6 +268,7 @@ data Output | ListOfDefinitions FindScope PPE.PrettyPrintEnv ListDetailed [SearchResult' Symbol Ann] | ListShallow (IO PPE.PrettyPrintEnv) [ShallowListEntry Symbol Ann] | ListStructuredFind [HQ.HashQualified Name] + | GlobalFindBranchResults (ProjectAndBranch ProjectName ProjectBranchName) PPE.PrettyPrintEnv ListDetailed [SearchResult' Symbol Ann] | -- ListStructuredFind patternMatchingUsages termBodyUsages -- show the result of add/update SlurpOutput Input PPE.PrettyPrintEnv SlurpResult @@ -545,6 +545,7 @@ isFailure o = case o of DeletedEverything -> False ListNames _ _ tys tms -> null tms && null tys ListOfDefinitions _ _ _ ds -> null ds + GlobalFindBranchResults _ _ _ _ -> False ListStructuredFind tms -> null tms SlurpOutput _ _ sr -> not $ SR.isOk sr ParseErrors {} -> True diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 671265a960..f9a9effcb7 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1149,7 +1149,7 @@ findAll :: InputPattern findAll = find' "find.all" (Input.FindLocalAndDeps Path.relativeEmpty') findGlobal :: InputPattern -findGlobal = find' "find.global" Input.FindGlobal +findGlobal = find' "debug.find.global" Input.FindGlobal findIn, findInAll :: InputPattern findIn = findIn' "find-in" Input.FindLocal @@ -1197,8 +1197,8 @@ findHelp = "lists all definitions with a name similar to 'foo' or 'bar' in the " <> "specified subnamespace (including one level of its 'lib')." ), - ( "find.global foo", - "lists all definitions with a name similar to 'foo' in any namespace" + ( "debug.find.global foo", + "Iteratively searches all projects and branches and lists all definitions with a name similar to 'foo'. Note that this is a very slow operation." ) ] ) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 77030bfdf6..2bdd255a12 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -64,6 +64,7 @@ library Unison.Codebase.Editor.HandleInput.EditNamespace Unison.Codebase.Editor.HandleInput.FindAndReplace Unison.Codebase.Editor.HandleInput.FormatFile + Unison.Codebase.Editor.HandleInput.Global Unison.Codebase.Editor.HandleInput.InstallLib Unison.Codebase.Editor.HandleInput.Load Unison.Codebase.Editor.HandleInput.Ls From d4a04b73492bdfa013108921ef5d8e33e04df163 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jul 2024 15:58:28 -0700 Subject: [PATCH 527/631] re-add names.global --- .../src/Unison/Codebase/Editor/HandleInput.hs | 36 ++++--- .../src/Unison/Codebase/Editor/Output.hs | 8 +- .../src/Unison/CommandLine/InputPatterns.hs | 9 +- .../src/Unison/CommandLine/OutputMessages.hs | 101 ++++++++++-------- 4 files changed, 90 insertions(+), 64 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 65b2fb781d..ae03247421 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -498,23 +498,27 @@ loop e = do fixupOutput = HQ'.toHQ . Path.nameFromHQSplit NamesI global query -> do hqLength <- Cli.runTransaction Codebase.hashLength - (names, pped) <- - if global - then do - error "TODO: Implement names.global." - else do - names <- Cli.currentNames + let searchNames names = do pped <- Cli.prettyPrintEnvDeclFromNames names - pure (names, pped) - - let unsuffixifiedPPE = PPED.unsuffixifiedPPE pped - terms = Names.lookupHQTerm Names.IncludeSuffixes query names - types = Names.lookupHQType Names.IncludeSuffixes query names - terms' :: [(Referent, [HQ'.HashQualified Name])] - terms' = map (\r -> (r, PPE.allTermNames unsuffixifiedPPE r)) (Set.toList terms) - types' :: [(Reference, [HQ'.HashQualified Name])] - types' = map (\r -> (r, PPE.allTypeNames unsuffixifiedPPE r)) (Set.toList types) - Cli.respond $ ListNames global hqLength types' terms' + let unsuffixifiedPPE = PPED.unsuffixifiedPPE pped + terms = Names.lookupHQTerm Names.IncludeSuffixes query names + types = Names.lookupHQType Names.IncludeSuffixes query names + terms' :: [(Referent, [HQ'.HashQualified Name])] + terms' = map (\r -> (r, PPE.allTermNames unsuffixifiedPPE r)) (Set.toList terms) + types' :: [(Reference, [HQ'.HashQualified Name])] + types' = map (\r -> (r, PPE.allTypeNames unsuffixifiedPPE r)) (Set.toList types) + pure (terms', types') + if global + then do + Global.forAllProjectBranches \(projBranchNames, _ids) branch -> do + let names = Branch.toNames . Branch.head $ branch + (terms, types) <- searchNames names + when (not (null terms) || not (null types)) do + Cli.respond $ GlobalListNames projBranchNames hqLength types terms + else do + names <- Cli.currentNames + (terms, types) <- searchNames names + Cli.respond $ ListNames hqLength types terms DocsI srcs -> do for_ srcs docsI CreateAuthorI authorNameSegment authorFullName -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index b8c13900a6..7a59f4ac96 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -264,6 +264,11 @@ data Output Int -- hq length to print References [(Reference, [HQ'.HashQualified Name])] -- type match, type names [(Referent, [HQ'.HashQualified Name])] -- term match, term names + | GlobalListNames + (ProjectAndBranch ProjectName ProjectBranchName) + Int -- hq length to print References + [(Reference, [HQ'.HashQualified Name])] -- type match, type names + [(Referent, [HQ'.HashQualified Name])] -- term match, term names -- list of all the definitions within this branch | ListOfDefinitions FindScope PPE.PrettyPrintEnv ListDetailed [SearchResult' Symbol Ann] | ListShallow (IO PPE.PrettyPrintEnv) [ShallowListEntry Symbol Ann] @@ -543,7 +548,8 @@ isFailure o = case o of MoveRootBranchConfirmation -> False MovedOverExistingBranch {} -> False DeletedEverything -> False - ListNames _ _ tys tms -> null tms && null tys + ListNames _ tys tms -> null tms && null tys + GlobalListNames {} -> False ListOfDefinitions _ _ _ ds -> null ds GlobalFindBranchResults _ _ _ _ -> False ListStructuredFind tms -> null tms diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index f9a9effcb7..38d24809de 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2611,12 +2611,15 @@ names isGlobal = [] I.Visible [("name or hash", Required, definitionQueryArg)] - (P.wrap $ makeExample (names isGlobal) ["foo"] <> " shows the hash and all known names for `foo`.") + (P.wrap $ makeExample (names isGlobal) ["foo"] <> description) $ \case [thing] -> Input.NamesI isGlobal <$> handleHashQualifiedNameArg thing args -> wrongArgsLength "exactly one argument" args where - cmdName = if isGlobal then "names.global" else "names" + description + | isGlobal = "Iteratively search across all projects and branches for names matching `foo`. Note that this is expected to be quite slow and is primarily for debugging issues with your codebase." + | otherwise = "List all known names for `foo` in the current branch." + cmdName = if isGlobal then "debug.names.global" else "names" dependents, dependencies :: InputPattern dependents = @@ -3456,7 +3459,7 @@ validInputs = mergeInputPattern, mergeCommitInputPattern, names False, -- names - names True, -- names.global + names True, -- debug.names.global namespaceDependencies, previewAdd, previewUpdate, diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index d061f37f54..62ed7ea70e 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -855,49 +855,24 @@ notifyUser dir = \case ] ListOfDefinitions fscope ppe detailed results -> listOfDefinitions fscope ppe detailed results - ListNames global len types terms -> - if null types && null terms - then - pure . P.callout "😶" $ - P.sepNonEmpty "\n\n" $ - [ P.wrap "I couldn't find anything by that name.", - globalTip - ] - else - pure . P.sepNonEmpty "\n\n" $ - [ formatTypes types, - formatTerms terms, - globalTip - ] - where - globalTip = - if global - then mempty - else (tip $ "Use " <> IP.makeExample (IP.names True) [] <> " to see more results.") - formatTerms tms = - P.lines . P.nonEmpty $ P.plural tms (P.blue "Term") : List.intersperse "" (go <$> tms) - where - go (ref, hqs) = - P.column2 - [ ("Hash:", P.syntaxToColor (prettyReferent len ref)), - ( "Names: ", - P.group $ - P.spaced $ - P.bold . P.syntaxToColor . prettyHashQualified' <$> List.sortBy Name.compareAlphabetical hqs - ) - ] - formatTypes types = - P.lines . P.nonEmpty $ P.plural types (P.blue "Type") : List.intersperse "" (go <$> types) - where - go (ref, hqs) = - P.column2 - [ ("Hash:", P.syntaxToColor (prettyReference len ref)), - ( "Names:", - P.group $ - P.spaced $ - P.bold . P.syntaxToColor . prettyHashQualified' <$> List.sortBy Name.compareAlphabetical hqs - ) - ] + GlobalFindBranchResults projBranchName ppe detailed results -> do + output <- listOfDefinitions Input.FindGlobal ppe detailed results + pure $ + P.lines + [ P.wrap $ "Found results in " <> P.text (into @Text projBranchName), + "", + output + ] + ListNames len types terms -> + listOfNames len types terms + GlobalListNames projectBranchName len types terms -> do + output <- listOfNames len types terms + pure $ + P.lines + [ P.wrap $ "Found results in " <> P.text (into @Text projectBranchName), + "", + output + ] -- > names foo -- Terms: -- Hash: #asdflkjasdflkjasdf @@ -997,7 +972,6 @@ notifyUser dir = \case -- defs in the codebase. In some cases it's fine for bindings to -- shadow codebase names, but you don't want it to capture them in -- the decompiled output. - let prettyBindings = P.bracket . P.lines $ P.wrap "The watch expression(s) reference these definitions:" @@ -2816,6 +2790,45 @@ listOfDefinitions :: listOfDefinitions fscope ppe detailed results = pure $ listOfDefinitions' fscope ppe detailed results +listOfNames :: Int -> [(Reference, [HQ'.HashQualified Name])] -> [(Referent, [HQ'.HashQualified Name])] -> IO Pretty +listOfNames len types terms = do + if null types && null terms + then + pure . P.callout "😶" $ + P.sepNonEmpty "\n\n" $ + [ P.wrap "I couldn't find anything by that name." + ] + else + pure . P.sepNonEmpty "\n\n" $ + [ formatTypes types, + formatTerms terms + ] + where + formatTerms tms = + P.lines . P.nonEmpty $ P.plural tms (P.blue "Term") : List.intersperse "" (go <$> tms) + where + go (ref, hqs) = + P.column2 + [ ("Hash:", P.syntaxToColor (prettyReferent len ref)), + ( "Names: ", + P.group $ + P.spaced $ + P.bold . P.syntaxToColor . prettyHashQualified' <$> List.sortBy Name.compareAlphabetical hqs + ) + ] + formatTypes types = + P.lines . P.nonEmpty $ P.plural types (P.blue "Type") : List.intersperse "" (go <$> types) + where + go (ref, hqs) = + P.column2 + [ ("Hash:", P.syntaxToColor (prettyReference len ref)), + ( "Names:", + P.group $ + P.spaced $ + P.bold . P.syntaxToColor . prettyHashQualified' <$> List.sortBy Name.compareAlphabetical hqs + ) + ] + data ShowNumbers = ShowNumbers | HideNumbers -- | `ppe` is just for rendering type signatures From e545e0b1a7c0614aa364602ae0b19f45bf498b0e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jul 2024 15:58:28 -0700 Subject: [PATCH 528/631] Rerun transcripts --- ...ability-order-doesnt-affect-hash.output.md | 2 - unison-src/transcripts/deep-names.output.md | 8 -- .../transcripts/empty-namespaces.output.md | 4 +- unison-src/transcripts/find-command.output.md | 9 +- unison-src/transcripts/help.output.md | 122 ++++++++++-------- unison-src/transcripts/merge.output.md | 2 - unison-src/transcripts/names.output.md | 6 - unison-src/transcripts/suffixes.output.md | 2 - .../transcripts/unique-type-churn.output.md | 6 - .../update-ignores-lib-namespace.output.md | 2 - 10 files changed, 75 insertions(+), 88 deletions(-) diff --git a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md index a61dd00459..d897322a99 100644 --- a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md +++ b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md @@ -45,7 +45,5 @@ scratch/main> names term1 Term Hash: #8hum58rlih Names: term1 term2 - - Tip: Use `names.global` to see more results. ``` diff --git a/unison-src/transcripts/deep-names.output.md b/unison-src/transcripts/deep-names.output.md index 114133d786..9756abc509 100644 --- a/unison-src/transcripts/deep-names.output.md +++ b/unison-src/transcripts/deep-names.output.md @@ -48,16 +48,12 @@ scratch/app1> names a Term Hash: #gjmq673r1v Names: lib.text_v1.a lib.text_v2.a - - Tip: Use `names.global` to see more results. scratch/app1> names x Term Hash: #nsmc4p1ra4 Names: lib.http_v3.x lib.http_v4.x - - Tip: Use `names.global` to see more results. ``` Our `app2` project includes the `http` library twice as direct dependencies, and once as an indirect dependency via `webutil`. @@ -102,15 +98,11 @@ scratch/app2> names a Term Hash: #gjmq673r1v Names: lib.webutil.lib.text_v1.a - - Tip: Use `names.global` to see more results. scratch/app2> names x Term Hash: #nsmc4p1ra4 Names: lib.http_v1.x lib.http_v2.x - - Tip: Use `names.global` to see more results. ``` diff --git a/unison-src/transcripts/empty-namespaces.output.md b/unison-src/transcripts/empty-namespaces.output.md index 1b598b6dd4..b1b647ecda 100644 --- a/unison-src/transcripts/empty-namespaces.output.md +++ b/unison-src/transcripts/empty-namespaces.output.md @@ -25,7 +25,7 @@ scratch/main> find.verbose No results. Check your spelling, or try using tab completion to supply command arguments. - `find.global` can be used to search outside the current + `debug.find.global` can be used to search outside the current namespace. ``` @@ -42,7 +42,7 @@ scratch/main> find mynamespace No results. Check your spelling, or try using tab completion to supply command arguments. - `find.global` can be used to search outside the current + `debug.find.global` can be used to search outside the current namespace. ``` diff --git a/unison-src/transcripts/find-command.output.md b/unison-src/transcripts/find-command.output.md index 7abbe26f0d..fde54abfd1 100644 --- a/unison-src/transcripts/find-command.output.md +++ b/unison-src/transcripts/find-command.output.md @@ -86,17 +86,14 @@ scratch/main> find baz No results. Check your spelling, or try using tab completion to supply command arguments. - `find.global` can be used to search outside the current + `debug.find.global` can be used to search outside the current namespace. ``` ``` ucm scratch/main> find.global notHere - 😶 - - No results. Check your spelling, or try using tab completion - to supply command arguments. - +⚠️ +I don't know how to find.global. Type `help` or `?` to get help. ``` diff --git a/unison-src/transcripts/help.output.md b/unison-src/transcripts/help.output.md index 248fb6b4fc..13f3c63820 100644 --- a/unison-src/transcripts/help.output.md +++ b/unison-src/transcripts/help.output.md @@ -113,6 +113,50 @@ scratch/main> help debug.file View details about the most recent successfully typechecked file. + debug.find.global + `find` lists all definitions in the + current namespace. + `find foo` lists all definitions with a + name similar to 'foo' in the + current namespace (excluding + those under 'lib'). + `find foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the current + namespace (excluding those + under 'lib'). + `find-in namespace` lists all definitions in the + specified subnamespace. + `find-in namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace. + find.all foo lists all definitions with a + name similar to 'foo' in the + current namespace (including + one level of 'lib'). + `find-in.all namespace` lists all definitions in the + specified subnamespace + (including one level of its + 'lib'). + `find-in.all namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace (including one + level of its 'lib'). + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. + + debug.names.global + `debug.names.global foo` Iteratively search across all + projects and branches for names matching `foo`. Note that this + is expected to be quite slow and is primarily for debugging + issues with your codebase. + debug.numberedArgs Dump the contents of the numbered args state. @@ -269,9 +313,12 @@ scratch/main> help 'bar' in the specified subnamespace (including one level of its 'lib'). - find.global foo lists all definitions with a - name similar to 'foo' in any - namespace + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. find-in `find` lists all definitions in the @@ -304,9 +351,12 @@ scratch/main> help 'bar' in the specified subnamespace (including one level of its 'lib'). - find.global foo lists all definitions with a - name similar to 'foo' in any - namespace + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. find-in.all `find` lists all definitions in the @@ -339,9 +389,12 @@ scratch/main> help 'bar' in the specified subnamespace (including one level of its 'lib'). - find.global foo lists all definitions with a - name similar to 'foo' in any - namespace + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. find.all `find` lists all definitions in the @@ -374,48 +427,16 @@ scratch/main> help 'bar' in the specified subnamespace (including one level of its 'lib'). - find.global foo lists all definitions with a - name similar to 'foo' in any - namespace + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. find.all.verbose `find.all.verbose` searches for definitions like `find.all`, but includes hashes and aliases in the results. - find.global - `find` lists all definitions in the - current namespace. - `find foo` lists all definitions with a - name similar to 'foo' in the - current namespace (excluding - those under 'lib'). - `find foo bar` lists all definitions with a - name similar to 'foo' or - 'bar' in the current - namespace (excluding those - under 'lib'). - `find-in namespace` lists all definitions in the - specified subnamespace. - `find-in namespace foo bar` lists all definitions with a - name similar to 'foo' or - 'bar' in the specified - subnamespace. - find.all foo lists all definitions with a - name similar to 'foo' in the - current namespace (including - one level of 'lib'). - `find-in.all namespace` lists all definitions in the - specified subnamespace - (including one level of its - 'lib'). - `find-in.all namespace foo bar` lists all definitions with a - name similar to 'foo' or - 'bar' in the specified - subnamespace (including one - level of its 'lib'). - find.global foo lists all definitions with a - name similar to 'foo' in any - namespace - find.verbose `find.verbose` searches for definitions like `find`, but includes hashes and aliases in the results. @@ -526,11 +547,8 @@ scratch/main> help `move.type foo bar` renames `foo` to `bar`. names - `names foo` shows the hash and all known names for `foo`. - - names.global - `names.global foo` shows the hash and all known names for - `foo`. + `names foo` List all known names for `foo` in the current + branch. namespace.dependencies List the external dependencies of the specified namespace. diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 77350b1130..7675b0f748 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1435,8 +1435,6 @@ project/alice> names A Type Hash: #65mdg7015r Names: A A.inner.X - - Tip: Use `names.global` to see more results. ``` Bob's branch: diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index 27b986afb0..78d1f5c9f1 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -59,8 +59,6 @@ scratch/main> names x Hash: #pi25gcdv0o Names: some.otherplace.x - - Tip: Use `names.global` to see more results. -- We can search by hash, and see all aliases of that hash scratch/main> names #gjmq673r1v @@ -68,8 +66,6 @@ scratch/main> names #gjmq673r1v Term Hash: #gjmq673r1v Names: some.otherplace.y some.place.x somewhere.z - - Tip: Use `names.global` to see more results. -- Works with absolute names too scratch/main> names .some.place.x @@ -77,8 +73,6 @@ scratch/main> names .some.place.x Term Hash: #gjmq673r1v Names: some.otherplace.y some.place.x somewhere.z - - Tip: Use `names.global` to see more results. ``` `names.global` searches from the root, and absolutely qualifies results diff --git a/unison-src/transcripts/suffixes.output.md b/unison-src/transcripts/suffixes.output.md index 43aa678efd..a4cd5e3b02 100644 --- a/unison-src/transcripts/suffixes.output.md +++ b/unison-src/transcripts/suffixes.output.md @@ -165,8 +165,6 @@ scratch/main> names distributed.lib.baz.qux Term Hash: #nhup096n2s Names: lib.distributed.lib.baz.qux - - Tip: Use `names.global` to see more results. ``` ## Corner cases diff --git a/unison-src/transcripts/unique-type-churn.output.md b/unison-src/transcripts/unique-type-churn.output.md index ea00586436..661b0b65dd 100644 --- a/unison-src/transcripts/unique-type-churn.output.md +++ b/unison-src/transcripts/unique-type-churn.output.md @@ -60,8 +60,6 @@ scratch/main> names A Term Hash: #uj8oalgadr#0 Names: A.A - - Tip: Use `names.global` to see more results. ``` ``` unison @@ -99,8 +97,6 @@ scratch/main> names A Term Hash: #ufo5tuc7ho#0 Names: A.A - - Tip: Use `names.global` to see more results. ``` ``` unison @@ -140,7 +136,5 @@ scratch/main> names A Term Hash: #uj8oalgadr#0 Names: A.A - - Tip: Use `names.global` to see more results. ``` diff --git a/unison-src/transcripts/update-ignores-lib-namespace.output.md b/unison-src/transcripts/update-ignores-lib-namespace.output.md index dc03596d08..a91ca27840 100644 --- a/unison-src/transcripts/update-ignores-lib-namespace.output.md +++ b/unison-src/transcripts/update-ignores-lib-namespace.output.md @@ -62,7 +62,5 @@ scratch/main> names foo Term Hash: #9ntnotdp87 Names: foo - - Tip: Use `names.global` to see more results. ``` From f9db384df181ebfee974d9d2f574a417767189fc Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jul 2024 16:54:10 -0700 Subject: [PATCH 529/631] Fix transcripts --- unison-src/transcripts/find-command.md | 7 +--- unison-src/transcripts/find-command.output.md | 18 ++++----- unison-src/transcripts/names.md | 13 +++---- unison-src/transcripts/names.output.md | 37 +++++++++++++++---- 4 files changed, 44 insertions(+), 31 deletions(-) diff --git a/unison-src/transcripts/find-command.md b/unison-src/transcripts/find-command.md index 019903556a..56958476a5 100644 --- a/unison-src/transcripts/find-command.md +++ b/unison-src/transcripts/find-command.md @@ -34,15 +34,10 @@ Finding within a namespace ```ucm scratch/main> find bar --- Shows UUIDs --- scratch/main> find.global bar +scratch/other> debug.find.global bar scratch/main> find-in somewhere bar ``` ```ucm:error scratch/main> find baz ``` - -```ucm:error -scratch/main> find.global notHere -``` diff --git a/unison-src/transcripts/find-command.output.md b/unison-src/transcripts/find-command.output.md index fde54abfd1..4d3af86ad6 100644 --- a/unison-src/transcripts/find-command.output.md +++ b/unison-src/transcripts/find-command.output.md @@ -65,8 +65,15 @@ scratch/main> find bar 1. somewhere.bar : Nat --- Shows UUIDs --- scratch/main> find.global bar +scratch/other> debug.find.global bar + + Found results in scratch/main + + 1. .cat.lib.bar : Nat + 2. .lib.bar : Nat + 3. .somewhere.bar : Nat + + scratch/main> find-in somewhere bar 1. bar : Nat @@ -90,10 +97,3 @@ scratch/main> find baz namespace. ``` -``` ucm -scratch/main> find.global notHere - -⚠️ -I don't know how to find.global. Type `help` or `?` to get help. - -``` diff --git a/unison-src/transcripts/names.md b/unison-src/transcripts/names.md index 7780292f42..486ff35ec1 100644 --- a/unison-src/transcripts/names.md +++ b/unison-src/transcripts/names.md @@ -32,16 +32,13 @@ scratch/main> names #gjmq673r1v scratch/main> names .some.place.x ``` -`names.global` searches from the root, and absolutely qualifies results +`debug.names.global` searches from the root, and absolutely qualifies results - -TODO: swap this back to a 'ucm' block when names.global is re-implemented - -``` +```ucm -- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. -scratch/other> names.global x +scratch/other> debug.names.global x -- We can search by hash, and see all aliases of that hash in the codebase -scratch/other> names.global #gjmq673r1v +scratch/other> debug.names.global #gjmq673r1v -- We can search using an absolute name -scratch/other> names.global .some.place.x +scratch/other> debug.names.global .some.place.x ``` diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index 78d1f5c9f1..06db804432 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -75,16 +75,37 @@ scratch/main> names .some.place.x Names: some.otherplace.y some.place.x somewhere.z ``` -`names.global` searches from the root, and absolutely qualifies results +`debug.names.global` searches from the root, and absolutely qualifies results -TODO: swap this back to a 'ucm' block when names.global is re-implemented - -``` +``` ucm -- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. -scratch/other> names.global x +scratch/other> debug.names.global x + + Found results in scratch/main + + Terms + Hash: #gjmq673r1v + Names: some.otherplace.y some.place.x somewhere.z + + Hash: #pi25gcdv0o + Names: some.otherplace.x + -- We can search by hash, and see all aliases of that hash in the codebase -scratch/other> names.global #gjmq673r1v +scratch/other> debug.names.global #gjmq673r1v + + Found results in scratch/main + + Term + Hash: #gjmq673r1v + Names: some.otherplace.y some.place.x somewhere.z + -- We can search using an absolute name -scratch/other> names.global .some.place.x -``` +scratch/other> debug.names.global .some.place.x + Found results in scratch/main + + Term + Hash: #gjmq673r1v + Names: some.otherplace.y some.place.x somewhere.z + +``` From 8c9c3baad81d75ae68eecc4bde32de0309ac3a6c Mon Sep 17 00:00:00 2001 From: ChrisPenner Date: Thu, 1 Aug 2024 00:17:33 +0000 Subject: [PATCH 530/631] automatically run ormolu --- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 62ed7ea70e..0bd733b88a 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -972,6 +972,7 @@ notifyUser dir = \case -- defs in the codebase. In some cases it's fine for bindings to -- shadow codebase names, but you don't want it to capture them in -- the decompiled output. + let prettyBindings = P.bracket . P.lines $ P.wrap "The watch expression(s) reference these definitions:" From 286066592589f4d2e0a71c53fd16b8b4b7f918ab Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 1 Aug 2024 08:03:48 -0400 Subject: [PATCH 531/631] extract findConflictedAlias to Unison.Merge --- .../Codebase/Editor/HandleInput/Merge2.hs | 53 +--------------- .../src/Unison/Codebase/Editor/Output.hs | 2 +- .../src/Unison/CommandLine/OutputMessages.hs | 17 +++-- unison-merge/src/Unison/Merge.hs | 4 ++ .../src/Unison/Merge/FindConflictedAlias.hs | 63 +++++++++++++++++++ unison-merge/unison-merge.cabal | 1 + unison-src/transcripts/merge.output.md | 2 +- 7 files changed, 84 insertions(+), 58 deletions(-) create mode 100644 unison-merge/src/Unison/Merge/FindConflictedAlias.hs diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 5dffadf5fd..f614882f11 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -260,8 +260,8 @@ doMerge info = do -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias for_ ((,) <$> Merge.TwoWay mergeTarget mergeSource <*> diffs) \(who, diff) -> - whenJust (findConflictedAlias defns3.lca diff) \(name1, name2) -> - done (Output.MergeConflictedAliases who name1 name2) + whenJust (Merge.findConflictedAlias defns3.lca diff) do + done . Output.MergeConflictedAliases who -- Combine the LCA->Alice and LCA->Bob diffs together let diff = Merge.combineDiffs diffs @@ -751,55 +751,6 @@ findTemporaryBranchName projectId mergeSourceAndTarget = do <> Text.Builder.char '.' <> Text.Builder.decimal z --- @findConflictedAlias namespace diff@, given an old namespace and a diff to a new namespace, will return the first --- "conflicted alias" encountered (if any), where a "conflicted alias" is a pair of names that referred to the same --- thing in the old namespace, but different things in the new one. --- --- For example, if the old namespace was --- --- foo = #foo --- bar = #foo --- --- and the new namespace is --- --- foo = #baz --- bar = #qux --- --- then (foo, bar) is a conflicted alias. --- --- This function currently doesn't return whether the conflicted alias is a decl or a term, but it certainly could. -findConflictedAlias :: - (Ord term, Ord typ) => - Defns (BiMultimap term Name) (BiMultimap typ Name) -> - DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed term typ -> - Maybe (Name, Name) -findConflictedAlias defns diff = - asum [go defns.terms diff.terms, go defns.types diff.types] - where - go :: forall ref. (Ord ref) => BiMultimap ref Name -> Map Name (Merge.DiffOp (Merge.Synhashed ref)) -> Maybe (Name, Name) - go namespace diff = - asum (map f (Map.toList diff)) - where - f :: (Name, Merge.DiffOp (Merge.Synhashed ref)) -> Maybe (Name, Name) - f (name, op) = - case op of - Merge.DiffOp'Add _ -> Nothing - Merge.DiffOp'Delete _ -> Nothing - Merge.DiffOp'Update hashed1 -> - BiMultimap.lookupPreimage name namespace - & Set.delete name - & Set.toList - & map (g hashed1.new) - & asum - where - g :: Merge.Synhashed ref -> Name -> Maybe (Name, Name) - g hashed1 alias = - case Map.lookup alias diff of - Just (Merge.DiffOp'Update hashed2) | hashed1 == hashed2.new -> Nothing - -- If "foo" was updated but its alias "bar" was deleted, that's ok - Just (Merge.DiffOp'Delete _) -> Nothing - _ -> Just (name, alias) - -- Given a name like "base", try "base__1", then "base__2", etc, until we find a name that doesn't -- clash with any existing dependencies. getTwoFreshNames :: Set NameSegment -> NameSegment -> (NameSegment, NameSegment) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 0f0b9dac3c..16ff1b5984 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -420,7 +420,7 @@ data Output | MergeFailure !FilePath !MergeSourceAndTarget !ProjectBranchName | MergeSuccess !MergeSourceAndTarget | MergeSuccessFastForward !MergeSourceAndTarget - | MergeConflictedAliases !MergeSourceOrTarget !Name !Name + | MergeConflictedAliases !MergeSourceOrTarget !(Defn (Name, Name) (Name, Name)) | MergeConflictInvolvingBuiltin !Name | MergeDefnsInLib !MergeSourceOrTarget | InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 0194da8ea1..6e86e30f4b 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1345,17 +1345,24 @@ notifyUser dir = \case prettyProjectAndBranchName aliceAndBob.alice <> "was already up-to-date with" <> P.group (prettyMergeSource aliceAndBob.bob <> ".") - MergeConflictedAliases aliceOrBob name1 name2 -> + MergeConflictedAliases aliceOrBob defn -> pure $ P.wrap "Sorry, I wasn't able to perform the merge:" <> P.newline <> P.newline <> P.wrap ( "On the merge ancestor," - <> prettyName name1 - <> "and" - <> prettyName name2 - <> "were aliases for the same definition, but on" + <> ( let (isTerm, name1, name2) = + case defn of + TermDefn (n1, n2) -> (True, n1, n2) + TypeDefn (n1, n2) -> (False, n1, n2) + in prettyName name1 + <> "and" + <> prettyName name2 + <> "were aliases for the same" + <> P.group ((if isTerm then "term" else "type") <> ",") + ) + <> "but on" <> prettyMergeSourceOrTarget aliceOrBob <> "the names have different definitions currently. I'd need just a single new definition to use in their" <> "dependents when I merge." diff --git a/unison-merge/src/Unison/Merge.hs b/unison-merge/src/Unison/Merge.hs index 9ea6972712..fffe4b947b 100644 --- a/unison-merge/src/Unison/Merge.hs +++ b/unison-merge/src/Unison/Merge.hs @@ -15,6 +15,9 @@ module Unison.Merge oldNameBasedNamespaceDiff, nameBasedNamespaceDiff, + -- * Finding conflicted aliases + findConflictedAlias, + -- * Combining namespace diffs CombinedDiffOp (..), combineDiffs, @@ -55,6 +58,7 @@ import Unison.Merge.Diff (nameBasedNamespaceDiff, oldNameBasedNamespaceDiff) import Unison.Merge.DiffOp (DiffOp (..)) import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.EitherWayI (EitherWayI (..)) +import Unison.Merge.FindConflictedAlias (findConflictedAlias) import Unison.Merge.Libdeps (LibdepDiffOp (..), applyLibdepsDiff, diffLibdeps) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs) diff --git a/unison-merge/src/Unison/Merge/FindConflictedAlias.hs b/unison-merge/src/Unison/Merge/FindConflictedAlias.hs new file mode 100644 index 0000000000..4b343b59da --- /dev/null +++ b/unison-merge/src/Unison/Merge/FindConflictedAlias.hs @@ -0,0 +1,63 @@ +module Unison.Merge.FindConflictedAlias + ( findConflictedAlias, + ) +where + +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Unison.Merge.DiffOp (DiffOp (..)) +import Unison.Merge.Synhashed (Synhashed) +import Unison.Merge.Updated qualified +import Unison.Prelude +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defn (Defn (..)) +import Unison.Util.Defns (Defns (..), DefnsF3) + +-- @findConflictedAlias namespace diff@, given an old namespace and a diff to a new namespace, will return the first +-- "conflicted alias" encountered (if any), where a "conflicted alias" is a pair of names that referred to the same +-- thing in the old namespace, but different things in the new one. +-- +-- For example, if the old namespace was +-- +-- foo = #foo +-- bar = #foo +-- +-- and the new namespace is +-- +-- foo = #baz +-- bar = #qux +-- +-- then (foo, bar) is a conflicted alias. +findConflictedAlias :: + forall name term typ. + (Ord name, Ord term, Ord typ) => + Defns (BiMultimap term name) (BiMultimap typ name) -> + DefnsF3 (Map name) DiffOp Synhashed term typ -> + Maybe (Defn (name, name) (name, name)) +findConflictedAlias defns diff = + asum [TermDefn <$> go defns.terms diff.terms, TypeDefn <$> go defns.types diff.types] + where + go :: forall ref. (Ord ref) => BiMultimap ref name -> Map name (DiffOp (Synhashed ref)) -> Maybe (name, name) + go namespace diff = + asum (map f (Map.toList diff)) + where + f :: (name, DiffOp (Synhashed ref)) -> Maybe (name, name) + f (name, op) = + case op of + DiffOp'Add _ -> Nothing + DiffOp'Delete _ -> Nothing + DiffOp'Update hashed1 -> + BiMultimap.lookupPreimage name namespace + & Set.delete name + & Set.toList + & map (g hashed1.new) + & asum + where + g :: Synhashed ref -> name -> Maybe (name, name) + g hashed1 alias = + case Map.lookup alias diff of + Just (DiffOp'Update hashed2) | hashed1 == hashed2.new -> Nothing + -- If "foo" was updated but its alias "bar" was deleted, that's ok + Just (DiffOp'Delete _) -> Nothing + _ -> Just (name, alias) diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index a2ab14b2f6..aa3fc272d1 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -26,6 +26,7 @@ library Unison.Merge.DiffOp Unison.Merge.EitherWay Unison.Merge.EitherWayI + Unison.Merge.FindConflictedAlias Unison.Merge.Libdeps Unison.Merge.PartialDeclNameLookup Unison.Merge.PartitionCombinedDiffs diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 77350b1130..d17790ccf2 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1294,7 +1294,7 @@ project/alice> merge /bob Sorry, I wasn't able to perform the merge: On the merge ancestor, bar and foo were aliases for the same - definition, but on project/alice the names have different + term, but on project/alice the names have different definitions currently. I'd need just a single new definition to use in their dependents when I merge. From 2e328d2aaadef5310ef96a1f17cf09cf635e270e Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 1 Aug 2024 08:28:02 -0400 Subject: [PATCH 532/631] remove "old style" merge functions that take merge database as argument --- .../src/Unison/Util/BiMultimap.hs | 1 + unison-cli/src/Unison/Cli/Monad.hs | 8 ++ unison-cli/src/Unison/Cli/UpdateUtils.hs | 6 +- .../Codebase/Editor/HandleInput/Merge2.hs | 134 +++++++++++++----- .../Codebase/Editor/HandleInput/Update2.hs | 41 ++++-- unison-merge/src/Unison/Merge.hs | 7 +- .../src/Unison/Merge/DeclCoherencyCheck.hs | 106 -------------- 7 files changed, 147 insertions(+), 156 deletions(-) diff --git a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs index 9f39a23223..ee060e3ef7 100644 --- a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs +++ b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs @@ -170,6 +170,7 @@ withoutRan ys m = domain :: BiMultimap a b -> Map a (NESet b) domain = toMultimap +-- | /O(1)/. range :: BiMultimap a b -> Map b a range = toMapR diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index 398982889c..f712907fab 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -47,6 +47,7 @@ module Unison.Cli.Monad -- * Running transactions runTransaction, runTransactionWithRollback, + runTransactionWithRollback2, -- * Internal setMostRecentProjectPath, @@ -444,3 +445,10 @@ runTransactionWithRollback action = do Env {codebase} <- ask liftIO (Codebase.runTransactionWithRollback codebase \rollback -> Right <$> action (\output -> rollback (Left output))) & onLeftM returnEarly + +-- | Run a transaction that can abort early. +-- todo: rename to runTransactionWithRollback +runTransactionWithRollback2 :: ((forall void. a -> Sqlite.Transaction void) -> Sqlite.Transaction a) -> Cli a +runTransactionWithRollback2 action = do + env <- ask + liftIO (Codebase.runTransactionWithRollback env.codebase action) diff --git a/unison-cli/src/Unison/Cli/UpdateUtils.hs b/unison-cli/src/Unison/Cli/UpdateUtils.hs index 25284c28fd..8e64952228 100644 --- a/unison-cli/src/Unison/Cli/UpdateUtils.hs +++ b/unison-cli/src/Unison/Cli/UpdateUtils.hs @@ -235,13 +235,13 @@ hydrateDefns :: (Hash -> m [term]) -> (Hash -> m [typ]) -> DefnsF (Map name) TermReferenceId TypeReferenceId -> - m (DefnsF (Map name) term (TypeReferenceId, typ)) + m (DefnsF (Map name) (TermReferenceId, term) (TypeReferenceId, typ)) hydrateDefns getTermComponent getTypeComponent = do bitraverse hydrateTerms hydrateTypes where - hydrateTerms :: Map name TermReferenceId -> m (Map name term) + hydrateTerms :: Map name TermReferenceId -> m (Map name (TermReferenceId, term)) hydrateTerms terms = - hydrateDefns_ getTermComponent terms \_ _ -> id + hydrateDefns_ getTermComponent terms \_ -> (,) hydrateTypes :: Map name TypeReferenceId -> m (Map name (TypeReferenceId, typ)) hydrateTypes types = diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 5dffadf5fd..a7ac7770e3 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -15,6 +15,7 @@ module Unison.Codebase.Editor.HandleInput.Merge2 ) where +import Control.Lens (mapped) import Control.Monad.Reader (ask) import Data.Bifoldable (bifoldMap) import Data.Bitraversable (bitraverse) @@ -106,10 +107,14 @@ import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name +import Unison.Term (Term) +import Unison.Type (Type) import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.UnisonFile qualified as UnisonFile import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Conflicted (Conflicted) +import Unison.Util.Defn (Defn) import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3, alignDefnsWith, defnsAreEmpty, zipDefnsWith, zipDefnsWith3) import Unison.Util.Monoid qualified as Monoid import Unison.Util.Nametree (Nametree (..), flattenNametrees, unflattenNametree) @@ -224,37 +229,102 @@ doMerge info = do whenM (Cli.runTransaction (hasDefnsInLib branch)) do done (Output.MergeDefnsInLib who) - -- Load Alice/Bob/LCA definitions and decl name lookups - (defns3, declNameLookups, lcaDeclNameLookup) <- do - let emptyNametree = Nametree {value = Defns Map.empty Map.empty, children = Map.empty} - let loadDefns branch = - Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) - & onLeftM (done . Output.ConflictedDefn "merge") - let load = \case - Nothing -> pure (emptyNametree, Merge.DeclNameLookup Map.empty Map.empty) - Just (who, branch) -> do - defns <- loadDefns branch - declNameLookup <- - Cli.runTransaction (Merge.oldCheckDeclCoherency db.loadDeclNumConstructors defns) - & onLeftM (done . Output.IncoherentDeclDuringMerge who) - pure (defns, declNameLookup) - - (aliceDefns0, aliceDeclNameLookup) <- load (Just (mergeTarget, branches.alice)) - (bobDefns0, bobDeclNameLookup) <- load (Just (mergeSource, branches.bob)) - lcaDefns0 <- maybe (pure emptyNametree) loadDefns branches.lca - lcaDeclNameLookup <- Cli.runTransaction (Merge.oldLenientCheckDeclCoherency db.loadDeclNumConstructors lcaDefns0) - - let defns3 = flattenNametrees <$> Merge.ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} - let declNameLookups = Merge.TwoWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup} - - pure (defns3, declNameLookups, lcaDeclNameLookup) - - let defns = ThreeWay.forgetLca defns3 + -- Load Alice/Bob/LCA definitions + -- + -- FIXME: Oops, if this fails due to a conflicted name, we don't actually say where the conflicted name came from. + -- We should have a better error message (even though you can't do anything about conflicted names in the LCA). + nametrees3 :: Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) <- do + let action :: + (forall a. Defn (Conflicted Name Referent) (Conflicted Name TypeReference) -> Transaction a) -> + Transaction (Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference))) + action rollback = do + alice <- loadNamespaceDefinitions (referent2to1 db) branches.alice & onLeftM rollback + bob <- loadNamespaceDefinitions (referent2to1 db) branches.bob & onLeftM rollback + lca <- + case branches.lca of + Nothing -> pure Nametree {value = Defns Map.empty Map.empty, children = Map.empty} + Just lca -> loadNamespaceDefinitions (referent2to1 db) lca & onLeftM rollback + pure Merge.ThreeWay {alice, bob, lca} + Cli.runTransactionWithRollback2 (\rollback -> Right <$> action (rollback . Left)) + & onLeftM (done . Output.ConflictedDefn "merge") + + -- Flatten nametrees + let defns3 :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) + defns3 = + flattenNametrees <$> nametrees3 + + let defns2 :: Merge.TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) + defns2 = + ThreeWay.forgetLca defns3 + + -- Hydrate + hydratedDefns2 :: + Merge.TwoWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ) <- + Cli.runTransaction $ + traverse + ( hydrateDefns + (Codebase.unsafeGetTermComponent codebase) + Operations.expectDeclComponent + ) + ( let f = Map.mapMaybe Referent.toTermReferenceId . BiMultimap.range + g = Map.mapMaybe Reference.toId . BiMultimap.range + in bimap f g <$> ThreeWay.forgetLca defns3 + ) + + -- Make one big constructor count lookup for Alice+Bob's type decls + let numConstructors :: Map TypeReferenceId Int + numConstructors = + Map.empty + & f (Map.elems hydratedDefns2.alice.types) + & f (Map.elems hydratedDefns2.bob.types) + where + f :: [(TypeReferenceId, Decl Symbol Ann)] -> Map TypeReferenceId Int -> Map TypeReferenceId Int + f types acc = + List.foldl' + ( \acc (ref, decl) -> + Map.insert ref (DataDeclaration.constructorCount (DataDeclaration.asDataDecl decl)) acc + ) + acc + types + + -- Make Alice/Bob decl name lookups + declNameLookups <- do + alice <- + Merge.checkDeclCoherency nametrees3.alice numConstructors + & onLeft (done . Output.IncoherentDeclDuringMerge mergeTarget) + bob <- + Merge.checkDeclCoherency nametrees3.bob numConstructors + & onLeft (done . Output.IncoherentDeclDuringMerge mergeSource) + pure Merge.TwoWay {alice, bob} + + -- Make LCA decl name lookup + let lcaDeclNameLookup = + Merge.lenientCheckDeclCoherency nametrees3.lca numConstructors liftIO (debugFunctions.debugDefns defns3 declNameLookups lcaDeclNameLookup) -- Diff LCA->Alice and LCA->Bob - diffs <- Cli.runTransaction (Merge.oldNameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns3) + let diffs :: Merge.TwoWay (DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference) + diffs = + Merge.nameBasedNamespaceDiff + declNameLookups + lcaDeclNameLookup + defns3 + Defns + { terms = + foldMap + (List.foldl' (\acc (ref, (term, _)) -> Map.insert ref term acc) Map.empty . Map.elems . (.terms)) + hydratedDefns2, + types = + foldMap + (List.foldl' (\acc (ref, typ) -> Map.insert ref typ acc) Map.empty . Map.elems . (.types)) + hydratedDefns2 + } liftIO (debugFunctions.debugDiffs diffs) @@ -270,14 +340,14 @@ doMerge info = do -- Partition the combined diff into the conflicted things and the unconflicted things (conflicts, unconflicts) <- - Merge.partitionCombinedDiffs defns declNameLookups diff & onLeft \name -> + Merge.partitionCombinedDiffs (ThreeWay.forgetLca defns3) declNameLookups diff & onLeft \name -> done (Output.MergeConflictInvolvingBuiltin name) liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts) -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if there -- aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) - dependents <- Cli.runTransaction (identifyDependents defns conflicts unconflicts) + dependents <- Cli.runTransaction (identifyDependents defns2 conflicts unconflicts) liftIO (debugFunctions.debugDependents dependents) @@ -304,7 +374,7 @@ doMerge info = do defnsNames <&> \names -> PPED.makePPED (PPE.namer (names <> libdepsNames)) suffixifier where suffixifier = PPE.suffixifyByName (fold defnsNames <> libdepsNames) - let ppes = mkPpes (defnsToNames <$> defns) (Branch.toNames mergedLibdeps) + let ppes = mkPpes (defnsToNames <$> defns2) (Branch.toNames mergedLibdeps) hydratedThings <- do Cli.runTransaction do @@ -315,8 +385,8 @@ doMerge info = do let (renderedConflicts, renderedDependents) = unzip $ ( \declNameLookup (conflicts, dependents) ppe -> - let honk1 = renderDefnsForUnisonFile declNameLookup ppe - in (honk1 conflicts, honk1 dependents) + let render = renderDefnsForUnisonFile declNameLookup ppe . over (#terms . mapped) snd + in (render conflicts, render dependents) ) <$> declNameLookups <*> hydratedThings diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index cfa3d73c33..e0459c30cb 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -7,13 +7,15 @@ module Unison.Codebase.Editor.HandleInput.Update2 ) where -import Control.Monad.RWS (ask) +import Control.Lens (mapped) +import Control.Monad.Reader.Class (ask) import Data.Bifoldable (bifoldMap) +import Data.Foldable qualified as Foldable import Data.List qualified as List import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text -import U.Codebase.Reference (Reference, TermReferenceId) +import U.Codebase.Reference (Reference, Reference' (..), TermReferenceId) import U.Codebase.Sqlite.Operations qualified as Operations import Unison.Cli.Monad (Cli, Env (..)) import Unison.Cli.Monad qualified as Cli @@ -38,8 +40,7 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.SqliteCodebase.Operations qualified as Operations import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as Decl -import Unison.Merge.DeclCoherencyCheck (oldCheckDeclCoherency) -import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) +import Unison.Merge qualified as Merge import Unison.Name (Name) import Unison.Names (Names) import Unison.Names qualified as Names @@ -51,6 +52,7 @@ import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference (TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference (fromId) +import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) @@ -58,6 +60,8 @@ import Unison.Syntax.Name qualified as Name import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF import Unison.UnisonFile.Type (TypecheckedUnisonFile) +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty) import Unison.Util.Monoid qualified as Monoid import Unison.Util.Nametree (flattenNametrees) @@ -78,14 +82,33 @@ handleUpdate2 = do let namesIncludingLibdeps = Branch.toNames currentBranch0 -- Assert that the namespace doesn't have any conflicted names - defns <- + nametree <- narrowDefns (Branch.deepDefns currentBranch0ExcludingLibdeps) & onLeft (Cli.returnEarly . Output.ConflictedDefn "update") + let defns :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) + defns = + flattenNametrees nametree + + -- Get the number of constructors for every type declaration + numConstructors <- + Cli.runTransaction do + defns.types + & BiMultimap.dom + & Set.toList + & Foldable.foldlM + ( \acc -> \case + ReferenceBuiltin _ -> pure acc + ReferenceDerived ref -> do + num <- Operations.expectDeclNumConstructors ref + pure $! Map.insert ref num acc + ) + Map.empty + -- Assert that the namespace doesn't have any incoherent decls declNameLookup <- - Cli.runTransaction (oldCheckDeclCoherency Operations.expectDeclNumConstructors defns) - & onLeftM (Cli.returnEarly . Output.IncoherentDeclDuringUpdate) + Merge.checkDeclCoherency nametree numConstructors + & onLeft (Cli.returnEarly . Output.IncoherentDeclDuringUpdate) Cli.respond Output.UpdateLookingForDependents @@ -94,7 +117,7 @@ handleUpdate2 = do -- Get all dependents of things being updated dependents0 <- getNamespaceDependentsOf2 - (flattenNametrees defns) + (flattenNametrees nametree) (getExistingReferencesNamed termAndDeclNames (Branch.toNames currentBranch0ExcludingLibdeps)) -- Throw away the dependents that are shadowed by the file itself @@ -125,7 +148,7 @@ handleUpdate2 = do let ppe = makePPE 10 namesIncludingLibdeps (UF.typecheckedToNames tuf) dependents in makePrettyUnisonFile (Pretty.prettyUnisonFile ppe (UF.discardTypes tuf)) - (renderDefnsForUnisonFile declNameLookup ppe hydratedDependents) + (renderDefnsForUnisonFile declNameLookup ppe (over (#terms . mapped) snd hydratedDependents)) parsingEnv <- Cli.makeParsingEnv pp namesIncludingLibdeps diff --git a/unison-merge/src/Unison/Merge.hs b/unison-merge/src/Unison/Merge.hs index 9ea6972712..43bfc80e30 100644 --- a/unison-merge/src/Unison/Merge.hs +++ b/unison-merge/src/Unison/Merge.hs @@ -3,16 +3,13 @@ module Unison.Merge DeclNameLookup (..), PartialDeclNameLookup (..), IncoherentDeclReason (..), - oldCheckDeclCoherency, checkDeclCoherency, - oldLenientCheckDeclCoherency, lenientCheckDeclCoherency, IncoherentDeclReasons (..), checkAllDeclCoherency, -- * 3-way namespace diff DiffOp (..), - oldNameBasedNamespaceDiff, nameBasedNamespaceDiff, -- * Combining namespace diffs @@ -47,11 +44,9 @@ import Unison.Merge.DeclCoherencyCheck checkAllDeclCoherency, checkDeclCoherency, lenientCheckDeclCoherency, - oldCheckDeclCoherency, - oldLenientCheckDeclCoherency, ) import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) -import Unison.Merge.Diff (nameBasedNamespaceDiff, oldNameBasedNamespaceDiff) +import Unison.Merge.Diff (nameBasedNamespaceDiff) import Unison.Merge.DiffOp (DiffOp (..)) import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.EitherWayI (EitherWayI (..)) diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 02bbf6ec95..c927ce44d0 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -81,9 +81,7 @@ -- machinery was invented. module Unison.Merge.DeclCoherencyCheck ( IncoherentDeclReason (..), - oldCheckDeclCoherency, checkDeclCoherency, - oldLenientCheckDeclCoherency, lenientCheckDeclCoherency, -- * Getting all failures rather than just the first @@ -93,7 +91,6 @@ module Unison.Merge.DeclCoherencyCheck where import Control.Lens ((%=), (.=), _2) -import Control.Monad.Except qualified as Except import Control.Monad.State.Strict (StateT) import Control.Monad.State.Strict qualified as State import Control.Monad.Trans.State.Strict (State) @@ -137,23 +134,6 @@ data IncoherentDeclReason | IncoherentDeclReason'StrayConstructor !TypeReferenceId !Name deriving stock (Show) -oldCheckDeclCoherency :: - (Monad m) => - (TypeReferenceId -> m Int) -> - Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> - m (Either IncoherentDeclReason DeclNameLookup) -oldCheckDeclCoherency loadDeclNumConstructors nametree = - Except.runExceptT $ - checkDeclCoherencyWith - (lift . loadDeclNumConstructors) - OnIncoherentDeclReasons - { onConstructorAlias = \x y z -> Except.throwError (IncoherentDeclReason'ConstructorAlias x y z), - onMissingConstructorName = \x -> Except.throwError (IncoherentDeclReason'MissingConstructorName x), - onNestedDeclAlias = \x y -> Except.throwError (IncoherentDeclReason'NestedDeclAlias x y), - onStrayConstructor = \x y -> Except.throwError (IncoherentDeclReason'StrayConstructor x y) - } - nametree - checkDeclCoherency :: (HasCallStack) => Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> @@ -360,92 +340,6 @@ checkDeclCoherencyWith_DoTypes2 loadDeclNumConstructors callbacks go prefix chil 0 -> UninhabitedDecl n -> InhabitedDecl (typeName, emptyConstructorNames n) --- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns partial decl name lookup, --- which doesn't require a name for every constructor, and allows a constructor with a nameless decl. --- --- This function exists merely to extract a best-effort name mapping for the LCA of a merge. We require Alice and Bob to --- have coherent decls, but their LCA is out of the user's control and may have incoherent decls, and whether or not it --- does, we still need to compute *some* syntactic hash for its decls. -oldLenientCheckDeclCoherency :: - forall m. - (Monad m) => - (TypeReferenceId -> m Int) -> - Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> - m PartialDeclNameLookup -oldLenientCheckDeclCoherency loadDeclNumConstructors = - fmap (view #declNameLookup) - . (`State.execStateT` LenientDeclCoherencyCheckState Map.empty (PartialDeclNameLookup Map.empty Map.empty)) - . go [] - where - go :: - [NameSegment] -> - (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> - StateT LenientDeclCoherencyCheckState m () - go prefix (Nametree defns children) = do - for_ (Map.toList defns.terms) \case - (_, Referent.Ref _) -> pure () - (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure () - (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do - #expectedConstructors %= Map.adjust (Map.map (lenientRecordConstructorName conId (fullName name))) typeRef - - childrenWeWentInto <- - forMaybe (Map.toList defns.types) \case - (_, ReferenceBuiltin _) -> pure Nothing - (name, ReferenceDerived typeRef) -> do - whatHappened <- do - let recordNewDecl :: m (WhatHappened (Map Name ConstructorNames)) - recordNewDecl = - loadDeclNumConstructors typeRef <&> \case - 0 -> UninhabitedDecl - n -> InhabitedDecl (Map.singleton typeName (emptyConstructorNames n)) - state <- State.get - lift (getCompose (Map.upsertF (\_ -> Compose recordNewDecl) typeRef state.expectedConstructors)) - case whatHappened of - UninhabitedDecl -> do - #declNameLookup . #declToConstructors %= Map.insert typeName [] - pure Nothing - InhabitedDecl expectedConstructors1 -> do - let child = Map.findWithDefault (Nametree (Defns Map.empty Map.empty) Map.empty) name children - #expectedConstructors .= expectedConstructors1 - go (name : prefix) child - state <- State.get - let (constructorNames0, expectedConstructors) = - Map.alterF f typeRef state.expectedConstructors - where - f :: - Maybe (Map Name ConstructorNames) -> - (ConstructorNames, Maybe (Map Name ConstructorNames)) - f = - -- fromJust is safe here because we upserted `typeRef` key above - -- deleteLookupJust is safe here because we upserted `typeName` key above - fromJust - >>> Map.deleteLookupJust typeName - >>> over _2 \m -> if Map.null m then Nothing else Just m - - constructorNames :: [Maybe Name] - constructorNames = - IntMap.elems constructorNames0 - - #expectedConstructors .= expectedConstructors - #declNameLookup . #constructorToDecl %= \constructorToDecl -> - List.foldl' - ( \acc -> \case - Nothing -> acc - Just constructorName -> Map.insert constructorName typeName acc - ) - constructorToDecl - constructorNames - #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames - pure (Just name) - where - typeName = fullName name - - let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto - for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child - where - fullName name = - Name.fromReverseSegments (name :| prefix) - -- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns partial decl name lookup, -- which doesn't require a name for every constructor, and allows a constructor with a nameless decl. -- From 1c0d1a1ed1bacf1dcaa341821cfcf60ac8726f05 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 1 Aug 2024 09:06:39 -0400 Subject: [PATCH 533/631] delete MergeDatabase --- .../src/Unison/Codebase/Type.hs | 17 +- .../Codebase/Editor/HandleInput/Merge2.hs | 53 ++-- unison-merge/src/Unison/Merge/Database.hs | 91 ------- unison-merge/src/Unison/Merge/Diff.hs | 231 +++++------------- unison-merge/unison-merge.cabal | 1 - 5 files changed, 96 insertions(+), 297 deletions(-) delete mode 100644 unison-merge/src/Unison/Merge/Database.hs diff --git a/parser-typechecker/src/Unison/Codebase/Type.hs b/parser-typechecker/src/Unison/Codebase/Type.hs index af69f555cd..5949224214 100644 --- a/parser-typechecker/src/Unison/Codebase/Type.hs +++ b/parser-typechecker/src/Unison/Codebase/Type.hs @@ -9,14 +9,13 @@ module Unison.Codebase.Type where import U.Codebase.HashTags (CausalHash) -import U.Codebase.Reference qualified as V2 import Unison.Codebase.Branch (Branch) import Unison.CodebasePath (CodebasePath) import Unison.ConstructorType qualified as CT import Unison.DataDeclaration (Decl) import Unison.Hash (Hash) import Unison.Prelude -import Unison.Reference (Reference, TypeReference) +import Unison.Reference (Reference, TypeReference, TermReferenceId, TypeReferenceId) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.ShortHash (ShortHash) @@ -31,27 +30,27 @@ data Codebase m v a = Codebase -- -- Note that it is possible to call 'putTerm', then 'getTerm', and receive @Nothing@, per the semantics of -- 'putTerm'. - getTerm :: Reference.Id -> Sqlite.Transaction (Maybe (Term v a)), + getTerm :: TermReferenceId -> Sqlite.Transaction (Maybe (Term v a)), -- | Get the type of a user-defined term. -- -- Note that it is possible to call 'putTerm', then 'getTypeOfTermImpl', and receive @Nothing@, per the semantics of -- 'putTerm'. - getTypeOfTermImpl :: Reference.Id -> Sqlite.Transaction (Maybe (Type v a)), + getTypeOfTermImpl :: TermReferenceId -> Sqlite.Transaction (Maybe (Type v a)), -- | Get a type declaration. -- -- Note that it is possible to call 'putTypeDeclaration', then 'getTypeDeclaration', and receive @Nothing@, per the -- semantics of 'putTypeDeclaration'. - getTypeDeclaration :: Reference.Id -> Sqlite.Transaction (Maybe (Decl v a)), + getTypeDeclaration :: TypeReferenceId -> Sqlite.Transaction (Maybe (Decl v a)), -- | Get the type of a given decl. - getDeclType :: V2.Reference -> Sqlite.Transaction CT.ConstructorType, + getDeclType :: TypeReference -> Sqlite.Transaction CT.ConstructorType, -- | Enqueue the put of a user-defined term (with its type) into the codebase, if it doesn't already exist. The -- implementation may choose to delay the put until all of the term's (and its type's) references are stored as -- well. - putTerm :: Reference.Id -> Term v a -> Type v a -> Sqlite.Transaction (), + putTerm :: TermReferenceId -> Term v a -> Type v a -> Sqlite.Transaction (), putTermComponent :: Hash -> [(Term v a, Type v a)] -> Sqlite.Transaction (), -- | Enqueue the put of a type declaration into the codebase, if it doesn't already exist. The implementation may -- choose to delay the put until all of the type declaration's references are stored as well. - putTypeDeclaration :: Reference.Id -> Decl v a -> Sqlite.Transaction (), + putTypeDeclaration :: TypeReferenceId -> Decl v a -> Sqlite.Transaction (), putTypeDeclarationComponent :: Hash -> [Decl v a] -> Sqlite.Transaction (), -- getTermComponent :: Hash -> m (Maybe [Term v a]), getTermComponentWithTypes :: Hash -> Sqlite.Transaction (Maybe [(Term v a, Type v a)]), @@ -66,7 +65,7 @@ data Codebase m v a = Codebase -- | Copy a branch and all of its dependencies from this codebase into the given codebase. syncToDirectory :: CodebasePath -> Branch m -> m (), -- | @getWatch k r@ returns watch result @t@ that was previously put by @putWatch k r t@. - getWatch :: WK.WatchKind -> Reference.Id -> Sqlite.Transaction (Maybe (Term v a)), + getWatch :: WK.WatchKind -> TermReferenceId -> Sqlite.Transaction (Maybe (Term v a)), -- | Get the set of user-defined terms-or-constructors that have the given type. termsOfTypeImpl :: Reference -> Sqlite.Transaction (Set Referent.Id), -- | Get the set of user-defined terms-or-constructors mention the given type anywhere in their signature. diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index a7ac7770e3..edfe6a0f56 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -68,12 +68,12 @@ import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache) import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions import Unison.Codebase.SqliteCodebase.Operations qualified as Operations +import Unison.ConstructorType (ConstructorType) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration import Unison.Debug qualified as Debug import Unison.Hash qualified as Hash import Unison.Merge qualified as Merge -import Unison.Merge.Database (MergeDatabase (..), makeMergeDatabase, referent2to1) import Unison.Merge.DeclNameLookup (expectConstructorNames) import Unison.Merge.EitherWayI qualified as EitherWayI import Unison.Merge.Synhashed qualified as Synhashed @@ -187,7 +187,7 @@ doMerge info = do let mergeTarget = MergeSourceOrTarget'Target aliceBranchNames let mergeSourceAndTarget = MergeSourceAndTarget {alice = aliceBranchNames, bob = info.bob.source} - Cli.Env {codebase} <- ask + env <- ask finalOutput <- Cli.label \done -> do @@ -197,22 +197,20 @@ doMerge info = do -- Otherwise, if LCA == alice (so alice is behind bob), then we could fast forward to bob, so we're done. when (info.lca.causalHash == Just info.alice.causalHash) do - bobBranch <- liftIO (Codebase.expectBranchForHash codebase info.bob.causalHash) + bobBranch <- liftIO (Codebase.expectBranchForHash env.codebase info.bob.causalHash) _ <- Cli.updateAt info.description (PP.projectBranchRoot info.alice.projectAndBranch) (\_aliceBranch -> bobBranch) done (Output.MergeSuccessFastForward mergeSourceAndTarget) - -- Create a bunch of cached database lookup functions - db <- makeMergeDatabase codebase - -- Load Alice/Bob/LCA causals - causals <- Cli.runTransaction do - traverse - Operations.expectCausalBranchByCausalHash - Merge.TwoOrThreeWay - { alice = info.alice.causalHash, - bob = info.bob.causalHash, - lca = info.lca.causalHash - } + causals <- + Cli.runTransaction do + traverse + Operations.expectCausalBranchByCausalHash + Merge.TwoOrThreeWay + { alice = info.alice.causalHash, + bob = info.bob.causalHash, + lca = info.lca.causalHash + } liftIO (debugFunctions.debugCausals causals) @@ -234,16 +232,17 @@ doMerge info = do -- FIXME: Oops, if this fails due to a conflicted name, we don't actually say where the conflicted name came from. -- We should have a better error message (even though you can't do anything about conflicted names in the LCA). nametrees3 :: Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) <- do + let referent2to1 = Conversions.referent2to1 (Codebase.getDeclType env.codebase) let action :: (forall a. Defn (Conflicted Name Referent) (Conflicted Name TypeReference) -> Transaction a) -> Transaction (Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference))) action rollback = do - alice <- loadNamespaceDefinitions (referent2to1 db) branches.alice & onLeftM rollback - bob <- loadNamespaceDefinitions (referent2to1 db) branches.bob & onLeftM rollback + alice <- loadNamespaceDefinitions referent2to1 branches.alice & onLeftM rollback + bob <- loadNamespaceDefinitions referent2to1 branches.bob & onLeftM rollback lca <- case branches.lca of Nothing -> pure Nametree {value = Defns Map.empty Map.empty, children = Map.empty} - Just lca -> loadNamespaceDefinitions (referent2to1 db) lca & onLeftM rollback + Just lca -> loadNamespaceDefinitions referent2to1 lca & onLeftM rollback pure Merge.ThreeWay {alice, bob, lca} Cli.runTransactionWithRollback2 (\rollback -> Right <$> action (rollback . Left)) & onLeftM (done . Output.ConflictedDefn "merge") @@ -268,7 +267,7 @@ doMerge info = do Cli.runTransaction $ traverse ( hydrateDefns - (Codebase.unsafeGetTermComponent codebase) + (Codebase.unsafeGetTermComponent env.codebase) Operations.expectDeclComponent ) ( let f = Map.mapMaybe Referent.toTermReferenceId . BiMultimap.range @@ -366,7 +365,9 @@ doMerge info = do mergedLibdeps <- Cli.runTransaction do libdeps <- loadLibdeps branches - libdepsToBranch0 db (Merge.applyLibdepsDiff getTwoFreshNames libdeps (Merge.diffLibdeps libdeps)) + libdepsToBranch0 + (Codebase.getDeclType env.codebase) + (Merge.applyLibdepsDiff getTwoFreshNames libdeps (Merge.diffLibdeps libdeps)) -- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names let mkPpes :: Merge.TwoWay Names -> Names -> Merge.TwoWay PrettyPrintEnvDecl @@ -379,7 +380,7 @@ doMerge info = do hydratedThings <- do Cli.runTransaction do for ((,) <$> conflicts <*> dependents) \(conflicts1, dependents1) -> - let hydrate = hydrateDefns (Codebase.unsafeGetTermComponent codebase) Operations.expectDeclComponent + let hydrate = hydrateDefns (Codebase.unsafeGetTermComponent env.codebase) Operations.expectDeclComponent in (,) <$> hydrate conflicts1 <*> hydrate dependents1 let (renderedConflicts, renderedDependents) = @@ -410,7 +411,7 @@ doMerge info = do renderedConflicts renderedDependents - let stageOneBranch = defnsAndLibdepsToBranch0 codebase stageOne mergedLibdeps + let stageOneBranch = defnsAndLibdepsToBranch0 env.codebase stageOne mergedLibdeps maybeTypecheckedUnisonFile <- let thisMergeHasConflicts = @@ -424,7 +425,7 @@ doMerge info = do parseAndTypecheck prettyUnisonFile parsingEnv let parents = - (\causal -> (causal.causalHash, Codebase.expectBranchForHash codebase causal.causalHash)) <$> causals + (\causal -> (causal.causalHash, Codebase.expectBranchForHash env.codebase causal.causalHash)) <$> causals case maybeTypecheckedUnisonFile of Nothing -> do @@ -443,7 +444,7 @@ doMerge info = do liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) pure (Output.MergeFailure scratchFilePath mergeSourceAndTarget temporaryBranchName) Just tuf -> do - Cli.runTransaction (Codebase.addDefsToCodebase codebase tuf) + Cli.runTransaction (Codebase.addDefsToCodebase env.codebase tuf) let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch Cli.updateProjectBranchRoot_ info.alice.projectAndBranch.branch @@ -904,8 +905,8 @@ getTwoFreshNames names name0 = mangled i = NameSegment (NameSegment.toUnescapedText name0 <> "__" <> tShow i) -libdepsToBranch0 :: MergeDatabase -> Map NameSegment (V2.CausalBranch Transaction) -> Transaction (Branch0 Transaction) -libdepsToBranch0 db libdeps = do +libdepsToBranch0 :: (Reference -> Transaction ConstructorType) -> Map NameSegment (V2.CausalBranch Transaction) -> Transaction (Branch0 Transaction) +libdepsToBranch0 loadDeclType libdeps = do let branch :: V2.Branch Transaction branch = V2.Branch @@ -919,7 +920,7 @@ libdepsToBranch0 db libdeps = do -- It would probably be better to reuse the codebase's branch cache. -- FIXME how slow/bad is this without that branch cache? branchCache <- Sqlite.unsafeIO newBranchCache - Conversions.branch2to1 branchCache db.loadDeclType branch + Conversions.branch2to1 branchCache loadDeclType branch typecheckedUnisonFileToBranchAdds :: TypecheckedUnisonFile Symbol Ann -> [(Path, Branch0 m -> Branch0 m)] typecheckedUnisonFileToBranchAdds tuf = do diff --git a/unison-merge/src/Unison/Merge/Database.hs b/unison-merge/src/Unison/Merge/Database.hs deleted file mode 100644 index 47d40954e6..0000000000 --- a/unison-merge/src/Unison/Merge/Database.hs +++ /dev/null @@ -1,91 +0,0 @@ -module Unison.Merge.Database - ( MergeDatabase (..), - referent2to1, - makeMergeDatabase, - ) -where - -import Data.Map.Strict qualified as Map -import Data.Text qualified as Text -import U.Codebase.Branch (CausalBranch) -import U.Codebase.HashTags (CausalHash) -import U.Codebase.Reference (Reference' (..), TermReferenceId, TypeReference, TypeReferenceId) -import U.Codebase.Referent (Referent) -import U.Codebase.Referent qualified as Referent -import U.Codebase.Sqlite.Operations qualified as Operations -import Unison.Builtin qualified as Builtins -import Unison.Codebase (Codebase) -import Unison.Codebase qualified as Codebase -import Unison.Codebase.SqliteCodebase.Operations qualified as Operations (expectDeclComponent) -import Unison.ConstructorReference (GConstructorReference (..)) -import Unison.ConstructorType (ConstructorType) -import Unison.DataDeclaration qualified as V1 (Decl) -import Unison.DataDeclaration qualified as V1.Decl -import Unison.Hash (Hash) -import Unison.Parser.Ann qualified as V1 (Ann) -import Unison.Prelude -import Unison.Referent qualified as V1 (Referent) -import Unison.Referent qualified as V1.Referent -import Unison.Sqlite (Transaction) -import Unison.Sqlite qualified as Sqlite -import Unison.Symbol qualified as V1 (Symbol) -import Unison.Term qualified as V1 (Term) -import Unison.Type qualified as V1 (Type) -import Unison.Util.Cache qualified as Cache - ------------------------------------------------------------------------------------------------------------------------- --- Merge database - --- A mini record-of-functions that contains just the (possibly backed by a cache) database queries used in merge. -data MergeDatabase = MergeDatabase - { loadCausal :: CausalHash -> Transaction (CausalBranch Transaction), - loadDeclNumConstructors :: TypeReferenceId -> Transaction Int, - loadDeclType :: TypeReference -> Transaction ConstructorType, - loadV1Decl :: TypeReferenceId -> Transaction (V1.Decl V1.Symbol V1.Ann), - loadV1DeclComponent :: Hash -> Transaction [V1.Decl V1.Symbol V1.Ann], - loadV1Term :: TermReferenceId -> Transaction (V1.Term V1.Symbol V1.Ann), - loadV1TermComponent :: Hash -> Transaction [(V1.Term V1.Symbol V1.Ann, V1.Type V1.Symbol V1.Ann)] - } - -makeMergeDatabase :: (MonadIO m) => Codebase IO V1.Symbol V1.Ann -> m MergeDatabase -makeMergeDatabase codebase = liftIO do - -- Create a bunch of cached database lookup functions - loadCausal <- do - cache <- Cache.semispaceCache 1024 - pure (Sqlite.cacheTransaction cache Operations.expectCausalBranchByCausalHash) - loadDeclNumConstructors <- do - cache <- Cache.semispaceCache 1024 - pure (Sqlite.cacheTransaction cache Operations.expectDeclNumConstructors) - loadV1Decl <- do - cache <- Cache.semispaceCache 1024 - pure (Sqlite.cacheTransaction cache (Codebase.unsafeGetTypeDeclaration codebase)) - -- Since loading a decl type loads the decl and projects out the decl type, just reuse the loadDecl cache - let loadDeclType ref = - case ref of - ReferenceBuiltin name -> - Map.lookup ref Builtins.builtinConstructorType - & maybe (error ("Unknown builtin: " ++ Text.unpack name)) pure - ReferenceDerived refId -> V1.Decl.constructorType <$> loadV1Decl refId - loadV1Term <- do - cache <- Cache.semispaceCache 1024 - pure (Sqlite.cacheTransaction cache (Codebase.unsafeGetTerm codebase)) - let loadV1TermComponent = Codebase.unsafeGetTermComponent codebase - let loadV1DeclComponent = Operations.expectDeclComponent - pure - MergeDatabase - { loadCausal, - loadDeclNumConstructors, - loadDeclType, - loadV1Decl, - loadV1DeclComponent, - loadV1Term, - loadV1TermComponent - } - --- Convert a v2 referent (missing decl type) to a v1 referent. -referent2to1 :: MergeDatabase -> Referent -> Transaction V1.Referent -referent2to1 MergeDatabase {loadDeclType} = \case - Referent.Con typeRef conId -> do - declTy <- loadDeclType typeRef - pure (V1.Referent.Con (ConstructorReference typeRef conId) declTy) - Referent.Ref termRef -> pure (V1.Referent.Ref termRef) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index 9bcb7ca2eb..f96834b15a 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -1,10 +1,8 @@ module Unison.Merge.Diff - ( oldNameBasedNamespaceDiff, - nameBasedNamespaceDiff, + ( nameBasedNamespaceDiff, ) where -import Data.Bitraversable (bitraverse) import Data.Map.Strict qualified as Map import Data.Semialign (alignWith) import Data.Set qualified as Set @@ -15,12 +13,11 @@ import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration import Unison.Hash (Hash (Hash)) import Unison.HashQualifiedPrime qualified as HQ' -import Unison.Merge.Database (MergeDatabase (..)) import Unison.Merge.DeclNameLookup (DeclNameLookup) import Unison.Merge.DeclNameLookup qualified as DeclNameLookup import Unison.Merge.DiffOp (DiffOp (..)) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) -import Unison.Merge.Synhash +import Unison.Merge.Synhash qualified as Synhash import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.ThreeWay (ThreeWay (..)) import Unison.Merge.ThreeWay qualified as ThreeWay @@ -34,7 +31,6 @@ import Unison.PrettyPrintEnv qualified as Ppe import Unison.Reference (Reference' (..), TermReference, TermReferenceId, TypeReferenceId) import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name import Unison.Term (Term) @@ -42,33 +38,6 @@ import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith) --- | @nameBasedNamespaceDiff db declNameLookups defns@ returns Alice's and Bob's name-based namespace diffs, each in the --- form: --- --- > terms :: Map Name (DiffOp (Synhashed Referent)) --- > types :: Map Name (DiffOp (Synhashed TypeReference)) --- --- where each name is paired with its diff-op (added, deleted, or updated), relative to the LCA between Alice and Bob's --- branches. If the hash of a name did not change, it will not appear in the map. -oldNameBasedNamespaceDiff :: - MergeDatabase -> - TwoWay DeclNameLookup -> - PartialDeclNameLookup -> - ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - Transaction (TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)) -oldNameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns = do - lcaHashes <- synhashLcaDefns db ppe lcaDeclNameLookup defns.lca - hashes <- sequence (synhashDefns db ppe <$> declNameLookups <*> ThreeWay.forgetLca defns) - pure (diffNamespaceDefns lcaHashes <$> hashes) - where - ppe :: PrettyPrintEnv - ppe = - -- The order between Alice and Bob isn't important here for syntactic hashing; not sure right now if it matters - -- that the LCA is added last - deepNamespaceDefinitionsToPpe defns.alice - `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.bob - `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.lca - -- | @nameBasedNamespaceDiff db declNameLookups defns@ returns Alice's and Bob's name-based namespace diffs, each in the -- form: -- @@ -84,9 +53,9 @@ nameBasedNamespaceDiff :: Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) -> TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) nameBasedNamespaceDiff declNameLookups lcaDeclNameLookup defns hydratedDefns = - let lcaHashes = synhashLcaDefns2 ppe lcaDeclNameLookup defns.lca hydratedDefns - hashes = synhashDefns2 ppe hydratedDefns <$> declNameLookups <*> ThreeWay.forgetLca defns - in diffNamespaceDefns lcaHashes <$> hashes + let lcaHashes = synhashLcaDefns ppe lcaDeclNameLookup defns.lca hydratedDefns + hashes = synhashDefns ppe hydratedDefns <$> declNameLookups <*> ThreeWay.forgetLca defns + in diffHashedNamespaceDefns lcaHashes <$> hashes where ppe :: PrettyPrintEnv ppe = @@ -96,47 +65,36 @@ nameBasedNamespaceDiff declNameLookups lcaDeclNameLookup defns hydratedDefns = `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.bob `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.lca -synhashLcaDefns :: - MergeDatabase -> - PrettyPrintEnv -> - PartialDeclNameLookup -> - Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> - Transaction (DefnsF2 (Map Name) Synhashed Referent TypeReference) -synhashLcaDefns db ppe declNameLookup = - synhashDefnsWith hashReferent hashType +diffHashedNamespaceDefns :: + DefnsF2 (Map Name) Synhashed term typ -> + DefnsF2 (Map Name) Synhashed term typ -> + DefnsF3 (Map Name) DiffOp Synhashed term typ +diffHashedNamespaceDefns = + zipDefnsWith f f where - -- For the LCA only, if we don't have a name for every constructor, or we don't have a name for a decl, that's okay, - -- just use a dummy syntactic hash (e.g. where we return `Hash mempty` below in two places). - -- - -- This is safe and correct; Alice/Bob can't have such a decl (it violates a merge precondition), so there's no risk - -- that we accidentally get an equal hash and classify a real update as unchanged. + f :: Map Name (Synhashed ref) -> Map Name (Synhashed ref) -> Map Name (DiffOp (Synhashed ref)) + f old new = + Map.mapMaybe id (alignWith g old new) - hashReferent :: Name -> Referent -> Transaction Hash - hashReferent name = \case - Referent.Con (ConstructorReference ref _) _ -> - case Map.lookup name declNameLookup.constructorToDecl of - Nothing -> pure (Hash mempty) -- see note above - Just declName -> hashType declName ref - Referent.Ref ref -> synhashTerm db.loadV1Term ppe ref + g :: (Eq x) => These x x -> Maybe (DiffOp x) + g = \case + This old -> Just (DiffOp'Delete old) + That new -> Just (DiffOp'Add new) + These old new + | old == new -> Nothing + | otherwise -> Just (DiffOp'Update Updated {old, new}) - hashType :: Name -> TypeReference -> Transaction Hash - hashType name = \case - ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) - ReferenceDerived ref -> - case sequence (declNameLookup.declToConstructors Map.! name) of - Nothing -> pure (Hash mempty) -- see note above - Just names -> do - decl <- loadDeclWithGoodConstructorNames db names ref - pure (synhashDerivedDecl ppe name decl) +------------------------------------------------------------------------------------------------------------------------ +-- Syntactic hashing -synhashLcaDefns2 :: +synhashLcaDefns :: PrettyPrintEnv -> PartialDeclNameLookup -> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) -> DefnsF2 (Map Name) Synhashed Referent TypeReference -synhashLcaDefns2 ppe declNameLookup defns hydratedDefns = - synhashDefnsWith2 hashReferent hashType defns +synhashLcaDefns ppe declNameLookup defns hydratedDefns = + synhashDefnsWith hashReferent hashType defns where -- For the LCA only, if we don't have a name for every constructor, or we don't have a name for a decl, that's okay, -- just use a dummy syntactic hash (e.g. where we return `Hash mempty` below in two places). @@ -150,24 +108,24 @@ synhashLcaDefns2 ppe declNameLookup defns hydratedDefns = case Map.lookup name declNameLookup.constructorToDecl of Nothing -> Hash mempty -- see note above Just declName -> hashType declName ref - Referent.Ref ref -> hashTermReference ppe hydratedDefns.terms ref + Referent.Ref ref -> synhashTermReference ppe hydratedDefns.terms ref hashType :: Name -> TypeReference -> Hash hashType name = \case - ReferenceBuiltin builtin -> synhashBuiltinDecl builtin + ReferenceBuiltin builtin -> Synhash.synhashBuiltinDecl builtin ReferenceDerived ref -> case sequence (declNameLookup.declToConstructors Map.! name) of Nothing -> Hash mempty -- see note above - Just names -> hashDerivedDecl ppe hydratedDefns.types names name ref + Just names -> synhashDerivedDecl ppe hydratedDefns.types names name ref -synhashDefns2 :: +synhashDefns :: PrettyPrintEnv -> Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) -> DeclNameLookup -> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> DefnsF2 (Map Name) Synhashed Referent TypeReference -synhashDefns2 ppe hydratedDefns declNameLookup = - synhashDefnsWith2 hashReferent hashType +synhashDefns ppe hydratedDefns declNameLookup = + synhashDefnsWith hashReferent hashType where hashReferent :: Name -> Referent -> Hash hashReferent name = \case @@ -178,76 +136,47 @@ synhashDefns2 ppe hydratedDefns declNameLookup = -- For example, if Alice updates `type Foo = Bar Nat` to `type Foo = Bar Nat Nat`, we want different synhashes on -- both the type (Foo) and the constructor (Foo.Bar). Referent.Con (ConstructorReference ref _) _ -> hashType (DeclNameLookup.expectDeclName declNameLookup name) ref - Referent.Ref ref -> hashTermReference ppe hydratedDefns.terms ref + Referent.Ref ref -> synhashTermReference ppe hydratedDefns.terms ref hashType :: Name -> TypeReference -> Hash hashType name = \case - ReferenceBuiltin builtin -> synhashBuiltinDecl builtin + ReferenceBuiltin builtin -> Synhash.synhashBuiltinDecl builtin ReferenceDerived ref -> - hashDerivedDecl ppe hydratedDefns.types (DeclNameLookup.expectConstructorNames declNameLookup name) name ref + synhashDerivedDecl ppe hydratedDefns.types (DeclNameLookup.expectConstructorNames declNameLookup name) name ref -hashDerivedDecl :: PrettyPrintEnv -> Map TypeReferenceId (Decl Symbol Ann) -> [Name] -> Name -> TypeReferenceId -> Hash -hashDerivedDecl ppe declsById names name ref = +synhashDerivedDecl :: + PrettyPrintEnv -> + Map TypeReferenceId (Decl Symbol Ann) -> + [Name] -> + Name -> + TypeReferenceId -> + Hash +synhashDerivedDecl ppe declsById names name ref = declsById & expectDecl ref & DataDeclaration.setConstructorNames (map Name.toVar names) - & synhashDerivedDecl ppe name + & Synhash.synhashDerivedDecl ppe name -hashTermReference :: PrettyPrintEnv -> Map TermReferenceId (Term Symbol Ann) -> TermReference -> Hash -hashTermReference ppe termsById = \case - ReferenceBuiltin builtin -> synhashBuiltinTerm builtin - ReferenceDerived ref -> synhashDerivedTerm ppe (expectTerm ref termsById) +synhashTermReference :: PrettyPrintEnv -> Map TermReferenceId (Term Symbol Ann) -> TermReference -> Hash +synhashTermReference ppe termsById = \case + ReferenceBuiltin builtin -> Synhash.synhashBuiltinTerm builtin + ReferenceDerived ref -> Synhash.synhashDerivedTerm ppe (expectTerm ref termsById) -synhashDefns :: - MergeDatabase -> - PrettyPrintEnv -> - DeclNameLookup -> - Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> - Transaction (DefnsF2 (Map Name) Synhashed Referent TypeReference) -synhashDefns db ppe declNameLookup = - -- FIXME: use cache so we only synhash each thing once - synhashDefnsWith hashReferent hashType - where - hashReferent :: Name -> Referent -> Transaction Hash - hashReferent name = \case - -- We say that a referent constructor *in the namespace* (distinct from a referent that is in a term body) has a - -- synhash that is simply equal to the synhash of its type declaration. This is because the type declaration and - -- constructors are changed in lock-step: it is not possible to change one, but not the other. - -- - -- For example, if Alice updates `type Foo = Bar Nat` to `type Foo = Bar Nat Nat`, we want different synhashes on - -- both the type (Foo) and the constructor (Foo.Bar). - Referent.Con (ConstructorReference ref _) _ -> hashType (DeclNameLookup.expectDeclName declNameLookup name) ref - Referent.Ref ref -> synhashTerm db.loadV1Term ppe ref - - hashType :: Name -> TypeReference -> Transaction Hash - hashType name = \case - ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) - ReferenceDerived ref -> do - decl <- loadDeclWithGoodConstructorNames db (DeclNameLookup.expectConstructorNames declNameLookup name) ref - pure (synhashDerivedDecl ppe name decl) - -loadDeclWithGoodConstructorNames :: MergeDatabase -> [Name] -> TypeReferenceId -> Transaction (Decl Symbol Ann) -loadDeclWithGoodConstructorNames db names = - fmap (DataDeclaration.setConstructorNames (map Name.toVar names)) . db.loadV1Decl - -diffNamespaceDefns :: - DefnsF2 (Map Name) Synhashed term typ -> - DefnsF2 (Map Name) Synhashed term typ -> - DefnsF3 (Map Name) DiffOp Synhashed term typ -diffNamespaceDefns = - zipDefnsWith f f +synhashDefnsWith :: + (Name -> term -> Hash) -> + (Name -> typ -> Hash) -> + Defns (BiMultimap term Name) (BiMultimap typ Name) -> + DefnsF2 (Map Name) Synhashed term typ +synhashDefnsWith hashTerm hashType = do + bimap + (Map.mapWithKey hashTerm1 . BiMultimap.range) + (Map.mapWithKey hashType1 . BiMultimap.range) where - f :: Map Name (Synhashed ref) -> Map Name (Synhashed ref) -> Map Name (DiffOp (Synhashed ref)) - f old new = - Map.mapMaybe id (alignWith g old new) + hashTerm1 name term = + Synhashed (hashTerm name term) term - g :: (Eq x) => These x x -> Maybe (DiffOp x) - g = \case - This old -> Just (DiffOp'Delete old) - That new -> Just (DiffOp'Add new) - These old new - | old == new -> Nothing - | otherwise -> Just (DiffOp'Update Updated {old, new}) + hashType1 name typ = + Synhashed (hashType name typ) typ ------------------------------------------------------------------------------------------------------------------------ -- Pretty-print env helpers @@ -262,44 +191,6 @@ deepNamespaceDefinitionsToPpe Defns {terms, types} = & Set.lookupMin & maybe [] \name -> [(HQ'.NameOnly name, HQ'.NameOnly name)] ------------------------------------------------------------------------------------------------------------------------- --- Syntactic hashing helpers - -synhashDefnsWith :: - (Monad m) => - (Name -> term -> m Hash) -> - (Name -> typ -> m Hash) -> - Defns (BiMultimap term Name) (BiMultimap typ Name) -> - m (DefnsF2 (Map Name) Synhashed term typ) -synhashDefnsWith hashTerm hashType = do - bitraverse - (Map.traverseWithKey hashTerm1 . BiMultimap.range) - (Map.traverseWithKey hashType1 . BiMultimap.range) - where - hashTerm1 name term = do - hash <- hashTerm name term - pure (Synhashed hash term) - - hashType1 name typ = do - hash <- hashType name typ - pure (Synhashed hash typ) - -synhashDefnsWith2 :: - (Name -> term -> Hash) -> - (Name -> typ -> Hash) -> - Defns (BiMultimap term Name) (BiMultimap typ Name) -> - DefnsF2 (Map Name) Synhashed term typ -synhashDefnsWith2 hashTerm hashType = do - bimap - (Map.mapWithKey hashTerm1 . BiMultimap.range) - (Map.mapWithKey hashType1 . BiMultimap.range) - where - hashTerm1 name term = - Synhashed (hashTerm name term) term - - hashType1 name typ = - Synhashed (hashType name typ) typ - ------------------------------------------------------------------------------------------------------------------------ -- Looking up terms and decls that we expect to be there diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index a2ab14b2f6..04e174bab4 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -19,7 +19,6 @@ library exposed-modules: Unison.Merge Unison.Merge.CombineDiffs - Unison.Merge.Database Unison.Merge.DeclCoherencyCheck Unison.Merge.DeclNameLookup Unison.Merge.Diff From 4803d446f1e361cf33c85daf698c6d58e31c796d Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 1 Aug 2024 10:51:32 -0600 Subject: [PATCH 534/631] Add some description to the new transcripts --- unison-src/transcripts/fix1327.md | 4 ++++ unison-src/transcripts/fix1327.output.md | 4 ++++ unison-src/transcripts/fix3977.md | 2 ++ unison-src/transcripts/fix3977.output.md | 2 ++ 4 files changed, 12 insertions(+) diff --git a/unison-src/transcripts/fix1327.md b/unison-src/transcripts/fix1327.md index 764d0f3ac5..45c1e11e92 100644 --- a/unison-src/transcripts/fix1327.md +++ b/unison-src/transcripts/fix1327.md @@ -4,6 +4,10 @@ foo = 4 bar = 5 ``` +`alias.many` should be able to consume the numbered args produced by `ls`. Previously, `ls` would produce absolute paths, but `alias.many` required relative ones. + +Now `ls` returns a pair of the absolute search directory and the result relative to that search directory, so it can be used in both absolute and relative contexts. + ```ucm scratch/main> add scratch/main> ls diff --git a/unison-src/transcripts/fix1327.output.md b/unison-src/transcripts/fix1327.output.md index fa542e6ed2..9e0234725a 100644 --- a/unison-src/transcripts/fix1327.output.md +++ b/unison-src/transcripts/fix1327.output.md @@ -18,6 +18,10 @@ bar = 5 foo : ##Nat ``` +`alias.many` should be able to consume the numbered args produced by `ls`. Previously, `ls` would produce absolute paths, but `alias.many` required relative ones. + +Now `ls` returns a pair of the absolute search directory and the result relative to that search directory, so it can be used in both absolute and relative contexts. + ``` ucm scratch/main> add diff --git a/unison-src/transcripts/fix3977.md b/unison-src/transcripts/fix3977.md index 8ad82cbce9..fc1fc1c718 100644 --- a/unison-src/transcripts/fix3977.md +++ b/unison-src/transcripts/fix3977.md @@ -2,6 +2,8 @@ scratch/main> builtins.merge ``` +Pretty-printing previously didn’t compensate for extra characters on a line that was about to be wrapped, resulting in a line-break without sufficient indentation. Now pretty-printing indents based on the starting column of the wrapped expression, not simply “prevIndent + 2”. + ```unison:hide failure msg context = Failure (typeLink Unit) msg (Any context) diff --git a/unison-src/transcripts/fix3977.output.md b/unison-src/transcripts/fix3977.output.md index 79a68eedc4..d4451d8c94 100644 --- a/unison-src/transcripts/fix3977.output.md +++ b/unison-src/transcripts/fix3977.output.md @@ -1,3 +1,5 @@ +Pretty-printing previously didn’t compensate for extra characters on a line that was about to be wrapped, resulting in a line-break without sufficient indentation. Now pretty-printing indents based on the starting column of the wrapped expression, not simply “prevIndent + 2”. + ``` unison failure msg context = Failure (typeLink Unit) msg (Any context) From acc63bff2b0a8cd7a212cd177f393bf2d4f74a40 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 1 Aug 2024 16:23:31 -0400 Subject: [PATCH 535/631] generalize findConflictedAlias a bit --- unison-merge/package.yaml | 1 + .../src/Unison/Merge/FindConflictedAlias.hs | 18 +++++++++++------- unison-merge/unison-merge.cabal | 1 + 3 files changed, 13 insertions(+), 7 deletions(-) diff --git a/unison-merge/package.yaml b/unison-merge/package.yaml index c31adfcd5b..5a81188e65 100644 --- a/unison-merge/package.yaml +++ b/unison-merge/package.yaml @@ -79,6 +79,7 @@ default-extensions: - OverloadedRecordDot - OverloadedStrings - PatternSynonyms + - QuantifiedConstraints - RankNTypes - ScopedTypeVariables - TupleSections diff --git a/unison-merge/src/Unison/Merge/FindConflictedAlias.hs b/unison-merge/src/Unison/Merge/FindConflictedAlias.hs index 4b343b59da..bf7222d4dd 100644 --- a/unison-merge/src/Unison/Merge/FindConflictedAlias.hs +++ b/unison-merge/src/Unison/Merge/FindConflictedAlias.hs @@ -6,7 +6,6 @@ where import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Unison.Merge.DiffOp (DiffOp (..)) -import Unison.Merge.Synhashed (Synhashed) import Unison.Merge.Updated qualified import Unison.Prelude import Unison.Util.BiMultimap (BiMultimap) @@ -30,19 +29,24 @@ import Unison.Util.Defns (Defns (..), DefnsF3) -- -- then (foo, bar) is a conflicted alias. findConflictedAlias :: - forall name term typ. - (Ord name, Ord term, Ord typ) => + forall name synhashed term typ. + (Ord name, forall ref. Eq (synhashed ref), Ord term, Ord typ) => Defns (BiMultimap term name) (BiMultimap typ name) -> - DefnsF3 (Map name) DiffOp Synhashed term typ -> + DefnsF3 (Map name) DiffOp synhashed term typ -> Maybe (Defn (name, name) (name, name)) findConflictedAlias defns diff = asum [TermDefn <$> go defns.terms diff.terms, TypeDefn <$> go defns.types diff.types] where - go :: forall ref. (Ord ref) => BiMultimap ref name -> Map name (DiffOp (Synhashed ref)) -> Maybe (name, name) + go :: + forall ref. + (Eq (synhashed ref), Ord ref) => + BiMultimap ref name -> + Map name (DiffOp (synhashed ref)) -> + Maybe (name, name) go namespace diff = asum (map f (Map.toList diff)) where - f :: (name, DiffOp (Synhashed ref)) -> Maybe (name, name) + f :: (name, DiffOp (synhashed ref)) -> Maybe (name, name) f (name, op) = case op of DiffOp'Add _ -> Nothing @@ -54,7 +58,7 @@ findConflictedAlias defns diff = & map (g hashed1.new) & asum where - g :: Synhashed ref -> name -> Maybe (name, name) + g :: synhashed ref -> name -> Maybe (name, name) g hashed1 alias = case Map.lookup alias diff of Just (DiffOp'Update hashed2) | hashed1 == hashed2.new -> Nothing diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index aa3fc272d1..69654bb3a5 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -69,6 +69,7 @@ library OverloadedRecordDot OverloadedStrings PatternSynonyms + QuantifiedConstraints RankNTypes ScopedTypeVariables TupleSections From 9100b97e91a3dd8df44038162072082162ec4c9a Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Thu, 1 Aug 2024 17:49:45 -0400 Subject: [PATCH 536/631] tweak output messages --- .../Unison/Codebase/Editor/HandleInput/Update2.hs | 4 ++-- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 13 +++++++------ unison-src/transcripts/update-on-conflict.output.md | 5 +++-- .../update-suffixifies-properly.output.md | 4 ++-- ...-term-with-dependent-to-different-type.output.md | 4 ++-- .../update-test-watch-roundtrip.output.md | 4 ++-- ...type-delete-constructor-with-dependent.output.md | 4 ++-- .../update-type-delete-record-field.output.md | 4 ++-- .../update-type-with-dependent-term.output.md | 4 ++-- ...-with-dependent-type-to-different-kind.output.md | 4 ++-- 10 files changed, 26 insertions(+), 24 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 858003c431..f2650da4d3 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -156,9 +156,9 @@ makePrettyUnisonFile originalFile dependents = originalFile <> Pretty.newline <> Pretty.newline - <> "-- The definitions below are not compatible with the updated definitions above." + <> "-- The definitions below no longer typecheck with the changes above." <> Pretty.newline - <> "-- Please fix the errors and run `update` again." + <> "-- Please fix the errors and try `update` again." <> Pretty.newline <> Pretty.newline <> ( dependents diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 0194da8ea1..f4aaac02e7 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2095,11 +2095,12 @@ notifyUser dir = \case <> P.text filename ConflictedDefn operation defn -> pure . P.wrap $ - ( case defn of - TermDefn (Conflicted name _refs) -> "The term name" <> prettyName name <> "is ambiguous." - TypeDefn (Conflicted name _refs) -> "The type name" <> prettyName name <> "is ambiguous." + ( "This branch has more than one" <> case defn of + TermDefn (Conflicted name _refs) -> "term with the name" <> P.group (P.backticked (prettyName name) <> ".") + TypeDefn (Conflicted name _refs) -> "type with the name" <> P.group (P.backticked (prettyName name) <> ".") ) - <> "Please resolve the ambiguity, then try to" + <> P.newline + <> "Please delete or rename all but one of them, then try the" <> P.text operation <> "again." IncoherentDeclDuringMerge aliceOrBob reason -> @@ -2614,7 +2615,7 @@ renderNameConflicts hashLen conflictedNames = do prettyConflictedTerms <- showConflictedNames "term" conflictedTermNames pure $ Monoid.unlessM (null allConflictedNames) $ - P.callout "❓" . P.sep "\n\n" . P.nonEmpty $ + P.callout "❓" . P.linesSpaced . P.nonEmpty $ [ prettyConflictedTypes, prettyConflictedTerms, tip $ @@ -2635,7 +2636,7 @@ renderNameConflicts hashLen conflictedNames = do where showConflictedNames :: Pretty -> Map Name [HQ.HashQualified Name] -> Numbered Pretty showConflictedNames thingKind conflictedNames = - P.lines <$> do + P.linesSpaced <$> do for (Map.toList conflictedNames) \(name, hashes) -> do prettyConflicts <- for hashes \hash -> do n <- addNumberedArg $ SA.HashQualified hash diff --git a/unison-src/transcripts/update-on-conflict.output.md b/unison-src/transcripts/update-on-conflict.output.md index d2a5f2de22..9beda9810c 100644 --- a/unison-src/transcripts/update-on-conflict.output.md +++ b/unison-src/transcripts/update-on-conflict.output.md @@ -59,7 +59,8 @@ x = 3 ``` ucm scratch/main> update - The term name x is ambiguous. Please resolve the ambiguity, - then try to update again. + This branch has more than one term with the name `x`. Please + delete or rename all but one of them, then try the update + again. ``` diff --git a/unison-src/transcripts/update-suffixifies-properly.output.md b/unison-src/transcripts/update-suffixifies-properly.output.md index 8e71e3a904..e8a30e7f38 100644 --- a/unison-src/transcripts/update-suffixifies-properly.output.md +++ b/unison-src/transcripts/update-suffixifies-properly.output.md @@ -72,8 +72,8 @@ myproject/main> update ``` unison:added-by-ucm scratch.u foo = +30 --- The definitions below are not compatible with the updated definitions above. --- Please fix the errors and run `update` again. +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. bar : Nat bar = diff --git a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md index 646d559fbd..c1737627d4 100644 --- a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md +++ b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md @@ -71,8 +71,8 @@ scratch/main> update foo : Int foo = +5 --- The definitions below are not compatible with the updated definitions above. --- Please fix the errors and run `update` again. +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. bar : Nat bar = diff --git a/unison-src/transcripts/update-test-watch-roundtrip.output.md b/unison-src/transcripts/update-test-watch-roundtrip.output.md index 9caf54c2f3..45ddaaa3f8 100644 --- a/unison-src/transcripts/update-test-watch-roundtrip.output.md +++ b/unison-src/transcripts/update-test-watch-roundtrip.output.md @@ -53,8 +53,8 @@ scratch/main> update ``` unison:added-by-ucm scratch.u foo n = "hello, world!" --- The definitions below are not compatible with the updated definitions above. --- Please fix the errors and run `update` again. +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. test> mynamespace.foo.test = n = 2 diff --git a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md index eee51c7060..085d0826a7 100644 --- a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md +++ b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md @@ -67,8 +67,8 @@ scratch/main> update ``` unison:added-by-ucm scratch.u type Foo = Bar Nat --- The definitions below are not compatible with the updated definitions above. --- Please fix the errors and run `update` again. +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. foo : Foo -> Nat foo = cases diff --git a/unison-src/transcripts/update-type-delete-record-field.output.md b/unison-src/transcripts/update-type-delete-record-field.output.md index fe6038c1c3..fb3f7a3c99 100644 --- a/unison-src/transcripts/update-type-delete-record-field.output.md +++ b/unison-src/transcripts/update-type-delete-record-field.output.md @@ -106,8 +106,8 @@ scratch/main> find.verbose ``` unison:added-by-ucm scratch.u type Foo = { bar : Nat } --- The definitions below are not compatible with the updated definitions above. --- Please fix the errors and run `update` again. +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. Foo.baz : Foo -> Int Foo.baz = cases Foo _ baz -> baz diff --git a/unison-src/transcripts/update-type-with-dependent-term.output.md b/unison-src/transcripts/update-type-with-dependent-term.output.md index e200341bb1..c334a5e853 100644 --- a/unison-src/transcripts/update-type-with-dependent-term.output.md +++ b/unison-src/transcripts/update-type-with-dependent-term.output.md @@ -62,8 +62,8 @@ scratch/main> update ``` unison:added-by-ucm scratch.u type Foo = Bar Nat Nat --- The definitions below are not compatible with the updated definitions above. --- Please fix the errors and run `update` again. +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. incrFoo : Foo -> Foo incrFoo = cases Bar n -> Bar (n Nat.+ 1) diff --git a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md index dcb3c96d24..bff59176e3 100644 --- a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md +++ b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md @@ -60,8 +60,8 @@ scratch/main> update ``` unison:added-by-ucm scratch.u type Foo a = Bar Nat a --- The definitions below are not compatible with the updated definitions above. --- Please fix the errors and run `update` again. +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. type Baz = Qux Foo From 8041e25b839905e982565927a2bd47dff67f68cf Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 1 Aug 2024 18:15:02 -0400 Subject: [PATCH 537/631] tease apart identifyDependents --- .../Codebase/Editor/HandleInput/Merge2.hs | 135 ++++++++---------- unison-merge/src/Unison/Merge/Unconflicts.hs | 17 ++- 2 files changed, 75 insertions(+), 77 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index edfe6a0f56..4b7a595d7d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -18,8 +18,6 @@ where import Control.Lens (mapped) import Control.Monad.Reader (ask) import Data.Bifoldable (bifoldMap) -import Data.Bitraversable (bitraverse) -import Data.Foldable qualified as Foldable import Data.List qualified as List import Data.Map.Strict qualified as Map import Data.Semialign (align, unzip, zipWith) @@ -346,7 +344,10 @@ doMerge info = do -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if there -- aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) - dependents <- Cli.runTransaction (identifyDependents defns2 conflicts unconflicts) + let soloUpdatesAndDeletes = Unconflicts.soloUpdatesAndDeletes unconflicts + let coreDependencies = identifyCoreDependencies defns2 conflicts soloUpdatesAndDeletes + dependents0 <- Cli.runTransaction (for ((,) <$> defns2 <*> coreDependencies) (uncurry getNamespaceDependentsOf2)) + let dependents = filterDependents conflicts soloUpdatesAndDeletes dependents0 liftIO (debugFunctions.debugDependents dependents) @@ -664,93 +665,77 @@ nametreeToBranch0 nametree = rel2star rel = Star2.Star2 {fact = Relation.dom rel, d1 = rel, d2 = Relation.empty} --- FIXME: let's come up with a better term for "dependencies" in the implementation of this function -identifyDependents :: +identifyCoreDependencies :: Merge.TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> - DefnsF Merge.Unconflicts Referent TypeReference -> - Transaction (Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId)) -identifyDependents defns conflicts unconflicts = do - let -- The other person's (i.e. with "Alice" and "Bob" swapped) solo-deleted and solo-updated names - theirSoloUpdatesAndDeletes :: Merge.TwoWay (DefnsF Set Name Name) - theirSoloUpdatesAndDeletes = - TwoWay.swap (unconflictedSoloDeletedNames <> unconflictedSoloUpdatedNames) - where - unconflictedSoloDeletedNames :: Merge.TwoWay (DefnsF Set Name Name) - unconflictedSoloDeletedNames = - bitraverse Unconflicts.soloDeletedNames Unconflicts.soloDeletedNames unconflicts - - unconflictedSoloUpdatedNames :: Merge.TwoWay (DefnsF Set Name Name) - unconflictedSoloUpdatedNames = - bitraverse Unconflicts.soloUpdatedNames Unconflicts.soloUpdatedNames unconflicts - - let dependencies :: Merge.TwoWay (Set Reference) - dependencies = - fold - [ -- One source of dependencies: Alice's versions of Bob's unconflicted deletes and updates, and vice-versa. - -- - -- This is name-based: if Bob updates the *name* "foo", then we go find the thing that Alice calls "foo" (if - -- anything), no matter what its hash is. - defnsReferences - <$> ( zipDefnsWith BiMultimap.restrictRan BiMultimap.restrictRan - <$> theirSoloUpdatesAndDeletes - <*> defns - ), - -- The other source of dependencies: Alice's own conflicted things, and ditto for Bob. - -- - -- An example: suppose Alice has foo#alice and Bob has foo#bob, so foo is conflicted. Furthermore, suppose - -- Alice has bar#bar that depends on foo#alice. - -- - -- We want Alice's #alice to be considered a dependency, so that when we go off and find dependents of these - -- dependencies to put in the scratch file for type checking and propagation, we find bar#bar. - -- - -- Note that this is necessary even if bar#bar is unconflicted! We don't want bar#bar to be put directly - -- into the namespace / parsing context for the conflicted merge, because it has an unnamed reference on - -- foo#alice. It rather ought to be in the scratchfile alongside the conflicted foo#alice and foo#bob, so - -- that when that conflict is resolved, it will propagate to bar. - let f :: (Foldable t) => t Reference.Id -> Set Reference - f = - List.foldl' (\acc ref -> Set.insert (Reference.DerivedId ref) acc) Set.empty . Foldable.toList - in bifoldMap f f <$> conflicts - ] - - dependents0 <- - for ((,) <$> defns <*> dependencies) \(defns1, dependencies1) -> - getNamespaceDependentsOf2 defns1 dependencies1 + Merge.TwoWay (DefnsF Set Name Name) -> + Merge.TwoWay (Set Reference) +identifyCoreDependencies defns conflicts soloUpdatesAndDeletes = do + fold + [ -- One source of dependencies: Alice's versions of Bob's unconflicted deletes and updates, and vice-versa. + -- + -- This is name-based: if Bob updates the *name* "foo", then we go find the thing that Alice calls "foo" (if + -- anything), no matter what its hash is. + defnsReferences + <$> ( zipDefnsWith BiMultimap.restrictRan BiMultimap.restrictRan + <$> TwoWay.swap soloUpdatesAndDeletes + <*> defns + ), + -- The other source of dependencies: Alice's own conflicted things, and ditto for Bob. + -- + -- An example: suppose Alice has foo#alice and Bob has foo#bob, so foo is conflicted. Furthermore, suppose + -- Alice has bar#bar that depends on foo#alice. + -- + -- We want Alice's #alice to be considered a dependency, so that when we go off and find dependents of these + -- dependencies to put in the scratch file for type checking and propagation, we find bar#bar. + -- + -- Note that this is necessary even if bar#bar is unconflicted! We don't want bar#bar to be put directly + -- into the namespace / parsing context for the conflicted merge, because it has an unnamed reference on + -- foo#alice. It rather ought to be in the scratchfile alongside the conflicted foo#alice and foo#bob, so + -- that when that conflict is resolved, it will propagate to bar. + let f :: Map Name Reference.Id -> Set Reference + f = + List.foldl' (\acc ref -> Set.insert (Reference.DerivedId ref) acc) Set.empty . Map.elems + in bifoldMap f f <$> conflicts + ] +filterDependents :: + (Ord name) => + Merge.TwoWay (DefnsF (Map name) term typ) -> + Merge.TwoWay (DefnsF Set name name) -> + Merge.TwoWay (DefnsF (Map name) term typ) -> + Merge.TwoWay (DefnsF (Map name) term typ) +filterDependents conflicts soloUpdatesAndDeletes dependents0 = -- There is some subset of Alice's dependents (and ditto for Bob of course) that we don't ultimately want/need to put -- into the scratch file: those for which any of the following are true: -- -- 1. It is Alice-conflicted (since we only want to return *unconflicted* things). -- 2. It was deleted by Bob. -- 3. It was updated by Bob and not updated by Alice. - let dependents1 :: Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) - dependents1 = + let dependents1 = zipDefnsWith Map.withoutKeys Map.withoutKeys <$> dependents0 - <*> ((bimap Map.keysSet Map.keysSet <$> conflicts) <> theirSoloUpdatesAndDeletes) + <*> ((bimap Map.keysSet Map.keysSet <$> conflicts) <> TwoWay.swap soloUpdatesAndDeletes) - -- Of the remaining dependents, it's still possible that the maps are not disjoint. But whenever the same name key - -- exists in Alice's and Bob's dependents, the value will either be equal (by Unison hash)... - -- - -- { alice = { terms = {"foo" => #alice} } } - -- { bob = { terms = {"foo" => #alice} } } - -- - -- ...or synhash-equal (i.e. the term or type received different auto-propagated updates)... - -- - -- { alice = { terms = {"foo" => #alice} } } - -- { bob = { terms = {"foo" => #bob} } } - -- - -- So, we can arbitrarily keep Alice's, because they will render the same. - -- - -- { alice = { terms = {"foo" => #alice} } } - -- { bob = { terms = {} } } - let dependents2 :: Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) + -- Of the remaining dependents, it's still possible that the maps are not disjoint. But whenever the same name key + -- exists in Alice's and Bob's dependents, the value will either be equal (by Unison hash)... + -- + -- { alice = { terms = {"foo" => #alice} } } + -- { bob = { terms = {"foo" => #alice} } } + -- + -- ...or synhash-equal (i.e. the term or type received different auto-propagated updates)... + -- + -- { alice = { terms = {"foo" => #alice} } } + -- { bob = { terms = {"foo" => #bob} } } + -- + -- So, we can arbitrarily keep Alice's, because they will render the same. + -- + -- { alice = { terms = {"foo" => #alice} } } + -- { bob = { terms = {} } } dependents2 = dependents1 & over #bob \bob -> zipDefnsWith Map.difference Map.difference bob dependents1.alice - - pure dependents2 + in dependents2 makeStageOne :: Merge.TwoWay Merge.DeclNameLookup -> diff --git a/unison-merge/src/Unison/Merge/Unconflicts.hs b/unison-merge/src/Unison/Merge/Unconflicts.hs index e5411189a1..c83590cfd7 100644 --- a/unison-merge/src/Unison/Merge/Unconflicts.hs +++ b/unison-merge/src/Unison/Merge/Unconflicts.hs @@ -2,8 +2,7 @@ module Unison.Merge.Unconflicts ( Unconflicts (..), empty, apply, - soloDeletedNames, - soloUpdatedNames, + soloUpdatesAndDeletes, ) where @@ -13,6 +12,8 @@ import Unison.Merge.TwoWayI (TwoWayI (..)) import Unison.Merge.TwoWayI qualified as TwoWayI import Unison.Name (Name) import Unison.Prelude hiding (empty) +import Unison.Util.Defns (DefnsF) +import Data.Bitraversable (bitraverse) data Unconflicts v = Unconflicts { adds :: !(TwoWayI (Map Name v)), @@ -44,6 +45,18 @@ apply unconflicts = applyDeletes = (`Map.withoutKeys` foldMap Map.keysSet unconflicts.deletes) +soloUpdatesAndDeletes :: DefnsF Unconflicts term typ -> TwoWay (DefnsF Set Name Name) +soloUpdatesAndDeletes unconflicts = + unconflictedSoloDeletedNames <> unconflictedSoloUpdatedNames + where + unconflictedSoloDeletedNames :: TwoWay (DefnsF Set Name Name) + unconflictedSoloDeletedNames = + bitraverse soloDeletedNames soloDeletedNames unconflicts + + unconflictedSoloUpdatedNames :: TwoWay (DefnsF Set Name Name) + unconflictedSoloUpdatedNames = + bitraverse soloUpdatedNames soloUpdatedNames unconflicts + soloDeletedNames :: Unconflicts v -> TwoWay (Set Name) soloDeletedNames = fmap Map.keysSet . TwoWayI.forgetBoth . view #deletes From 3f73d7fd896b132b1f4b1b2171715d5ee5ffcf6e Mon Sep 17 00:00:00 2001 From: mitchellwrosen Date: Thu, 1 Aug 2024 22:16:38 +0000 Subject: [PATCH 538/631] automatically run ormolu --- unison-merge/src/Unison/Merge/Unconflicts.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-merge/src/Unison/Merge/Unconflicts.hs b/unison-merge/src/Unison/Merge/Unconflicts.hs index c83590cfd7..39d19e4a4b 100644 --- a/unison-merge/src/Unison/Merge/Unconflicts.hs +++ b/unison-merge/src/Unison/Merge/Unconflicts.hs @@ -6,6 +6,7 @@ module Unison.Merge.Unconflicts ) where +import Data.Bitraversable (bitraverse) import Data.Map.Strict qualified as Map import Unison.Merge.TwoWay (TwoWay) import Unison.Merge.TwoWayI (TwoWayI (..)) @@ -13,7 +14,6 @@ import Unison.Merge.TwoWayI qualified as TwoWayI import Unison.Name (Name) import Unison.Prelude hiding (empty) import Unison.Util.Defns (DefnsF) -import Data.Bitraversable (bitraverse) data Unconflicts v = Unconflicts { adds :: !(TwoWayI (Map Name v)), From c5a66d5608849dbe2f4d4b9164cae34ade4c6ca1 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Mon, 29 Jul 2024 16:49:21 -0600 Subject: [PATCH 539/631] Simplify Doc parser from `State` to `Reader` --- .../src/Unison/Syntax/Lexer/Unison.hs | 2 +- unison-syntax/src/Unison/Syntax/Parser/Doc.hs | 44 +++++++++---------- 2 files changed, 23 insertions(+), 23 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs index 8a6c20d1a8..c641786505 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -355,7 +355,7 @@ doc2 = do (docTok, closeTok) <- local (\env -> env {inLayout = False}) do - body <- Doc.doc typeOrTerm lexemes' . P.lookAhead $ () <$ lit "}}" + body <- Doc.doc typeOrTerm lexemes' . P.lookAhead $ lit "}}" closeStart <- posP lit "}}" closeEnd <- posP diff --git a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs index 8ba6840dd2..1a03665493 100644 --- a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs +++ b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs @@ -5,12 +5,12 @@ -- -- - an identifer parser -- - a code parser (that accepts a termination parser) --- - a termination parser (only used for lookahead), for this parser to know when to give up +-- - a termination parser, for this parser to know when to give up -- -- Each of those parsers is expected to satisfy @(`Ord` e, `P.MonadParsec` e `String` m)@. module Unison.Syntax.Parser.Doc ( Tree, - initialState, + initialEnv, doc, untitledSection, sectionElem, @@ -52,7 +52,7 @@ module Unison.Syntax.Parser.Doc where import Control.Comonad.Cofree (Cofree ((:<))) -import Control.Monad.State qualified as S +import Control.Monad.Reader qualified as R import Data.Char (isControl, isSpace) import Data.List qualified as List import Data.List.Extra qualified as List @@ -64,7 +64,7 @@ import Text.Megaparsec.Char qualified as CP import Text.Megaparsec.Char.Lexer qualified as LP import Unison.Parser.Ann (Ann, Annotated (..)) import Unison.Prelude hiding (join) -import Unison.Syntax.Lexer (column, line, lit, local, sepBy1', some', someTill', (<+>)) +import Unison.Syntax.Lexer (column, line, lit, sepBy1', some', someTill', (<+>)) import Unison.Syntax.Lexer.Token (Token (Token), posP, tokenP) import Unison.Syntax.Parser.Doc.Data @@ -79,16 +79,16 @@ data ParsingEnv = ParsingEnv } deriving (Show) -initialState :: ParsingEnv -initialState = ParsingEnv [0] 0 +initialEnv :: ParsingEnv +initialEnv = ParsingEnv [0] 0 doc :: (Ord e, P.MonadParsec e String m, Annotated code) => m ident -> (m () -> m code) -> - m () -> + m end -> m (UntitledSection (Tree ident code)) -doc ident code = flip S.evalStateT initialState . untitledSection . sectionElem ident code +doc ident code = flip R.runReaderT initialEnv . untitledSection . sectionElem ident code . void -- | This is the actual `Doc` lexer. Unlike `doc2`, it doesn’t do any Unison-side lexing (i.e., it doesn’t know that -- Unison wraps `Doc` literals in `}}`). @@ -100,7 +100,7 @@ sectionElem :: m ident -> (m () -> m code) -> m () -> - S.StateT ParsingEnv m (Tree ident code) + R.ReaderT ParsingEnv m (Tree ident code) sectionElem ident code docClose = fmap wrap' $ section ident code docClose @@ -390,13 +390,13 @@ list :: m ident -> (m () -> m code) -> m () -> - S.StateT ParsingEnv m (Top ident code (Tree ident code)) + R.ReaderT ParsingEnv m (Top ident code (Tree ident code)) list ident code docClose = bulletedList ident code docClose <|> numberedList ident code docClose -listSep :: (Ord e, S.MonadState ParsingEnv m, P.MonadParsec e String m) => m () +listSep :: (Ord e, R.MonadReader ParsingEnv m, P.MonadParsec e String m) => m () listSep = P.try $ newline *> nonNewlineSpaces *> P.lookAhead (void bulletedStart <|> void numberedStart) -bulletedStart :: (Ord e, S.MonadState ParsingEnv m, P.MonadParsec e String m) => m (Int, [a]) +bulletedStart :: (Ord e, R.MonadReader ParsingEnv m, P.MonadParsec e String m) => m (Int, [a]) bulletedStart = P.try $ do r <- listItemStart $ [] <$ P.satisfy bulletChar P.lookAhead (P.satisfy isSpace) @@ -404,15 +404,15 @@ bulletedStart = P.try $ do where bulletChar ch = ch == '*' || ch == '-' || ch == '+' -listItemStart :: (Ord e, S.MonadState ParsingEnv m, P.MonadParsec e String m) => m a -> m (Int, a) +listItemStart :: (Ord e, R.MonadReader ParsingEnv m, P.MonadParsec e String m) => m a -> m (Int, a) listItemStart gutter = P.try do nonNewlineSpaces col <- column <$> posP - parentCol <- S.gets parentListColumn + parentCol <- R.asks parentListColumn guard (col > parentCol) (col,) <$> gutter -numberedStart :: (Ord e, S.MonadState ParsingEnv m, P.MonadParsec e String m) => m (Int, Token Word64) +numberedStart :: (Ord e, R.MonadReader ParsingEnv m, P.MonadParsec e String m) => m (Int, Token Word64) numberedStart = listItemStart $ P.try (tokenP $ LP.decimal <* lit ".") -- | FIXME: This should take a @`P` a@ @@ -421,7 +421,7 @@ numberedList :: m ident -> (m () -> m code) -> m () -> - S.StateT ParsingEnv m (Top ident code (Tree ident code)) + R.ReaderT ParsingEnv m (Top ident code (Tree ident code)) numberedList ident code docClose = NumberedList <$> sepBy1' numberedItem listSep where numberedItem = P.label "numbered list (examples: 1. item1, 8. start numbering at '8')" do @@ -434,7 +434,7 @@ bulletedList :: m ident -> (m () -> m code) -> m () -> - S.StateT ParsingEnv m (Top ident code (Tree ident code)) + R.ReaderT ParsingEnv m (Top ident code (Tree ident code)) bulletedList ident code docClose = BulletedList <$> sepBy1' bullet listSep where bullet = P.label "bullet (examples: * item1, - item2)" do @@ -447,11 +447,11 @@ column' :: (m () -> m code) -> m () -> Int -> - S.StateT ParsingEnv m (Column (Tree ident code)) + R.ReaderT ParsingEnv m (Column (Tree ident code)) column' ident code docClose col = Column . wrap' <$> (nonNewlineSpaces *> listItemParagraph) - <*> local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> fmap wrap' (list ident code docClose)) + <*> R.local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> fmap wrap' (list ident code docClose)) where listItemParagraph = Paragraph <$> do @@ -497,14 +497,14 @@ section :: m ident -> (m () -> m code) -> m () -> - S.StateT ParsingEnv m (Top ident code (Tree ident code)) + R.ReaderT ParsingEnv m (Top ident code (Tree ident code)) section ident code docClose = do - ns <- S.gets parentSections + ns <- R.asks parentSections hashes <- lift $ P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp docClose title <- lift $ paragraph ident code docClose <* CP.space let m = length hashes + head ns body <- - local (\env -> env {parentSections = (m : (tail ns))}) $ + R.local (\env -> env {parentSections = m : tail ns}) $ P.many (sectionElem ident code docClose <* CP.space) pure $ Section (wrap' title) body From 96f865b37c4fcb31928d976ece21dbf3231d8e87 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 1 Aug 2024 22:53:33 -0600 Subject: [PATCH 540/631] Add a transcript showing that #5076 was fixed Some handling of blocks without final newlines was improved in the course of this PR. Fixes #5076. --- unison-src/transcripts/fix5076.md | 12 ++++++++++++ unison-src/transcripts/fix5076.output.md | 22 ++++++++++++++++++++++ 2 files changed, 34 insertions(+) create mode 100644 unison-src/transcripts/fix5076.md create mode 100644 unison-src/transcripts/fix5076.output.md diff --git a/unison-src/transcripts/fix5076.md b/unison-src/transcripts/fix5076.md new file mode 100644 index 0000000000..d2c4b5a7b2 --- /dev/null +++ b/unison-src/transcripts/fix5076.md @@ -0,0 +1,12 @@ +```ucm:hide +scratch/main> builtins.mergeio +``` + +Nested call to code lexer wasn’t terminating inline examples containing blocks properly. + +```unison +x = {{ + ``let "me"`` live + ``do "me"`` in + }} +``` diff --git a/unison-src/transcripts/fix5076.output.md b/unison-src/transcripts/fix5076.output.md new file mode 100644 index 0000000000..f92954cd23 --- /dev/null +++ b/unison-src/transcripts/fix5076.output.md @@ -0,0 +1,22 @@ +Nested call to code lexer wasn’t terminating inline examples containing blocks properly. + +``` unison +x = {{ + ``let "me"`` live + ``do "me"`` in + }} +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + x : Doc2 + +``` From ac75905f8b44bf58a2d00fd30a675d8fe0f7d4fc Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Fri, 2 Aug 2024 13:44:31 -0400 Subject: [PATCH 541/631] debug nix-dev-cache --- .github/workflows/nix-dev-cache.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/nix-dev-cache.yaml b/.github/workflows/nix-dev-cache.yaml index 9ee02af326..0a48c953f3 100644 --- a/.github/workflows/nix-dev-cache.yaml +++ b/.github/workflows/nix-dev-cache.yaml @@ -36,5 +36,7 @@ jobs: with: name: unison authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' + - name: Setup tmate session + uses: mxschmitt/action-tmate@v3 - name: build all packages and development shells run: nix -L build --accept-flake-config --no-link --keep-going '.#all' From 3e87dc3854e4cb3a16d75f59bb4983cb71cba1d2 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 2 Aug 2024 10:34:24 -0700 Subject: [PATCH 542/631] Fix unused-binding-detection in case patterns --- .../src/Unison/Syntax/TermParser.hs | 3 +- .../Unison/LSP/FileAnalysis/UnusedBindings.hs | 67 ++++++++++++++++--- unison-cli/tests/Unison/Test/LSP.hs | 28 ++++++-- 3 files changed, 82 insertions(+), 16 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 635a974d89..78048c404e 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -294,12 +294,13 @@ parsePattern = label "pattern" root do _ <- anyToken; pure (Set.findMin s <$ tok) where isLower = Text.all Char.isLower . Text.take 1 . Name.toText + isIgnored n = Text.take 1 (Name.toText n) == "_" die hq s = case L.payload hq of -- if token not hash qualified or uppercase, -- fail w/out consuming it to allow backtracking HQ.NameOnly n | Set.null s - && isLower n -> + && (isLower n || isIgnored n) -> fail $ "not a constructor name: " <> show n -- it was hash qualified, and wasn't found in the env, that's a failure! _ -> failCommitted $ err hq s diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs index 46d87c6ec1..85a3511cfd 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -14,20 +14,42 @@ import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Symbol (Symbol (..)) import Unison.Term (Term) +import Unison.Term qualified as Term +import Unison.Util.List qualified as ListUtils import Unison.Util.Range qualified as Range import Unison.Var qualified as Var +data VarUsages + = VarUsages + { unusedVars :: Map Symbol (Set Ann), + usedVars :: Set Symbol, + -- This is generally a copy of usedVars, except that we _don't_ remove variables when they go out of scope. + -- This is solely so we have the information to handle an edge case in pattern guards where vars are independently + -- brought into scope in BOTH the guards and the body of a match case, and we want to count a var as used if it + -- appears in _either_. + allUsedVars :: Set Symbol + } + +instance Semigroup VarUsages where + VarUsages a b c <> VarUsages a' b' c' = + VarUsages (Map.unionWith (<>) a a') (b <> b') (c <> c') + +instance Monoid VarUsages where + mempty = VarUsages mempty mempty mempty + analyseTerm :: Lsp.Uri -> Term Symbol Ann -> [Diagnostic] analyseTerm fileUri tm = - let (unusedVars, _) = ABT.cata alg tm + let (VarUsages {unusedVars}) = ABT.cata alg tm vars = Map.toList unusedVars & mapMaybe \(v, ann) -> do (,ann) <$> getRelevantVarName v diagnostics = - vars & mapMaybe \(varName, ann) -> do + vars & foldMap \(varName, anns) -> do + ann <- Set.toList anns + range <- maybeToList $ Cv.annToURange ann -- Limit the range to the first line of the binding to not be too annoying. -- Maybe in the future we can get the actual annotation of the variable name. - lspRange <- Cv.uToLspRange . Range.startingLine <$> Cv.annToURange ann + let lspRange = Cv.uToLspRange . Range.startingLine $ range pure $ Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning [Lsp.DiagnosticTag_Unnecessary] ("Unused binding " <> tShow varName <> ". Use the binding, or prefix it with an _ to dismiss this warning.") [] in diagnostics where @@ -41,12 +63,39 @@ analyseTerm fileUri tm = guard (not (Text.isPrefixOf "_" n)) Just n _ -> Nothing - alg :: (Foldable f, Ord v) => Ann -> ABT f v (Map v Ann, Set v) -> (Map v Ann, Set v) + alg :: + Ann -> + (ABT (Term.F Symbol Ann Ann) Symbol VarUsages -> VarUsages) alg ann abt = case abt of - Var v -> (mempty, Set.singleton v) + Var v -> VarUsages {unusedVars = mempty, usedVars = Set.singleton v, allUsedVars = Set.singleton v} Cycle x -> x - Abs v (unusedBindings, usedVars) -> + Abs v (VarUsages {unusedVars, usedVars, allUsedVars}) -> if v `Set.member` usedVars - then (unusedBindings, Set.delete v usedVars) - else (Map.insert v ann unusedBindings, usedVars) - Tm fx -> Foldable.fold fx + then VarUsages {unusedVars, usedVars = Set.delete v usedVars, allUsedVars} + else VarUsages {unusedVars = Map.insert v (Set.singleton ann) unusedVars, usedVars, allUsedVars} + Tm fx -> + case fx of + -- We need to special-case pattern guards because the pattern, guard, and body treat each of their vars in + -- their own independent scopes, even though the vars created in the pattern are the same ones used in the + -- guards and bindings :shrug: + Term.Match scrutinee cases -> + let -- There's a separate case for every guard on a single pattern, so we first do our best to group up cases with the same pattern. + -- Otherwise, a var may be reported unused in one branch of a guard even though it's used in another branch. + groupedCases = ListUtils.groupBy (\(Term.MatchCase pat _ _) -> pat) cases + caseVars = + groupedCases & foldMap \singlePatCases -> + let (VarUsages {unusedVars = unused, usedVars = used, allUsedVars = allUsed}) = + singlePatCases + & foldMap + ( \(Term.MatchCase pat guard body) -> + -- This is imprecise, but it's quite annoying to get the actual ann of the unused bindings, so + -- we just use the FULL span of the pattern for now. We could fix this with a bit + -- of elbow grease. + let patSpanAnn = fold pat + combindedVarUsages = fold guard <> body + in combindedVarUsages {unusedVars = (unusedVars combindedVarUsages) $> (Set.singleton patSpanAnn)} + ) + actuallyUnusedVars = unused & Map.filterWithKey \k _ -> k `Set.notMember` allUsed + in VarUsages {unusedVars = actuallyUnusedVars, usedVars = used, allUsedVars = allUsed} + in scrutinee <> caseVars + _ -> Foldable.fold fx diff --git a/unison-cli/tests/Unison/Test/LSP.hs b/unison-cli/tests/Unison/Test/LSP.hs index 880fd6214b..2ab406da56 100644 --- a/unison-cli/tests/Unison/Test/LSP.hs +++ b/unison-cli/tests/Unison/Test/LSP.hs @@ -416,21 +416,24 @@ withTestCodebase action = do makeDiagnosticRangeTest :: (String, Text) -> Test () makeDiagnosticRangeTest (testName, testSrc) = scope testName $ do - (ann, _block, cleanSrc) <- case extractDelimitedBlock ('«', '»') testSrc of - Nothing -> crash "expected exactly one delimited block" - Just r -> pure r + let (cleanSrc, mayExpectedDiagnostic) = case extractDelimitedBlock ('«', '»') testSrc of + Nothing -> (testSrc, Nothing) + Just (ann, block, clean) -> (clean, Just (ann, block)) (pf, _mayTypecheckedFile) <- typecheckSrc testName cleanSrc UF.terms pf & Map.elems & \case [(_a, trm)] -> do - case UnusedBindings.analyseTerm (LSP.Uri "test") trm of - [diag] -> do + case (mayExpectedDiagnostic, UnusedBindings.analyseTerm (LSP.Uri "test") trm) of + (Just (ann, _block), [diag]) -> do let expectedRange = Cv.annToRange ann let actualRange = Just (diag ^. LSP.range) when (expectedRange /= actualRange) do crash $ "Expected diagnostic at range: " <> show expectedRange <> ", got: " <> show actualRange - _ -> crash "Expected exactly one diagnostic" + (Nothing, []) -> pure () + (expected, actual) -> case expected of + Nothing -> crash $ "Expected no diagnostics, got: " <> show actual + Just _ -> crash $ "Expected exactly one diagnostic, but got " <> show actual _ -> crash "Expected exactly one term" unusedBindingLocations :: Test () @@ -446,5 +449,18 @@ unusedBindingLocations = ), ( "Unused argument", [here|term «unused» = 1|] + ), + ( "Unused binding in cases block", + [here|term = cases + -- Note: the diagnostic _should_ only wrap the unused bindings, but right now it just wraps the whole pattern. + («unused, used») + | used > 0 -> true + | otherwise -> false + |] + ), + ( "Ignored unused binding in cases block shouldn't error", + [here|term = cases + (used, _ignored) -> used + |] ) ] From a26a31a7cd0b7a1676782fa539e0601f6f896541 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Fri, 2 Aug 2024 14:13:47 -0400 Subject: [PATCH 543/631] Update nix-dev-cache.yaml --- .github/workflows/nix-dev-cache.yaml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.github/workflows/nix-dev-cache.yaml b/.github/workflows/nix-dev-cache.yaml index 0a48c953f3..dc17e49263 100644 --- a/.github/workflows/nix-dev-cache.yaml +++ b/.github/workflows/nix-dev-cache.yaml @@ -24,6 +24,11 @@ jobs: - macOS-14 steps: - uses: actions/checkout@v4 + - name: set up mount points on Linux + if: runner.os == 'Linux' + run: | + mkdir /nix /mnt/nix + mount -B /mnt/nix /nix - uses: cachix/install-nix-action@v27 if: runner.os == 'Linux' with: From d12176f2bbecf01803b9d89e32c3b16d69eca4a2 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Fri, 2 Aug 2024 14:14:48 -0400 Subject: [PATCH 544/631] Update nix-dev-cache.yaml --- .github/workflows/nix-dev-cache.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/nix-dev-cache.yaml b/.github/workflows/nix-dev-cache.yaml index dc17e49263..a4a51b0cce 100644 --- a/.github/workflows/nix-dev-cache.yaml +++ b/.github/workflows/nix-dev-cache.yaml @@ -27,8 +27,8 @@ jobs: - name: set up mount points on Linux if: runner.os == 'Linux' run: | - mkdir /nix /mnt/nix - mount -B /mnt/nix /nix + sudo mkdir /nix /mnt/nix + sudo mount -B /mnt/nix /nix - uses: cachix/install-nix-action@v27 if: runner.os == 'Linux' with: From d903fd240191fe9ba7f01e5db739ce48141f7d8c Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Fri, 2 Aug 2024 14:32:57 -0400 Subject: [PATCH 545/631] Update nix-dev-cache.yaml --- .github/workflows/nix-dev-cache.yaml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/nix-dev-cache.yaml b/.github/workflows/nix-dev-cache.yaml index a4a51b0cce..ee13b8a64c 100644 --- a/.github/workflows/nix-dev-cache.yaml +++ b/.github/workflows/nix-dev-cache.yaml @@ -24,7 +24,7 @@ jobs: - macOS-14 steps: - uses: actions/checkout@v4 - - name: set up mount points on Linux + - name: set up nix mount points on Linux if: runner.os == 'Linux' run: | sudo mkdir /nix /mnt/nix @@ -41,7 +41,7 @@ jobs: with: name: unison authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' - - name: Setup tmate session - uses: mxschmitt/action-tmate@v3 - name: build all packages and development shells run: nix -L build --accept-flake-config --no-link --keep-going '.#all' + - name: print disk free status + run: df -h From 02f9eb7eeddf318b1ee449cb3fa8bae64b52ac40 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Fri, 2 Aug 2024 15:43:05 -0400 Subject: [PATCH 546/631] Update .github/workflows/nix-dev-cache.yaml Co-authored-by: Greg Pfeil --- .github/workflows/nix-dev-cache.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/nix-dev-cache.yaml b/.github/workflows/nix-dev-cache.yaml index ee13b8a64c..df2291c8e4 100644 --- a/.github/workflows/nix-dev-cache.yaml +++ b/.github/workflows/nix-dev-cache.yaml @@ -24,7 +24,7 @@ jobs: - macOS-14 steps: - uses: actions/checkout@v4 - - name: set up nix mount points on Linux + - name: mount Nix store on larger partition if: runner.os == 'Linux' run: | sudo mkdir /nix /mnt/nix From d7ac7c60311e94f688c8cb4535cc1c0419ae6244 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Fri, 2 Aug 2024 15:48:33 -0400 Subject: [PATCH 547/631] Update .github/workflows/nix-dev-cache.yaml --- .github/workflows/nix-dev-cache.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/nix-dev-cache.yaml b/.github/workflows/nix-dev-cache.yaml index df2291c8e4..4300e1bc81 100644 --- a/.github/workflows/nix-dev-cache.yaml +++ b/.github/workflows/nix-dev-cache.yaml @@ -25,6 +25,7 @@ jobs: steps: - uses: actions/checkout@v4 - name: mount Nix store on larger partition + # on the Linux runner `/` doesn't have enough space, but there's a `/mnt` which does. if: runner.os == 'Linux' run: | sudo mkdir /nix /mnt/nix From 6cb39c8838449a69c7b4af920eb207f25eedbade Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Fri, 2 Aug 2024 16:00:20 -0400 Subject: [PATCH 548/631] Update .github/workflows/nix-dev-cache.yaml Co-authored-by: Greg Pfeil --- .github/workflows/nix-dev-cache.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/nix-dev-cache.yaml b/.github/workflows/nix-dev-cache.yaml index 4300e1bc81..2ac6857c37 100644 --- a/.github/workflows/nix-dev-cache.yaml +++ b/.github/workflows/nix-dev-cache.yaml @@ -29,7 +29,7 @@ jobs: if: runner.os == 'Linux' run: | sudo mkdir /nix /mnt/nix - sudo mount -B /mnt/nix /nix + sudo mount --bind /mnt/nix /nix - uses: cachix/install-nix-action@v27 if: runner.os == 'Linux' with: From 325e4ee4de8b600487a5fe4996c990853142b95b Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 5 Aug 2024 11:38:25 -0400 Subject: [PATCH 549/631] separate partitioning from asserting no builtins --- .../Codebase/Editor/HandleInput/Merge2.hs | 9 +++-- .../src/Unison/Codebase/Editor/Output.hs | 2 +- .../src/Unison/CommandLine/OutputMessages.hs | 37 +++++++++++-------- unison-merge/src/Unison/Merge.hs | 3 +- .../Unison/Merge/PartitionCombinedDiffs.hs | 33 ++++++++--------- 5 files changed, 45 insertions(+), 39 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 5faeaf4477..d1a8fb670d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -336,9 +336,12 @@ doMerge info = do liftIO (debugFunctions.debugCombinedDiff diff) -- Partition the combined diff into the conflicted things and the unconflicted things - (conflicts, unconflicts) <- - Merge.partitionCombinedDiffs (ThreeWay.forgetLca defns3) declNameLookups diff & onLeft \name -> - done (Output.MergeConflictInvolvingBuiltin name) + (conflicts, unconflicts) <- do + let (conflicts0, unconflicts) = Merge.partitionCombinedDiffs (ThreeWay.forgetLca defns3) declNameLookups diff + conflicts <- + Merge.narrowConflictsToNonBuiltins conflicts0 & onLeft \name -> + done (Output.MergeConflictInvolvingBuiltin name) + pure (conflicts, unconflicts) liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index da514c1412..1750c5f3a0 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -426,7 +426,7 @@ data Output | MergeSuccess !MergeSourceAndTarget | MergeSuccessFastForward !MergeSourceAndTarget | MergeConflictedAliases !MergeSourceOrTarget !(Defn (Name, Name) (Name, Name)) - | MergeConflictInvolvingBuiltin !Name + | MergeConflictInvolvingBuiltin !(Defn Name Name) | MergeDefnsInLib !MergeSourceOrTarget | InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment | NoUpgradeInProgress diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 4bbd1e22bb..a0d855abb2 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1368,22 +1368,27 @@ notifyUser dir = \case <> P.newline <> P.newline <> P.wrap "and then try merging again." - MergeConflictInvolvingBuiltin name -> - pure . P.lines $ - [ P.wrap "Sorry, I wasn't able to perform the merge:", - "", - P.wrap - ( "There's a merge conflict on" - <> P.group (prettyName name <> ",") - <> "but it's a builtin on one or both branches. I can't yet handle merge conflicts involving builtins." - ), - "", - P.wrap - ( "Please eliminate this conflict by updating one branch or the other, making" - <> prettyName name - <> "the same on both branches, or making neither of them a builtin, and then try the merge again." - ) - ] + MergeConflictInvolvingBuiltin defn -> + let (isTerm, name) = + case defn of + TermDefn n -> (True, n) + TypeDefn n -> (False, n) + in pure . P.lines $ + [ P.wrap "Sorry, I wasn't able to perform the merge:", + "", + P.wrap + ( "There's a merge conflict on" + <> (if isTerm then "term" else "type") + <> P.group (prettyName name <> ",") + <> "but it's a builtin on one or both branches. I can't yet handle merge conflicts involving builtins." + ), + "", + P.wrap + ( "Please eliminate this conflict by updating one branch or the other, making" + <> prettyName name + <> "the same on both branches, or making neither of them a builtin, and then try the merge again." + ) + ] -- Note [DefnsInLibMessage] If you change this, also change the other similar one MergeDefnsInLib aliceOrBob -> pure . P.lines $ diff --git a/unison-merge/src/Unison/Merge.hs b/unison-merge/src/Unison/Merge.hs index d90d684316..840c2228dc 100644 --- a/unison-merge/src/Unison/Merge.hs +++ b/unison-merge/src/Unison/Merge.hs @@ -22,6 +22,7 @@ module Unison.Merge -- * Partitioning combined namespace diffs Unconflicts (..), partitionCombinedDiffs, + narrowConflictsToNonBuiltins, -- * Merging libdeps LibdepDiffOp (..), @@ -56,7 +57,7 @@ import Unison.Merge.EitherWayI (EitherWayI (..)) import Unison.Merge.FindConflictedAlias (findConflictedAlias) import Unison.Merge.Libdeps (LibdepDiffOp (..), applyLibdepsDiff, diffLibdeps) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) -import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs) +import Unison.Merge.PartitionCombinedDiffs (narrowConflictsToNonBuiltins, partitionCombinedDiffs) import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.ThreeWay (ThreeWay (..)) import Unison.Merge.TwoOrThreeWay (TwoOrThreeWay (..)) diff --git a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs index 5b63f0323e..8283194f75 100644 --- a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs +++ b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs @@ -1,5 +1,6 @@ module Unison.Merge.PartitionCombinedDiffs ( partitionCombinedDiffs, + narrowConflictsToNonBuiltins, ) where @@ -27,6 +28,7 @@ import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defn (Defn (..)) import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, defnsAreEmpty) import Unison.Util.Map qualified as Map @@ -35,16 +37,12 @@ partitionCombinedDiffs :: TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> TwoWay DeclNameLookup -> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> - Either - Name - ( TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId), - DefnsF Unconflicts Referent TypeReference - ) -partitionCombinedDiffs defns declNameLookups diffs = do - let conflicts0 = identifyConflicts declNameLookups defns diffs - let unconflicts = identifyUnconflicts declNameLookups conflicts0 diffs - conflicts <- assertThereAreNoBuiltins conflicts0 - Right (conflicts, unconflicts) + ( TwoWay (DefnsF (Map Name) TermReference TypeReference), + DefnsF Unconflicts Referent TypeReference + ) +partitionCombinedDiffs defns declNameLookups diffs = + let conflicts = identifyConflicts declNameLookups defns diffs + in (conflicts, identifyUnconflicts declNameLookups conflicts diffs) data S = S { me :: !(EitherWay ()), @@ -247,21 +245,20 @@ justTheConflictedNames = CombinedDiffOp'Delete _ -> names CombinedDiffOp'Update _ -> names -assertThereAreNoBuiltins :: +narrowConflictsToNonBuiltins :: TwoWay (DefnsF (Map Name) TermReference TypeReference) -> - Either Name (TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId)) -assertThereAreNoBuiltins = + Either (Defn Name Name) (TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId)) +narrowConflictsToNonBuiltins = traverse (bitraverse (Map.traverseWithKey assertTermIsntBuiltin) (Map.traverseWithKey assertTypeIsntBuiltin)) where - assertTermIsntBuiltin :: Name -> TermReference -> Either Name TermReferenceId + assertTermIsntBuiltin :: Name -> TermReference -> Either (Defn Name Name) TermReferenceId assertTermIsntBuiltin name ref = case Reference.toId ref of - Nothing -> Left name + Nothing -> Left (TermDefn name) Just refId -> Right refId - -- Same body as above, but could be different some day (e.g. return value tells you what namespace) - assertTypeIsntBuiltin :: Name -> TypeReference -> Either Name TypeReferenceId + assertTypeIsntBuiltin :: Name -> TypeReference -> Either (Defn Name Name) TypeReferenceId assertTypeIsntBuiltin name ref = case Reference.toId ref of - Nothing -> Left name + Nothing -> Left (TypeDefn name) Just refId -> Right refId From 565eb6625ff2e43d3509dcccc1d05082de5074ea Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 5 Aug 2024 12:10:16 -0400 Subject: [PATCH 550/631] don't hydrate twice, and hyrate lca defns too --- .../Codebase/Editor/HandleInput/Merge2.hs | 40 ++++++++++++------- unison-merge/src/Unison/Merge/Diff.hs | 11 +++-- unison-src/transcripts/merge.output.md | 6 +-- 3 files changed, 36 insertions(+), 21 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index d1a8fb670d..ac7d6d384c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -255,8 +255,8 @@ doMerge info = do ThreeWay.forgetLca defns3 -- Hydrate - hydratedDefns2 :: - Merge.TwoWay + hydratedDefns3 :: + Merge.ThreeWay ( DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) @@ -270,15 +270,16 @@ doMerge info = do ) ( let f = Map.mapMaybe Referent.toTermReferenceId . BiMultimap.range g = Map.mapMaybe Reference.toId . BiMultimap.range - in bimap f g <$> ThreeWay.forgetLca defns3 + in bimap f g <$> defns3 ) - -- Make one big constructor count lookup for Alice+Bob's type decls + -- Make one big constructor count lookup for all type decls let numConstructors :: Map TypeReferenceId Int numConstructors = Map.empty - & f (Map.elems hydratedDefns2.alice.types) - & f (Map.elems hydratedDefns2.bob.types) + & f (Map.elems hydratedDefns3.alice.types) + & f (Map.elems hydratedDefns3.bob.types) + & f (Map.elems hydratedDefns3.lca.types) where f :: [(TypeReferenceId, Decl Symbol Ann)] -> Map TypeReferenceId Int -> Map TypeReferenceId Int f types acc = @@ -316,11 +317,11 @@ doMerge info = do { terms = foldMap (List.foldl' (\acc (ref, (term, _)) -> Map.insert ref term acc) Map.empty . Map.elems . (.terms)) - hydratedDefns2, + hydratedDefns3, types = foldMap (List.foldl' (\acc (ref, typ) -> Map.insert ref typ acc) Map.empty . Map.elems . (.types)) - hydratedDefns2 + hydratedDefns3 } liftIO (debugFunctions.debugDiffs diffs) @@ -349,8 +350,9 @@ doMerge info = do -- aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) let soloUpdatesAndDeletes = Unconflicts.soloUpdatesAndDeletes unconflicts let coreDependencies = identifyCoreDependencies defns2 conflicts soloUpdatesAndDeletes - dependents0 <- Cli.runTransaction (for ((,) <$> defns2 <*> coreDependencies) (uncurry getNamespaceDependentsOf2)) - let dependents = filterDependents conflicts soloUpdatesAndDeletes dependents0 + dependents <- do + dependents0 <- Cli.runTransaction (for ((,) <$> defns2 <*> coreDependencies) (uncurry getNamespaceDependentsOf2)) + pure (filterDependents conflicts soloUpdatesAndDeletes dependents0) liftIO (debugFunctions.debugDependents dependents) @@ -381,11 +383,19 @@ doMerge info = do suffixifier = PPE.suffixifyByName (fold defnsNames <> libdepsNames) let ppes = mkPpes (defnsToNames <$> defns2) (Branch.toNames mergedLibdeps) - hydratedThings <- do - Cli.runTransaction do - for ((,) <$> conflicts <*> dependents) \(conflicts1, dependents1) -> - let hydrate = hydrateDefns (Codebase.unsafeGetTermComponent env.codebase) Operations.expectDeclComponent - in (,) <$> hydrate conflicts1 <*> hydrate dependents1 + let hydratedThings :: + Merge.TwoWay + ( DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann), + DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann) + ) + hydratedThings = + ( \as bs cs -> + let f xs ys = xs `Map.restrictKeys` Map.keysSet ys + in (zipDefnsWith f f as bs, zipDefnsWith f f as cs) + ) + <$> ThreeWay.forgetLca hydratedDefns3 + <*> conflicts + <*> dependents let (renderedConflicts, renderedDependents) = unzip $ diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index f96834b15a..b3b724da87 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -47,6 +47,7 @@ import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith) -- where each name is paired with its diff-op (added, deleted, or updated), relative to the LCA between Alice and Bob's -- branches. If the hash of a name did not change, it will not appear in the map. nameBasedNamespaceDiff :: + HasCallStack => TwoWay DeclNameLookup -> PartialDeclNameLookup -> ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> @@ -88,6 +89,7 @@ diffHashedNamespaceDefns = -- Syntactic hashing synhashLcaDefns :: + HasCallStack => PrettyPrintEnv -> PartialDeclNameLookup -> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> @@ -119,6 +121,7 @@ synhashLcaDefns ppe declNameLookup defns hydratedDefns = Just names -> synhashDerivedDecl ppe hydratedDefns.types names name ref synhashDefns :: + HasCallStack => PrettyPrintEnv -> Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) -> DeclNameLookup -> @@ -145,6 +148,7 @@ synhashDefns ppe hydratedDefns declNameLookup = synhashDerivedDecl ppe hydratedDefns.types (DeclNameLookup.expectConstructorNames declNameLookup name) name ref synhashDerivedDecl :: + HasCallStack => PrettyPrintEnv -> Map TypeReferenceId (Decl Symbol Ann) -> [Name] -> @@ -157,12 +161,13 @@ synhashDerivedDecl ppe declsById names name ref = & DataDeclaration.setConstructorNames (map Name.toVar names) & Synhash.synhashDerivedDecl ppe name -synhashTermReference :: PrettyPrintEnv -> Map TermReferenceId (Term Symbol Ann) -> TermReference -> Hash +synhashTermReference :: HasCallStack => PrettyPrintEnv -> Map TermReferenceId (Term Symbol Ann) -> TermReference -> Hash synhashTermReference ppe termsById = \case ReferenceBuiltin builtin -> Synhash.synhashBuiltinTerm builtin ReferenceDerived ref -> Synhash.synhashDerivedTerm ppe (expectTerm ref termsById) synhashDefnsWith :: + HasCallStack => (Name -> term -> Hash) -> (Name -> typ -> Hash) -> Defns (BiMultimap term Name) (BiMultimap typ Name) -> @@ -194,13 +199,13 @@ deepNamespaceDefinitionsToPpe Defns {terms, types} = ------------------------------------------------------------------------------------------------------------------------ -- Looking up terms and decls that we expect to be there -expectTerm :: TermReferenceId -> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann +expectTerm :: HasCallStack => TermReferenceId -> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann expectTerm ref termsById = case Map.lookup ref termsById of Nothing -> error (reportBug "E488229" ("term ref " ++ show ref ++ " not found in map " ++ show termsById)) Just term -> term -expectDecl :: TypeReferenceId -> Map TypeReferenceId (Decl Symbol Ann) -> Decl Symbol Ann +expectDecl :: HasCallStack => TypeReferenceId -> Map TypeReferenceId (Decl Symbol Ann) -> Decl Symbol Ann expectDecl ref declsById = case Map.lookup ref declsById of Nothing -> error (reportBug "E663160" ("type ref " ++ show ref ++ " not found in map " ++ show declsById)) diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 08e374506a..8495f8f273 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1335,9 +1335,9 @@ project/alice> merge /bob Sorry, I wasn't able to perform the merge: - There's a merge conflict on MyNat, but it's a builtin on one - or both branches. I can't yet handle merge conflicts involving - builtins. + There's a merge conflict on type MyNat, but it's a builtin on + one or both branches. I can't yet handle merge conflicts + involving builtins. Please eliminate this conflict by updating one branch or the other, making MyNat the same on both branches, or making From 2ffbba47c324cdbbee3882ccf3715be31cd11f67 Mon Sep 17 00:00:00 2001 From: mitchellwrosen Date: Mon, 5 Aug 2024 16:10:55 +0000 Subject: [PATCH 551/631] automatically run ormolu --- unison-merge/src/Unison/Merge/Diff.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index b3b724da87..219bc70b6a 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -47,7 +47,7 @@ import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith) -- where each name is paired with its diff-op (added, deleted, or updated), relative to the LCA between Alice and Bob's -- branches. If the hash of a name did not change, it will not appear in the map. nameBasedNamespaceDiff :: - HasCallStack => + (HasCallStack) => TwoWay DeclNameLookup -> PartialDeclNameLookup -> ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> @@ -89,7 +89,7 @@ diffHashedNamespaceDefns = -- Syntactic hashing synhashLcaDefns :: - HasCallStack => + (HasCallStack) => PrettyPrintEnv -> PartialDeclNameLookup -> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> @@ -121,7 +121,7 @@ synhashLcaDefns ppe declNameLookup defns hydratedDefns = Just names -> synhashDerivedDecl ppe hydratedDefns.types names name ref synhashDefns :: - HasCallStack => + (HasCallStack) => PrettyPrintEnv -> Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) -> DeclNameLookup -> @@ -148,7 +148,7 @@ synhashDefns ppe hydratedDefns declNameLookup = synhashDerivedDecl ppe hydratedDefns.types (DeclNameLookup.expectConstructorNames declNameLookup name) name ref synhashDerivedDecl :: - HasCallStack => + (HasCallStack) => PrettyPrintEnv -> Map TypeReferenceId (Decl Symbol Ann) -> [Name] -> @@ -161,13 +161,13 @@ synhashDerivedDecl ppe declsById names name ref = & DataDeclaration.setConstructorNames (map Name.toVar names) & Synhash.synhashDerivedDecl ppe name -synhashTermReference :: HasCallStack => PrettyPrintEnv -> Map TermReferenceId (Term Symbol Ann) -> TermReference -> Hash +synhashTermReference :: (HasCallStack) => PrettyPrintEnv -> Map TermReferenceId (Term Symbol Ann) -> TermReference -> Hash synhashTermReference ppe termsById = \case ReferenceBuiltin builtin -> Synhash.synhashBuiltinTerm builtin ReferenceDerived ref -> Synhash.synhashDerivedTerm ppe (expectTerm ref termsById) synhashDefnsWith :: - HasCallStack => + (HasCallStack) => (Name -> term -> Hash) -> (Name -> typ -> Hash) -> Defns (BiMultimap term Name) (BiMultimap typ Name) -> @@ -199,13 +199,13 @@ deepNamespaceDefinitionsToPpe Defns {terms, types} = ------------------------------------------------------------------------------------------------------------------------ -- Looking up terms and decls that we expect to be there -expectTerm :: HasCallStack => TermReferenceId -> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann +expectTerm :: (HasCallStack) => TermReferenceId -> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann expectTerm ref termsById = case Map.lookup ref termsById of Nothing -> error (reportBug "E488229" ("term ref " ++ show ref ++ " not found in map " ++ show termsById)) Just term -> term -expectDecl :: HasCallStack => TypeReferenceId -> Map TypeReferenceId (Decl Symbol Ann) -> Decl Symbol Ann +expectDecl :: (HasCallStack) => TypeReferenceId -> Map TypeReferenceId (Decl Symbol Ann) -> Decl Symbol Ann expectDecl ref declsById = case Map.lookup ref declsById of Nothing -> error (reportBug "E663160" ("type ref " ++ show ref ++ " not found in map " ++ show declsById)) From 4acee45238e868184c80c5da3b0a37aed9a4505f Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 5 Aug 2024 14:11:42 -0400 Subject: [PATCH 552/631] extract PPE making to merge API --- codebase2/core/Unison/NameSegment.hs | 3 +- .../Codebase/Editor/HandleInput/Merge2.hs | 142 +++++++----------- unison-merge/src/Unison/Merge.hs | 7 +- unison-merge/src/Unison/Merge/Libdeps.hs | 40 +++++ .../src/Unison/Merge/PrettyPrintEnv.hs | 20 +++ unison-merge/unison-merge.cabal | 1 + 6 files changed, 120 insertions(+), 93 deletions(-) create mode 100644 unison-merge/src/Unison/Merge/PrettyPrintEnv.hs diff --git a/codebase2/core/Unison/NameSegment.hs b/codebase2/core/Unison/NameSegment.hs index 32771f75dc..924e2b8951 100644 --- a/codebase2/core/Unison/NameSegment.hs +++ b/codebase2/core/Unison/NameSegment.hs @@ -1,5 +1,6 @@ module Unison.NameSegment ( NameSegment, + toUnescapedText, -- * Sentinel name segments defaultPatchSegment, @@ -23,7 +24,7 @@ module Unison.NameSegment ) where -import Unison.NameSegment.Internal (NameSegment (NameSegment)) +import Unison.NameSegment.Internal (NameSegment (NameSegment, toUnescapedText)) ------------------------------------------------------------------------------------------------------------------------ -- special segment names diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index ac7d6d384c..edb06bbec8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -79,16 +79,12 @@ import Unison.Merge.ThreeWay qualified as ThreeWay import Unison.Merge.TwoWay qualified as TwoWay import Unison.Merge.Unconflicts qualified as Unconflicts import Unison.Name (Name) +import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment -import Unison.NameSegment.Internal (NameSegment (NameSegment)) -import Unison.NameSegment.Internal qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Prelude -import Unison.PrettyPrintEnv.Names qualified as PPE -import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) -import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Project ( ProjectAndBranch (..), ProjectBranchName, @@ -250,10 +246,6 @@ doMerge info = do defns3 = flattenNametrees <$> nametrees3 - let defns2 :: Merge.TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) - defns2 = - ThreeWay.forgetLca defns3 - -- Hydrate hydratedDefns3 :: Merge.ThreeWay @@ -344,15 +336,22 @@ doMerge info = do done (Output.MergeConflictInvolvingBuiltin name) pure (conflicts, unconflicts) + let conflictsNames = bimap Map.keysSet Map.keysSet <$> conflicts + let conflictsIds = bimap (Set.fromList . Map.elems) (Set.fromList . Map.elems) <$> conflicts + liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts) - -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if there - -- aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) + -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if + -- there aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) let soloUpdatesAndDeletes = Unconflicts.soloUpdatesAndDeletes unconflicts - let coreDependencies = identifyCoreDependencies defns2 conflicts soloUpdatesAndDeletes + let coreDependencies = identifyCoreDependencies (ThreeWay.forgetLca defns3) conflictsIds soloUpdatesAndDeletes dependents <- do - dependents0 <- Cli.runTransaction (for ((,) <$> defns2 <*> coreDependencies) (uncurry getNamespaceDependentsOf2)) - pure (filterDependents conflicts soloUpdatesAndDeletes dependents0) + dependents0 <- + Cli.runTransaction $ + for + ((,) <$> ThreeWay.forgetLca defns3 <*> coreDependencies) + (uncurry getNamespaceDependentsOf2) + pure (filterDependents conflictsNames soloUpdatesAndDeletes (bimap Map.keysSet Map.keysSet <$> dependents0)) liftIO (debugFunctions.debugDependents dependents) @@ -360,7 +359,7 @@ doMerge info = do stageOne = makeStageOne declNameLookups - conflicts + conflictsNames unconflicts dependents (bimap BiMultimap.range BiMultimap.range defns3.lca) @@ -373,15 +372,7 @@ doMerge info = do libdeps <- loadLibdeps branches libdepsToBranch0 (Codebase.getDeclType env.codebase) - (Merge.applyLibdepsDiff getTwoFreshNames libdeps (Merge.diffLibdeps libdeps)) - - -- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names - let mkPpes :: Merge.TwoWay Names -> Names -> Merge.TwoWay PrettyPrintEnvDecl - mkPpes defnsNames libdepsNames = - defnsNames <&> \names -> PPED.makePPED (PPE.namer (names <> libdepsNames)) suffixifier - where - suffixifier = PPE.suffixifyByName (fold defnsNames <> libdepsNames) - let ppes = mkPpes (defnsToNames <$> defns2) (Branch.toNames mergedLibdeps) + (Merge.applyLibdepsDiff Merge.getTwoFreshLibdepNames libdeps (Merge.diffLibdeps libdeps)) let hydratedThings :: Merge.TwoWay @@ -390,11 +381,12 @@ doMerge info = do ) hydratedThings = ( \as bs cs -> - let f xs ys = xs `Map.restrictKeys` Map.keysSet ys - in (zipDefnsWith f f as bs, zipDefnsWith f f as cs) + ( zipDefnsWith Map.restrictKeys Map.restrictKeys as bs, + zipDefnsWith Map.restrictKeys Map.restrictKeys as cs + ) ) <$> ThreeWay.forgetLca hydratedDefns3 - <*> conflicts + <*> conflictsNames <*> dependents let (renderedConflicts, renderedDependents) = @@ -405,7 +397,13 @@ doMerge info = do ) <$> declNameLookups <*> hydratedThings - <*> ppes + <*> ( Merge.makePrettyPrintEnvs + Merge.ThreeWay + { alice = defnsToNames defns3.alice, + bob = defnsToNames defns3.bob, + lca = Branch.toNames mergedLibdeps + } + ) let prettyUnisonFile = makePrettyUnisonFile @@ -616,22 +614,20 @@ makePrettyUnisonFile authors conflicts dependents = -- terms = { "foo", "Maybe.Nothing", "Maybe.Just" } -- types = { "Maybe" } -- } -refIdsToNames :: Merge.DeclNameLookup -> DefnsF (Map Name) term typ -> DefnsF Set Name Name +refIdsToNames :: Merge.DeclNameLookup -> DefnsF Set Name Name -> DefnsF Set Name Name refIdsToNames declNameLookup = bifoldMap goTerms goTypes where - goTerms :: Map Name term -> DefnsF Set Name Name + goTerms :: Set Name -> DefnsF Set Name Name goTerms terms = - Defns {terms = Map.keysSet terms, types = Set.empty} + Defns {terms, types = Set.empty} - goTypes :: Map Name typ -> DefnsF Set Name Name + goTypes :: Set Name -> DefnsF Set Name Name goTypes types = Defns - { terms = foldMap (Set.fromList . expectConstructorNames declNameLookup) names, - types = names + { terms = foldMap (Set.fromList . expectConstructorNames declNameLookup) types, + types } - where - names = Map.keysSet types defnsAndLibdepsToBranch0 :: Codebase IO v a -> @@ -680,7 +676,7 @@ nametreeToBranch0 nametree = identifyCoreDependencies :: Merge.TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> + Merge.TwoWay (DefnsF Set TermReferenceId TypeReferenceId) -> Merge.TwoWay (DefnsF Set Name Name) -> Merge.TwoWay (Set Reference) identifyCoreDependencies defns conflicts soloUpdatesAndDeletes = do @@ -706,18 +702,15 @@ identifyCoreDependencies defns conflicts soloUpdatesAndDeletes = do -- into the namespace / parsing context for the conflicted merge, because it has an unnamed reference on -- foo#alice. It rather ought to be in the scratchfile alongside the conflicted foo#alice and foo#bob, so -- that when that conflict is resolved, it will propagate to bar. - let f :: Map Name Reference.Id -> Set Reference - f = - List.foldl' (\acc ref -> Set.insert (Reference.DerivedId ref) acc) Set.empty . Map.elems - in bifoldMap f f <$> conflicts + bifoldMap (Set.map Reference.DerivedId) (Set.map Reference.DerivedId) <$> conflicts ] filterDependents :: (Ord name) => - Merge.TwoWay (DefnsF (Map name) term typ) -> Merge.TwoWay (DefnsF Set name name) -> - Merge.TwoWay (DefnsF (Map name) term typ) -> - Merge.TwoWay (DefnsF (Map name) term typ) + Merge.TwoWay (DefnsF Set name name) -> + Merge.TwoWay (DefnsF Set name name) -> + Merge.TwoWay (DefnsF Set name name) filterDependents conflicts soloUpdatesAndDeletes dependents0 = -- There is some subset of Alice's dependents (and ditto for Bob of course) that we don't ultimately want/need to put -- into the scratch file: those for which any of the following are true: @@ -726,9 +719,9 @@ filterDependents conflicts soloUpdatesAndDeletes dependents0 = -- 2. It was deleted by Bob. -- 3. It was updated by Bob and not updated by Alice. let dependents1 = - zipDefnsWith Map.withoutKeys Map.withoutKeys + zipDefnsWith Set.difference Set.difference <$> dependents0 - <*> ((bimap Map.keysSet Map.keysSet <$> conflicts) <> TwoWay.swap soloUpdatesAndDeletes) + <*> (conflicts <> TwoWay.swap soloUpdatesAndDeletes) -- Of the remaining dependents, it's still possible that the maps are not disjoint. But whenever the same name key -- exists in Alice's and Bob's dependents, the value will either be equal (by Unison hash)... @@ -747,20 +740,20 @@ filterDependents conflicts soloUpdatesAndDeletes dependents0 = -- { bob = { terms = {} } } dependents2 = dependents1 & over #bob \bob -> - zipDefnsWith Map.difference Map.difference bob dependents1.alice + zipDefnsWith Set.difference Set.difference bob dependents1.alice in dependents2 makeStageOne :: Merge.TwoWay Merge.DeclNameLookup -> - Merge.TwoWay (DefnsF (Map Name) termid typeid) -> + Merge.TwoWay (DefnsF Set Name Name) -> DefnsF Merge.Unconflicts term typ -> - Merge.TwoWay (DefnsF (Map Name) termid typeid) -> + Merge.TwoWay (DefnsF Set Name Name) -> DefnsF (Map Name) term typ -> DefnsF (Map Name) term typ makeStageOne declNameLookups conflicts unconflicts dependents = zipDefnsWith3 makeStageOneV makeStageOneV unconflicts (f conflicts <> f dependents) where - f :: Merge.TwoWay (DefnsF (Map Name) term typ) -> DefnsF Set Name Name + f :: Merge.TwoWay (DefnsF Set Name Name) -> DefnsF Set Name Name f defns = fold (refIdsToNames <$> declNameLookups <*> defns) @@ -820,41 +813,10 @@ findTemporaryBranchName projectId mergeSourceAndTarget = do <> Text.Builder.char '.' <> Text.Builder.decimal z --- Given a name like "base", try "base__1", then "base__2", etc, until we find a name that doesn't --- clash with any existing dependencies. -getTwoFreshNames :: Set NameSegment -> NameSegment -> (NameSegment, NameSegment) -getTwoFreshNames names name0 = - go2 0 - where - -- if - -- name0 = "base" - -- names = {"base__5", "base__6"} - -- then - -- go2 4 = ("base__4", "base__7") - go2 :: Integer -> (NameSegment, NameSegment) - go2 !i - | Set.member name names = go2 (i + 1) - | otherwise = (name, go1 (i + 1)) - where - name = mangled i - - -- if - -- name0 = "base" - -- names = {"base__5", "base__6"} - -- then - -- go1 5 = "base__7" - go1 :: Integer -> NameSegment - go1 !i - | Set.member name names = go1 (i + 1) - | otherwise = name - where - name = mangled i - - mangled :: Integer -> NameSegment - mangled i = - NameSegment (NameSegment.toUnescapedText name0 <> "__" <> tShow i) - -libdepsToBranch0 :: (Reference -> Transaction ConstructorType) -> Map NameSegment (V2.CausalBranch Transaction) -> Transaction (Branch0 Transaction) +libdepsToBranch0 :: + (Reference -> Transaction ConstructorType) -> + Map NameSegment (V2.CausalBranch Transaction) -> + Transaction (Branch0 Transaction) libdepsToBranch0 loadDeclType libdeps = do let branch :: V2.Branch Transaction branch = @@ -921,7 +883,7 @@ data DebugFunctions = DebugFunctions Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> DefnsF Merge.Unconflicts Referent TypeReference -> IO (), - debugDependents :: Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> IO (), + debugDependents :: Merge.TwoWay (DefnsF Set Name Name) -> IO (), debugStageOne :: DefnsF (Map Name) Referent TypeReference -> IO () } @@ -1132,7 +1094,7 @@ realDebugPartitionedDiff conflicts unconflicts = do <> " " <> renderRef ref -realDebugDependents :: Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> IO () +realDebugDependents :: Merge.TwoWay (DefnsF Set Name Name) -> IO () realDebugDependents dependents = do Text.putStrLn (Text.bold "\n=== Alice dependents of Bob deletes, Bob updates, and Alice conflicts ===") renderThings "termid" dependents.alice.terms @@ -1141,15 +1103,13 @@ realDebugDependents dependents = do renderThings "termid" dependents.bob.terms renderThings "typeid" dependents.bob.types where - renderThings :: Text -> Map Name Reference.Id -> IO () + renderThings :: Text -> Set Name -> IO () renderThings label things = - for_ (Map.toList things) \(name, ref) -> + for_ (Set.toList things) \name -> Text.putStrLn $ Text.italic label <> " " <> Name.toText name - <> " " - <> Reference.idToText ref realDebugStageOne :: DefnsF (Map Name) Referent TypeReference -> IO () realDebugStageOne defns = do diff --git a/unison-merge/src/Unison/Merge.hs b/unison-merge/src/Unison/Merge.hs index 840c2228dc..3ebe8be048 100644 --- a/unison-merge/src/Unison/Merge.hs +++ b/unison-merge/src/Unison/Merge.hs @@ -28,6 +28,10 @@ module Unison.Merge LibdepDiffOp (..), diffLibdeps, applyLibdepsDiff, + getTwoFreshLibdepNames, + + -- * Making a pretty-print environment + makePrettyPrintEnvs, -- * Utility types EitherWay (..), @@ -55,9 +59,10 @@ import Unison.Merge.DiffOp (DiffOp (..)) import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.EitherWayI (EitherWayI (..)) import Unison.Merge.FindConflictedAlias (findConflictedAlias) -import Unison.Merge.Libdeps (LibdepDiffOp (..), applyLibdepsDiff, diffLibdeps) +import Unison.Merge.Libdeps (LibdepDiffOp (..), applyLibdepsDiff, diffLibdeps, getTwoFreshLibdepNames) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) import Unison.Merge.PartitionCombinedDiffs (narrowConflictsToNonBuiltins, partitionCombinedDiffs) +import Unison.Merge.PrettyPrintEnv (makePrettyPrintEnvs) import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.ThreeWay (ThreeWay (..)) import Unison.Merge.TwoOrThreeWay (TwoOrThreeWay (..)) diff --git a/unison-merge/src/Unison/Merge/Libdeps.hs b/unison-merge/src/Unison/Merge/Libdeps.hs index c1fcb941b1..ec0b9899d4 100644 --- a/unison-merge/src/Unison/Merge/Libdeps.hs +++ b/unison-merge/src/Unison/Merge/Libdeps.hs @@ -3,6 +3,7 @@ module Unison.Merge.Libdeps ( LibdepDiffOp (..), diffLibdeps, applyLibdepsDiff, + getTwoFreshLibdepNames, ) where @@ -18,6 +19,8 @@ import Unison.Merge.TwoDiffOps (TwoDiffOps (..)) import Unison.Merge.TwoDiffOps qualified as TwoDiffOps import Unison.Merge.TwoWay (TwoWay (..)) import Unison.Merge.Updated (Updated (..)) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) +import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude hiding (catMaybes) import Unison.Util.Map qualified as Map import Witherable (catMaybes) @@ -129,3 +132,40 @@ applyLibdepsDiff freshen0 libdeps = Map.keysSet libdeps.alice, Map.keysSet libdeps.bob ] + +------------------------------------------------------------------------------------------------------------------------ +-- Getting fresh libdeps names + +-- Given a name like "base", try "base__1", then "base__2", etc, until we find a name that doesn't +-- clash with any existing dependencies. +getTwoFreshLibdepNames :: Set NameSegment -> NameSegment -> (NameSegment, NameSegment) +getTwoFreshLibdepNames names name0 = + go2 0 + where + -- if + -- name0 = "base" + -- names = {"base__5", "base__6"} + -- then + -- go2 4 = ("base__4", "base__7") + go2 :: Integer -> (NameSegment, NameSegment) + go2 !i + | Set.member name names = go2 (i + 1) + | otherwise = (name, go1 (i + 1)) + where + name = mangled i + + -- if + -- name0 = "base" + -- names = {"base__5", "base__6"} + -- then + -- go1 5 = "base__7" + go1 :: Integer -> NameSegment + go1 !i + | Set.member name names = go1 (i + 1) + | otherwise = name + where + name = mangled i + + mangled :: Integer -> NameSegment + mangled i = + NameSegment (NameSegment.toUnescapedText name0 <> "__" <> tShow i) diff --git a/unison-merge/src/Unison/Merge/PrettyPrintEnv.hs b/unison-merge/src/Unison/Merge/PrettyPrintEnv.hs new file mode 100644 index 0000000000..92c2a754e5 --- /dev/null +++ b/unison-merge/src/Unison/Merge/PrettyPrintEnv.hs @@ -0,0 +1,20 @@ +module Unison.Merge.PrettyPrintEnv + ( makePrettyPrintEnvs, + ) +where + +import Unison.Merge.ThreeWay (ThreeWay) +import Unison.Merge.ThreeWay qualified as ThreeWay +import Unison.Merge.TwoWay (TwoWay) +import Unison.Names (Names) +import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE +import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl) +import Unison.PrettyPrintEnvDecl.Names qualified as PPED + +-- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names +makePrettyPrintEnvs :: ThreeWay Names -> TwoWay PrettyPrintEnvDecl +makePrettyPrintEnvs names3 = + ThreeWay.forgetLca names3 <&> \names -> PPED.makePPED (PPE.namer (names <> names3.lca)) suffixifier + where + suffixifier = PPE.suffixifyByName (fold names3) diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index 099f20fa70..40f347cf70 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -29,6 +29,7 @@ library Unison.Merge.Libdeps Unison.Merge.PartialDeclNameLookup Unison.Merge.PartitionCombinedDiffs + Unison.Merge.PrettyPrintEnv Unison.Merge.Synhash Unison.Merge.Synhashed Unison.Merge.ThreeWay From 816d785b8dde826e7729f65c29b8b83e7f9ead84 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 5 Aug 2024 14:34:36 -0400 Subject: [PATCH 553/631] extract rendering conflicts and dependents to a helper --- .../Codebase/Editor/HandleInput/Merge2.hs | 73 +++++++++++-------- 1 file changed, 44 insertions(+), 29 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index edb06bbec8..dbc8a21f51 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -374,36 +374,17 @@ doMerge info = do (Codebase.getDeclType env.codebase) (Merge.applyLibdepsDiff Merge.getTwoFreshLibdepNames libdeps (Merge.diffLibdeps libdeps)) - let hydratedThings :: - Merge.TwoWay - ( DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann), - DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann) - ) - hydratedThings = - ( \as bs cs -> - ( zipDefnsWith Map.restrictKeys Map.restrictKeys as bs, - zipDefnsWith Map.restrictKeys Map.restrictKeys as cs - ) - ) - <$> ThreeWay.forgetLca hydratedDefns3 - <*> conflictsNames - <*> dependents - let (renderedConflicts, renderedDependents) = - unzip $ - ( \declNameLookup (conflicts, dependents) ppe -> - let render = renderDefnsForUnisonFile declNameLookup ppe . over (#terms . mapped) snd - in (render conflicts, render dependents) - ) - <$> declNameLookups - <*> hydratedThings - <*> ( Merge.makePrettyPrintEnvs - Merge.ThreeWay - { alice = defnsToNames defns3.alice, - bob = defnsToNames defns3.bob, - lca = Branch.toNames mergedLibdeps - } - ) + renderConflictsAndDependents + declNameLookups + (ThreeWay.forgetLca hydratedDefns3) + conflictsNames + dependents + Merge.ThreeWay + { alice = defnsToNames defns3.alice, + bob = defnsToNames defns3.bob, + lca = Branch.toNames mergedLibdeps + } let prettyUnisonFile = makePrettyUnisonFile @@ -466,6 +447,40 @@ doMerge info = do Cli.respond finalOutput +renderConflictsAndDependents :: + Merge.TwoWay Merge.DeclNameLookup -> + Merge.TwoWay (DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann)) -> + Merge.TwoWay (DefnsF Set Name Name) -> + Merge.TwoWay (DefnsF Set Name Name) -> + Merge.ThreeWay Names -> + ( Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), + Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) + ) +renderConflictsAndDependents declNameLookups hydratedDefns conflicts dependents names = + unzip $ + ( \declNameLookup (conflicts, dependents) ppe -> + let render = renderDefnsForUnisonFile declNameLookup ppe . over (#terms . mapped) snd + in (render conflicts, render dependents) + ) + <$> declNameLookups + <*> hydratedConflictsAndDependents + <*> Merge.makePrettyPrintEnvs names + where + hydratedConflictsAndDependents :: + Merge.TwoWay + ( DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann), + DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann) + ) + hydratedConflictsAndDependents = + ( \as bs cs -> + ( zipDefnsWith Map.restrictKeys Map.restrictKeys as bs, + zipDefnsWith Map.restrictKeys Map.restrictKeys as cs + ) + ) + <$> hydratedDefns + <*> conflicts + <*> dependents + doMergeLocalBranch :: Merge.TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () doMergeLocalBranch branches = do (aliceCausalHash, bobCausalHash, lcaCausalHash) <- From aedb9c2e43227c278180eb3dffceed76cee19e84 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 5 Aug 2024 15:48:12 -0400 Subject: [PATCH 554/631] begin moving over to "mergeblob" api --- .../Codebase/Editor/HandleInput/Merge2.hs | 340 ++++++++++++------ 1 file changed, 224 insertions(+), 116 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index dbc8a21f51..6ea8e061b2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -93,6 +93,7 @@ import Unison.Project Semver (..), classifyProjectBranchName, ) +import Unison.Reference (TermReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -241,10 +242,7 @@ doMerge info = do Cli.runTransactionWithRollback2 (\rollback -> Right <$> action (rollback . Left)) & onLeftM (done . Output.ConflictedDefn "merge") - -- Flatten nametrees - let defns3 :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) - defns3 = - flattenNametrees <$> nametrees3 + let blob0 = makeMergeblob0 nametrees3 -- Hydrate hydratedDefns3 :: @@ -262,109 +260,36 @@ doMerge info = do ) ( let f = Map.mapMaybe Referent.toTermReferenceId . BiMultimap.range g = Map.mapMaybe Reference.toId . BiMultimap.range - in bimap f g <$> defns3 + in bimap f g <$> blob0.defns ) - -- Make one big constructor count lookup for all type decls - let numConstructors :: Map TypeReferenceId Int - numConstructors = - Map.empty - & f (Map.elems hydratedDefns3.alice.types) - & f (Map.elems hydratedDefns3.bob.types) - & f (Map.elems hydratedDefns3.lca.types) - where - f :: [(TypeReferenceId, Decl Symbol Ann)] -> Map TypeReferenceId Int -> Map TypeReferenceId Int - f types acc = - List.foldl' - ( \acc (ref, decl) -> - Map.insert ref (DataDeclaration.constructorCount (DataDeclaration.asDataDecl decl)) acc - ) - acc - types - - -- Make Alice/Bob decl name lookups - declNameLookups <- do - alice <- - Merge.checkDeclCoherency nametrees3.alice numConstructors - & onLeft (done . Output.IncoherentDeclDuringMerge mergeTarget) - bob <- - Merge.checkDeclCoherency nametrees3.bob numConstructors - & onLeft (done . Output.IncoherentDeclDuringMerge mergeSource) - pure Merge.TwoWay {alice, bob} - - -- Make LCA decl name lookup - let lcaDeclNameLookup = - Merge.lenientCheckDeclCoherency nametrees3.lca numConstructors - - liftIO (debugFunctions.debugDefns defns3 declNameLookups lcaDeclNameLookup) - - -- Diff LCA->Alice and LCA->Bob - let diffs :: Merge.TwoWay (DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference) - diffs = - Merge.nameBasedNamespaceDiff - declNameLookups - lcaDeclNameLookup - defns3 - Defns - { terms = - foldMap - (List.foldl' (\acc (ref, (term, _)) -> Map.insert ref term acc) Map.empty . Map.elems . (.terms)) - hydratedDefns3, - types = - foldMap - (List.foldl' (\acc (ref, typ) -> Map.insert ref typ acc) Map.empty . Map.elems . (.types)) - hydratedDefns3 - } + blob2 <- + makeMergeblob1 blob0 hydratedDefns3 & onLeft \case + Merge.Alice reason -> done (Output.IncoherentDeclDuringMerge mergeTarget reason) + Merge.Bob reason -> done (Output.IncoherentDeclDuringMerge mergeSource reason) + + liftIO (debugFunctions.debugDefns blob2.defns blob2.declNameLookups blob2.lcaDeclNameLookup) - liftIO (debugFunctions.debugDiffs diffs) + liftIO (debugFunctions.debugDiffs blob2.diffs) -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias - for_ ((,) <$> Merge.TwoWay mergeTarget mergeSource <*> diffs) \(who, diff) -> - whenJust (Merge.findConflictedAlias defns3.lca diff) do + -- + -- FIXME work this into Mergeblob2 + for_ ((,) <$> Merge.TwoWay mergeTarget mergeSource <*> blob2.diffs) \(who, diff) -> + whenJust (Merge.findConflictedAlias blob2.defns.lca diff) do done . Output.MergeConflictedAliases who - -- Combine the LCA->Alice and LCA->Bob diffs together - let diff = Merge.combineDiffs diffs - - liftIO (debugFunctions.debugCombinedDiff diff) - - -- Partition the combined diff into the conflicted things and the unconflicted things - (conflicts, unconflicts) <- do - let (conflicts0, unconflicts) = Merge.partitionCombinedDiffs (ThreeWay.forgetLca defns3) declNameLookups diff - conflicts <- - Merge.narrowConflictsToNonBuiltins conflicts0 & onLeft \name -> - done (Output.MergeConflictInvolvingBuiltin name) - pure (conflicts, unconflicts) - - let conflictsNames = bimap Map.keysSet Map.keysSet <$> conflicts - let conflictsIds = bimap (Set.fromList . Map.elems) (Set.fromList . Map.elems) <$> conflicts - - liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts) - - -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if - -- there aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) - let soloUpdatesAndDeletes = Unconflicts.soloUpdatesAndDeletes unconflicts - let coreDependencies = identifyCoreDependencies (ThreeWay.forgetLca defns3) conflictsIds soloUpdatesAndDeletes - dependents <- do - dependents0 <- - Cli.runTransaction $ - for - ((,) <$> ThreeWay.forgetLca defns3 <*> coreDependencies) - (uncurry getNamespaceDependentsOf2) - pure (filterDependents conflictsNames soloUpdatesAndDeletes (bimap Map.keysSet Map.keysSet <$> dependents0)) - - liftIO (debugFunctions.debugDependents dependents) - - let stageOne :: DefnsF (Map Name) Referent TypeReference - stageOne = - makeStageOne - declNameLookups - conflictsNames - unconflicts - dependents - (bimap BiMultimap.range BiMultimap.range defns3.lca) - - liftIO (debugFunctions.debugStageOne stageOne) + liftIO (debugFunctions.debugCombinedDiff blob2.diff) + + blob3 <- makeMergeblob3 blob2 & onLeft (done . Output.MergeConflictInvolvingBuiltin) + + liftIO (debugFunctions.debugPartitionedDiff blob3.conflicts blob3.unconflicts) + + dependents0 <- + Cli.runTransaction $ + for + ((,) <$> ThreeWay.forgetLca blob3.defns <*> blob3.coreDependencies) + (uncurry getNamespaceDependentsOf2) -- Load and merge Alice's and Bob's libdeps mergedLibdeps <- @@ -374,17 +299,11 @@ doMerge info = do (Codebase.getDeclType env.codebase) (Merge.applyLibdepsDiff Merge.getTwoFreshLibdepNames libdeps (Merge.diffLibdeps libdeps)) - let (renderedConflicts, renderedDependents) = - renderConflictsAndDependents - declNameLookups - (ThreeWay.forgetLca hydratedDefns3) - conflictsNames - dependents - Merge.ThreeWay - { alice = defnsToNames defns3.alice, - bob = defnsToNames defns3.bob, - lca = Branch.toNames mergedLibdeps - } + let blob4 = makeMergeblob4 blob3 (bimap Map.keysSet Map.keysSet <$> dependents0) (Branch.toNames mergedLibdeps) + + liftIO (debugFunctions.debugDependents blob4.dependents) + + liftIO (debugFunctions.debugStageOne blob4.stageOne) let prettyUnisonFile = makePrettyUnisonFile @@ -401,15 +320,19 @@ doMerge info = do Nothing -> "" Just name -> Name.toText name } - renderedConflicts - renderedDependents + blob4.renderedConflicts + blob4.renderedDependents - let stageOneBranch = defnsAndLibdepsToBranch0 env.codebase stageOne mergedLibdeps + let stageOneBranch = defnsAndLibdepsToBranch0 env.codebase blob4.stageOne mergedLibdeps maybeTypecheckedUnisonFile <- let thisMergeHasConflicts = - -- Eh, they'd either both be null, or neither, but just check both maps anyway - not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob) + or + [ not (Map.null blob4.renderedConflicts.alice.terms), + not (Map.null blob4.renderedConflicts.alice.types), + not (Map.null blob4.renderedConflicts.bob.terms), + not (Map.null blob4.renderedConflicts.bob.types) + ] in if thisMergeHasConflicts then pure Nothing else do @@ -447,6 +370,191 @@ doMerge info = do Cli.respond finalOutput +data Mergeblob0 = Mergeblob0 + { defns :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), + nametrees :: Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) + } + +makeMergeblob0 :: Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> Mergeblob0 +makeMergeblob0 nametrees = + Mergeblob0 + { defns = flattenNametrees <$> nametrees, + nametrees + } + +data Mergeblob1 = Mergeblob1 + { conflicts :: Merge.TwoWay (DefnsF (Map Name) TermReference TypeReference), + declNameLookups :: Merge.TwoWay Merge.DeclNameLookup, + defns :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), + diff :: DefnsF2 (Map Name) Merge.CombinedDiffOp Referent TypeReference, + diffs :: Merge.TwoWay (DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference), + hydratedDefns :: + Merge.ThreeWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ), + lcaDeclNameLookup :: Merge.PartialDeclNameLookup, + nametrees :: Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)), + unconflicts :: DefnsF Merge.Unconflicts Referent TypeReference + } + +makeMergeblob1 :: + Mergeblob0 -> + Merge.ThreeWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ) -> + Either (Merge.EitherWay Merge.IncoherentDeclReason) Mergeblob1 +makeMergeblob1 blob hydratedDefns = do + -- Make one big constructor count lookup for all type decls + let numConstructors = + Map.empty + & f (Map.elems hydratedDefns.alice.types) + & f (Map.elems hydratedDefns.bob.types) + & f (Map.elems hydratedDefns.lca.types) + where + f :: [(TypeReferenceId, Decl Symbol Ann)] -> Map TypeReferenceId Int -> Map TypeReferenceId Int + f types acc = + List.foldl' + ( \acc (ref, decl) -> + Map.insert ref (DataDeclaration.constructorCount (DataDeclaration.asDataDecl decl)) acc + ) + acc + types + + -- Make Alice/Bob decl name lookups, which can fail if either have an incoherent decl + declNameLookups <- do + alice <- Merge.checkDeclCoherency blob.nametrees.alice numConstructors & mapLeft Merge.Alice + bob <- Merge.checkDeclCoherency blob.nametrees.bob numConstructors & mapLeft Merge.Bob + pure Merge.TwoWay {alice, bob} + + -- Make LCA decl name lookup + let lcaDeclNameLookup = + Merge.lenientCheckDeclCoherency blob.nametrees.lca numConstructors + + -- Diff LCA->Alice and LCA->Bob + let diffs = + Merge.nameBasedNamespaceDiff + declNameLookups + lcaDeclNameLookup + blob.defns + Defns + { terms = + foldMap + (List.foldl' (\acc (ref, (term, _)) -> Map.insert ref term acc) Map.empty . Map.elems . (.terms)) + hydratedDefns, + types = + foldMap + (List.foldl' (\acc (ref, typ) -> Map.insert ref typ acc) Map.empty . Map.elems . (.types)) + hydratedDefns + } + + -- Combine the LCA->Alice and LCA->Bob diffs together + let diff = + Merge.combineDiffs diffs + + -- Partition the combined diff into the conflicted things and the unconflicted things + let (conflicts, unconflicts) = + Merge.partitionCombinedDiffs (ThreeWay.forgetLca blob.defns) declNameLookups diff + + pure + Mergeblob1 + { conflicts, + declNameLookups, + defns = blob.defns, + diff, + diffs, + hydratedDefns, + lcaDeclNameLookup, + nametrees = blob.nametrees, + unconflicts + } + +data Mergeblob3 = Mergeblob3 + { conflicts :: Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId), + conflictsIds :: Merge.TwoWay (DefnsF Set TermReferenceId TypeReferenceId), + conflictsNames :: Merge.TwoWay (DefnsF Set Name Name), + coreDependencies :: Merge.TwoWay (Set Reference), + declNameLookups :: Merge.TwoWay Merge.DeclNameLookup, + defns :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), + hydratedDefns :: + Merge.TwoWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ), + lcaDeclNameLookup :: Merge.PartialDeclNameLookup, + soloUpdatesAndDeletes :: Merge.TwoWay (DefnsF Set Name Name), + unconflicts :: DefnsF Merge.Unconflicts Referent TypeReference + } + +makeMergeblob3 :: Mergeblob1 -> Either (Defn Name Name) Mergeblob3 +makeMergeblob3 blob = do + conflicts <- Merge.narrowConflictsToNonBuiltins blob.conflicts + let conflictsIds = bimap (Set.fromList . Map.elems) (Set.fromList . Map.elems) <$> conflicts + let conflictsNames = bimap Map.keysSet Map.keysSet <$> conflicts + + let soloUpdatesAndDeletes = Unconflicts.soloUpdatesAndDeletes blob.unconflicts + let coreDependencies = identifyCoreDependencies (ThreeWay.forgetLca blob.defns) conflictsIds soloUpdatesAndDeletes + + pure + Mergeblob3 + { conflicts, + conflictsIds, + conflictsNames, + coreDependencies, + declNameLookups = blob.declNameLookups, + defns = blob.defns, + hydratedDefns = ThreeWay.forgetLca blob.hydratedDefns, + lcaDeclNameLookup = blob.lcaDeclNameLookup, + soloUpdatesAndDeletes, + unconflicts = blob.unconflicts + } + +data Mergeblob4 = Mergeblob4 + { dependents :: Merge.TwoWay (DefnsF Set Name Name), + renderedConflicts :: Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), + renderedDependents :: Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), + stageOne :: DefnsF (Map Name) Referent TypeReference + } + +makeMergeblob4 :: Mergeblob3 -> Merge.TwoWay (DefnsF Set Name Name) -> Names -> Mergeblob4 +makeMergeblob4 blob dependents0 lcaNames = + -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if + -- there aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) + let dependents = filterDependents blob.conflictsNames blob.soloUpdatesAndDeletes dependents0 + + stageOne = + makeStageOne + blob.declNameLookups + blob.conflictsNames + blob.unconflicts + dependents + (bimap BiMultimap.range BiMultimap.range blob.defns.lca) + + (renderedConflicts, renderedDependents) = + renderConflictsAndDependents + blob.declNameLookups + blob.hydratedDefns + blob.conflictsNames + dependents + Merge.ThreeWay + { alice = defnsToNames blob.defns.alice, + bob = defnsToNames blob.defns.bob, + lca = lcaNames + } + in Mergeblob4 + { dependents, + renderedConflicts, + renderedDependents, + stageOne + } + renderConflictsAndDependents :: Merge.TwoWay Merge.DeclNameLookup -> Merge.TwoWay (DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann)) -> From d5a9585194b0f2ee8360351634942af33dbf8f73 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 6 Aug 2024 13:05:24 -0400 Subject: [PATCH 555/631] continue refactoring --- unison-cli/src/Unison/Cli/UpdateUtils.hs | 21 +- .../Codebase/Editor/HandleInput/Merge2.hs | 237 ++++++++++-------- .../src/Unison/Merge/PrettyPrintEnv.hs | 10 +- 3 files changed, 157 insertions(+), 111 deletions(-) diff --git a/unison-cli/src/Unison/Cli/UpdateUtils.hs b/unison-cli/src/Unison/Cli/UpdateUtils.hs index 8e64952228..c976af6184 100644 --- a/unison-cli/src/Unison/Cli/UpdateUtils.hs +++ b/unison-cli/src/Unison/Cli/UpdateUtils.hs @@ -9,6 +9,7 @@ module Unison.Cli.UpdateUtils -- * Getting dependents in a namespace getNamespaceDependentsOf, getNamespaceDependentsOf2, + getNamespaceDependentsOf3, -- * Narrowing definitions narrowDefns, @@ -28,7 +29,7 @@ import Control.Lens (mapped, _1) import Control.Monad.Reader (ask) import Control.Monad.Writer (Writer) import Control.Monad.Writer qualified as Writer -import Data.Bifoldable (bifoldMap) +import Data.Bifoldable (bifoldMap, bifold) import Data.Bitraversable (bitraverse) import Data.Foldable qualified as Foldable import Data.List qualified as List @@ -58,11 +59,13 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment +import Unison.Names (Names) +import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Parsers qualified as Parsers import Unison.Prelude import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) -import Unison.Reference (Reference, TypeReference) +import Unison.Reference (Reference, TermReference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -90,8 +93,6 @@ import Unison.Util.Relation qualified as Relation import Unison.Util.Set qualified as Set import Unison.Var (Var) import Prelude hiding (unzip, zip, zipWith) -import Unison.Names (Names) -import qualified Unison.Names as Names ------------------------------------------------------------------------------------------------------------------------ -- Loading definitions @@ -193,6 +194,18 @@ getNamespaceDependentsOf2 defns dependencies = do let names = BiMultimap.lookupDom (Reference.fromId ref) defns.types in Set.foldl' (\acc name -> Map.insert name ref acc) acc0 names +-- | Given a namespace and a set of dependencies, return the subset of the namespace that consists of only the +-- (transitive) dependents of the dependencies. +getNamespaceDependentsOf3 :: + Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> + DefnsF Set TermReference TypeReference -> + Transaction (DefnsF Set TermReferenceId TypeReferenceId) +getNamespaceDependentsOf3 defns dependencies = do + let toTermScope = Set.mapMaybe Referent.toReferenceId . BiMultimap.dom + let toTypeScope = Set.mapMaybe Reference.toId . BiMultimap.dom + let scope = bifoldMap toTermScope toTypeScope defns + Operations.transitiveDependentsWithinScope scope (bifold dependencies) + ------------------------------------------------------------------------------------------------------------------------ -- Narrowing definitions diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 6ea8e061b2..93c0047aa8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -22,6 +22,8 @@ import Data.List qualified as List import Data.Map.Strict qualified as Map import Data.Semialign (align, unzip, zipWith) import Data.Set qualified as Set +import Data.Set.NonEmpty (NESet) +import Data.Set.NonEmpty qualified as Set.NonEmpty import Data.Text qualified as Text import Data.Text.IO qualified as Text import Data.These (These (..)) @@ -44,7 +46,7 @@ import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Cli.UpdateUtils - ( getNamespaceDependentsOf2, + ( getNamespaceDependentsOf3, hydrateDefns, loadNamespaceDefinitions, parseAndTypecheck, @@ -66,6 +68,7 @@ import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache) import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions import Unison.Codebase.SqliteCodebase.Operations qualified as Operations +import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType (ConstructorType) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration @@ -93,7 +96,7 @@ import Unison.Project Semver (..), classifyProjectBranchName, ) -import Unison.Reference (TermReference) +import Unison.Reference (Reference' (..), TermReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -242,10 +245,12 @@ doMerge info = do Cli.runTransactionWithRollback2 (\rollback -> Right <$> action (rollback . Left)) & onLeftM (done . Output.ConflictedDefn "merge") - let blob0 = makeMergeblob0 nametrees3 + libdeps3 <- Cli.runTransaction (loadLibdeps branches) + + let blob0 = makeMergeblob0 nametrees3 libdeps3 -- Hydrate - hydratedDefns3 :: + hydratedDefns :: Merge.ThreeWay ( DefnsF (Map Name) @@ -263,47 +268,40 @@ doMerge info = do in bimap f g <$> blob0.defns ) - blob2 <- - makeMergeblob1 blob0 hydratedDefns3 & onLeft \case + blob1 <- + makeMergeblob1 blob0 hydratedDefns & onLeft \case Merge.Alice reason -> done (Output.IncoherentDeclDuringMerge mergeTarget reason) Merge.Bob reason -> done (Output.IncoherentDeclDuringMerge mergeSource reason) - liftIO (debugFunctions.debugDefns blob2.defns blob2.declNameLookups blob2.lcaDeclNameLookup) + liftIO (debugFunctions.debugDiffs blob1.diffs) - liftIO (debugFunctions.debugDiffs blob2.diffs) - - -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias - -- - -- FIXME work this into Mergeblob2 - for_ ((,) <$> Merge.TwoWay mergeTarget mergeSource <*> blob2.diffs) \(who, diff) -> - whenJust (Merge.findConflictedAlias blob2.defns.lca diff) do - done . Output.MergeConflictedAliases who + liftIO (debugFunctions.debugCombinedDiff blob1.diff) - liftIO (debugFunctions.debugCombinedDiff blob2.diff) - - blob3 <- makeMergeblob3 blob2 & onLeft (done . Output.MergeConflictInvolvingBuiltin) + blob2 <- + makeMergeblob2 blob1 & onLeft \err -> + done case err of + Mergeblob2Error'ConflictedAlias defn0 -> + case defn0 of + Merge.Alice defn -> Output.MergeConflictedAliases mergeTarget defn + Merge.Bob defn -> Output.MergeConflictedAliases mergeSource defn + Mergeblob2Error'ConflictedBuiltin defn -> Output.MergeConflictInvolvingBuiltin defn - liftIO (debugFunctions.debugPartitionedDiff blob3.conflicts blob3.unconflicts) + liftIO (debugFunctions.debugPartitionedDiff blob2.conflicts blob2.unconflicts) dependents0 <- Cli.runTransaction $ - for - ((,) <$> ThreeWay.forgetLca blob3.defns <*> blob3.coreDependencies) - (uncurry getNamespaceDependentsOf2) + for ((,) <$> ThreeWay.forgetLca blob2.defns <*> blob2.coreDependencies) \(defns, deps) -> + getNamespaceDependentsOf3 defns deps -- Load and merge Alice's and Bob's libdeps mergedLibdeps <- - Cli.runTransaction do - libdeps <- loadLibdeps branches - libdepsToBranch0 - (Codebase.getDeclType env.codebase) - (Merge.applyLibdepsDiff Merge.getTwoFreshLibdepNames libdeps (Merge.diffLibdeps libdeps)) + Cli.runTransaction (libdepsToBranch0 (Codebase.getDeclType env.codebase) blob2.libdeps) - let blob4 = makeMergeblob4 blob3 (bimap Map.keysSet Map.keysSet <$> dependents0) (Branch.toNames mergedLibdeps) + let blob3 = makeMergeblob3 blob2 dependents0 (Branch.toNames mergedLibdeps) - liftIO (debugFunctions.debugDependents blob4.dependents) + liftIO (debugFunctions.debugDependents blob3.dependents) - liftIO (debugFunctions.debugStageOne blob4.stageOne) + liftIO (debugFunctions.debugStageOne blob3.stageOne) let prettyUnisonFile = makePrettyUnisonFile @@ -320,18 +318,18 @@ doMerge info = do Nothing -> "" Just name -> Name.toText name } - blob4.renderedConflicts - blob4.renderedDependents + blob3.renderedConflicts + blob3.renderedDependents - let stageOneBranch = defnsAndLibdepsToBranch0 env.codebase blob4.stageOne mergedLibdeps + let stageOneBranch = defnsAndLibdepsToBranch0 env.codebase blob3.stageOne mergedLibdeps maybeTypecheckedUnisonFile <- let thisMergeHasConflicts = or - [ not (Map.null blob4.renderedConflicts.alice.terms), - not (Map.null blob4.renderedConflicts.alice.types), - not (Map.null blob4.renderedConflicts.bob.terms), - not (Map.null blob4.renderedConflicts.bob.types) + [ not (Map.null blob3.renderedConflicts.alice.terms), + not (Map.null blob3.renderedConflicts.alice.types), + not (Map.null blob3.renderedConflicts.bob.terms), + not (Map.null blob3.renderedConflicts.bob.types) ] in if thisMergeHasConflicts then pure Nothing @@ -341,7 +339,7 @@ doMerge info = do parseAndTypecheck prettyUnisonFile parsingEnv let parents = - (\causal -> (causal.causalHash, Codebase.expectBranchForHash env.codebase causal.causalHash)) <$> causals + causals <&> \causal -> (causal.causalHash, Codebase.expectBranchForHash env.codebase causal.causalHash) case maybeTypecheckedUnisonFile of Nothing -> do @@ -349,7 +347,10 @@ doMerge info = do (_temporaryBranchId, temporaryBranchName) <- HandleInput.Branch.createBranch info.description - (HandleInput.Branch.CreateFrom'NamespaceWithParent info.alice.projectAndBranch.branch (Branch.mergeNode stageOneBranch parents.alice parents.bob)) + ( HandleInput.Branch.CreateFrom'NamespaceWithParent + info.alice.projectAndBranch.branch + (Branch.mergeNode stageOneBranch parents.alice parents.bob) + ) info.alice.projectAndBranch.project (findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget) @@ -370,19 +371,24 @@ doMerge info = do Cli.respond finalOutput -data Mergeblob0 = Mergeblob0 +data Mergeblob0 libdep = Mergeblob0 { defns :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), + libdeps :: Merge.ThreeWay (Map NameSegment libdep), nametrees :: Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) } -makeMergeblob0 :: Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> Mergeblob0 -makeMergeblob0 nametrees = +makeMergeblob0 :: + Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + Merge.ThreeWay (Map NameSegment libdep) -> + Mergeblob0 libdep +makeMergeblob0 nametrees libdeps = Mergeblob0 { defns = flattenNametrees <$> nametrees, + libdeps, nametrees } -data Mergeblob1 = Mergeblob1 +data Mergeblob1 libdep = Mergeblob1 { conflicts :: Merge.TwoWay (DefnsF (Map Name) TermReference TypeReference), declNameLookups :: Merge.TwoWay Merge.DeclNameLookup, defns :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), @@ -396,19 +402,22 @@ data Mergeblob1 = Mergeblob1 (TypeReferenceId, Decl Symbol Ann) ), lcaDeclNameLookup :: Merge.PartialDeclNameLookup, - nametrees :: Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)), + libdeps :: Map NameSegment libdep, + libdepsDiff :: Map NameSegment (Merge.LibdepDiffOp libdep), unconflicts :: DefnsF Merge.Unconflicts Referent TypeReference } makeMergeblob1 :: - Mergeblob0 -> + forall libdep. + (Eq libdep) => + Mergeblob0 libdep -> Merge.ThreeWay ( DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann) ) -> - Either (Merge.EitherWay Merge.IncoherentDeclReason) Mergeblob1 + Either (Merge.EitherWay Merge.IncoherentDeclReason) (Mergeblob1 libdep) makeMergeblob1 blob hydratedDefns = do -- Make one big constructor count lookup for all type decls let numConstructors = @@ -461,6 +470,15 @@ makeMergeblob1 blob hydratedDefns = do let (conflicts, unconflicts) = Merge.partitionCombinedDiffs (ThreeWay.forgetLca blob.defns) declNameLookups diff + -- Diff and merge libdeps + let libdepsDiff :: Map NameSegment (Merge.LibdepDiffOp libdep) + libdepsDiff = + Merge.diffLibdeps blob.libdeps + + let libdeps :: Map NameSegment libdep + libdeps = + Merge.applyLibdepsDiff Merge.getTwoFreshLibdepNames blob.libdeps libdepsDiff + pure Mergeblob1 { conflicts, @@ -470,15 +488,16 @@ makeMergeblob1 blob hydratedDefns = do diffs, hydratedDefns, lcaDeclNameLookup, - nametrees = blob.nametrees, + libdeps, + libdepsDiff, unconflicts } -data Mergeblob3 = Mergeblob3 +data Mergeblob2 libdep = Mergeblob2 { conflicts :: Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId), conflictsIds :: Merge.TwoWay (DefnsF Set TermReferenceId TypeReferenceId), conflictsNames :: Merge.TwoWay (DefnsF Set Name Name), - coreDependencies :: Merge.TwoWay (Set Reference), + coreDependencies :: Merge.TwoWay (DefnsF Set TermReference TypeReference), declNameLookups :: Merge.TwoWay Merge.DeclNameLookup, defns :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), hydratedDefns :: @@ -489,13 +508,23 @@ data Mergeblob3 = Mergeblob3 (TypeReferenceId, Decl Symbol Ann) ), lcaDeclNameLookup :: Merge.PartialDeclNameLookup, + libdeps :: Map NameSegment libdep, soloUpdatesAndDeletes :: Merge.TwoWay (DefnsF Set Name Name), unconflicts :: DefnsF Merge.Unconflicts Referent TypeReference } -makeMergeblob3 :: Mergeblob1 -> Either (Defn Name Name) Mergeblob3 -makeMergeblob3 blob = do - conflicts <- Merge.narrowConflictsToNonBuiltins blob.conflicts +data Mergeblob2Error + = Mergeblob2Error'ConflictedAlias (Merge.EitherWay (Defn (Name, Name) (Name, Name))) + | Mergeblob2Error'ConflictedBuiltin (Defn Name Name) + +makeMergeblob2 :: Mergeblob1 libdep -> Either Mergeblob2Error (Mergeblob2 libdep) +makeMergeblob2 blob = do + -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias + for_ ((,) <$> Merge.TwoWay Merge.Alice Merge.Bob <*> blob.diffs) \(who, diff) -> + whenJust (Merge.findConflictedAlias blob.defns.lca diff) $ + Left . Mergeblob2Error'ConflictedAlias . who + + conflicts <- Merge.narrowConflictsToNonBuiltins blob.conflicts & mapLeft Mergeblob2Error'ConflictedBuiltin let conflictsIds = bimap (Set.fromList . Map.elems) (Set.fromList . Map.elems) <$> conflicts let conflictsNames = bimap Map.keysSet Map.keysSet <$> conflicts @@ -503,7 +532,7 @@ makeMergeblob3 blob = do let coreDependencies = identifyCoreDependencies (ThreeWay.forgetLca blob.defns) conflictsIds soloUpdatesAndDeletes pure - Mergeblob3 + Mergeblob2 { conflicts, conflictsIds, conflictsNames, @@ -512,22 +541,48 @@ makeMergeblob3 blob = do defns = blob.defns, hydratedDefns = ThreeWay.forgetLca blob.hydratedDefns, lcaDeclNameLookup = blob.lcaDeclNameLookup, + libdeps = blob.libdeps, soloUpdatesAndDeletes, unconflicts = blob.unconflicts } -data Mergeblob4 = Mergeblob4 +data Mergeblob3 = Mergeblob3 { dependents :: Merge.TwoWay (DefnsF Set Name Name), renderedConflicts :: Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), renderedDependents :: Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), stageOne :: DefnsF (Map Name) Referent TypeReference } -makeMergeblob4 :: Mergeblob3 -> Merge.TwoWay (DefnsF Set Name Name) -> Names -> Mergeblob4 -makeMergeblob4 blob dependents0 lcaNames = +makeMergeblob3 :: + Mergeblob2 libdep -> + Merge.TwoWay (DefnsF Set TermReferenceId TypeReferenceId) -> + Names -> + Mergeblob3 +makeMergeblob3 blob dependents0 libdeps = -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if -- there aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) - let dependents = filterDependents blob.conflictsNames blob.soloUpdatesAndDeletes dependents0 + let dependents = + filterDependents + blob.conflictsNames + blob.soloUpdatesAndDeletes + ( let f :: Set TermReferenceId -> Referent -> NESet Name -> Set Name + f deps defn0 names + | Just defn <- Referent.toTermReferenceId defn0, + Set.member defn deps = + Set.NonEmpty.toSet names + | otherwise = Set.empty + g :: Set TypeReferenceId -> TypeReference -> NESet Name -> Set Name + g deps defn0 names + | ReferenceDerived defn <- defn0, + Set.member defn deps = + Set.NonEmpty.toSet names + | otherwise = Set.empty + in zipDefnsWith + (\defns deps -> Map.foldMapWithKey (f deps) (BiMultimap.domain defns)) + (\defns deps -> Map.foldMapWithKey (g deps) (BiMultimap.domain defns)) + <$> ThreeWay.forgetLca blob.defns + <*> dependents0 + ) stageOne = makeStageOne @@ -543,12 +598,9 @@ makeMergeblob4 blob dependents0 lcaNames = blob.hydratedDefns blob.conflictsNames dependents - Merge.ThreeWay - { alice = defnsToNames blob.defns.alice, - bob = defnsToNames blob.defns.bob, - lca = lcaNames - } - in Mergeblob4 + (defnsToNames <$> ThreeWay.forgetLca blob.defns) + libdeps + in Mergeblob3 { dependents, renderedConflicts, renderedDependents, @@ -560,11 +612,12 @@ renderConflictsAndDependents :: Merge.TwoWay (DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann)) -> Merge.TwoWay (DefnsF Set Name Name) -> Merge.TwoWay (DefnsF Set Name Name) -> - Merge.ThreeWay Names -> + Merge.TwoWay Names -> + Names -> ( Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) ) -renderConflictsAndDependents declNameLookups hydratedDefns conflicts dependents names = +renderConflictsAndDependents declNameLookups hydratedDefns conflicts dependents names libdepsNames = unzip $ ( \declNameLookup (conflicts, dependents) ppe -> let render = renderDefnsForUnisonFile declNameLookup ppe . over (#terms . mapped) snd @@ -572,7 +625,7 @@ renderConflictsAndDependents declNameLookups hydratedDefns conflicts dependents ) <$> declNameLookups <*> hydratedConflictsAndDependents - <*> Merge.makePrettyPrintEnvs names + <*> Merge.makePrettyPrintEnvs names libdepsNames where hydratedConflictsAndDependents :: Merge.TwoWay @@ -801,7 +854,7 @@ identifyCoreDependencies :: Merge.TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> Merge.TwoWay (DefnsF Set TermReferenceId TypeReferenceId) -> Merge.TwoWay (DefnsF Set Name Name) -> - Merge.TwoWay (Set Reference) + Merge.TwoWay (DefnsF Set TermReference TypeReference) identifyCoreDependencies defns conflicts soloUpdatesAndDeletes = do fold [ -- One source of dependencies: Alice's versions of Bob's unconflicted deletes and updates, and vice-versa. @@ -825,7 +878,7 @@ identifyCoreDependencies defns conflicts soloUpdatesAndDeletes = do -- into the namespace / parsing context for the conflicted merge, because it has an unnamed reference on -- foo#alice. It rather ought to be in the scratchfile alongside the conflicted foo#alice and foo#bob, so -- that when that conflict is resolved, it will propagate to bar. - bifoldMap (Set.map Reference.DerivedId) (Set.map Reference.DerivedId) <$> conflicts + bimap (Set.map Reference.DerivedId) (Set.map Reference.DerivedId) <$> conflicts ] filterDependents :: @@ -884,9 +937,20 @@ makeStageOneV :: Merge.Unconflicts v -> Set Name -> Map Name v -> Map Name v makeStageOneV unconflicts namesToDelete = (`Map.withoutKeys` namesToDelete) . Unconflicts.apply unconflicts -defnsReferences :: Defns (BiMultimap Referent name) (BiMultimap TypeReference name) -> Set Reference -defnsReferences = - bifoldMap (Set.map Referent.toReference . BiMultimap.dom) BiMultimap.dom +defnsReferences :: + Defns (BiMultimap Referent name) (BiMultimap TypeReference name) -> + DefnsF Set TermReference TypeReference +defnsReferences defns = + List.foldl' f Defns {terms = Set.empty, types = BiMultimap.dom defns.types} (Set.toList (BiMultimap.dom defns.terms)) + where + f :: DefnsF Set TermReference TypeReference -> Referent -> DefnsF Set TermReference TypeReference + f acc = \case + Referent.Con (ConstructorReference ref _) _ -> + let !types = Set.insert ref acc.types + in Defns {terms = acc.terms, types} + Referent.Ref ref -> + let !terms = Set.insert ref acc.terms + in Defns {terms, types = acc.types} defnsToNames :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> Names defnsToNames defns = @@ -995,11 +1059,6 @@ typecheckedUnisonFileToBranchAdds tuf = do data DebugFunctions = DebugFunctions { debugCausals :: Merge.TwoOrThreeWay (V2.CausalBranch Transaction) -> IO (), - debugDefns :: - Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - Merge.TwoWay Merge.DeclNameLookup -> - Merge.PartialDeclNameLookup -> - IO (), debugDiffs :: Merge.TwoWay (DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference) -> IO (), debugCombinedDiff :: DefnsF2 (Map Name) Merge.CombinedDiffOp Referent TypeReference -> IO (), debugPartitionedDiff :: @@ -1014,7 +1073,6 @@ realDebugFunctions :: DebugFunctions realDebugFunctions = DebugFunctions { debugCausals = realDebugCausals, - debugDefns = realDebugDefns, debugDiffs = realDebugDiffs, debugCombinedDiff = realDebugCombinedDiff, debugPartitionedDiff = realDebugPartitionedDiff, @@ -1024,7 +1082,7 @@ realDebugFunctions = fakeDebugFunctions :: DebugFunctions fakeDebugFunctions = - DebugFunctions mempty mempty mempty mempty mempty mempty mempty + DebugFunctions mempty mempty mempty mempty mempty mempty realDebugCausals :: Merge.TwoOrThreeWay (V2.CausalBranch Transaction) -> IO () realDebugCausals causals = do @@ -1037,24 +1095,6 @@ realDebugCausals causals = do Nothing -> "Nothing" Just causal -> "Just " <> Hash.toBase32HexText (unCausalHash causal.causalHash) -realDebugDefns :: - Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - Merge.TwoWay Merge.DeclNameLookup -> - Merge.PartialDeclNameLookup -> - IO () -realDebugDefns defns declNameLookups _lcaDeclNameLookup = do - Text.putStrLn (Text.bold "\n=== Alice definitions ===") - debugDefns1 (bimap BiMultimap.range BiMultimap.range defns.alice) - - Text.putStrLn (Text.bold "\n=== Bob definitions ===") - debugDefns1 (bimap BiMultimap.range BiMultimap.range defns.bob) - - Text.putStrLn (Text.bold "\n=== Alice constructor names ===") - debugConstructorNames declNameLookups.alice.declToConstructors - - Text.putStrLn (Text.bold "\n=== Bob constructor names ===") - debugConstructorNames declNameLookups.bob.declToConstructors - realDebugDiffs :: Merge.TwoWay (DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference) -> IO () realDebugDiffs diffs = do Text.putStrLn (Text.bold "\n=== LCA→Alice diff ===") @@ -1239,11 +1279,6 @@ realDebugStageOne defns = do Text.putStrLn (Text.bold "\n=== Stage 1 ===") debugDefns1 defns -debugConstructorNames :: Map Name [Name] -> IO () -debugConstructorNames names = - for_ (Map.toList names) \(typeName, conNames) -> - Text.putStrLn (Name.toText typeName <> " => " <> Text.intercalate ", " (map Name.toText conNames)) - debugDefns1 :: DefnsF (Map Name) Referent TypeReference -> IO () debugDefns1 defns = do renderThings referentLabel Referent.toText defns.terms diff --git a/unison-merge/src/Unison/Merge/PrettyPrintEnv.hs b/unison-merge/src/Unison/Merge/PrettyPrintEnv.hs index 92c2a754e5..6527abc04c 100644 --- a/unison-merge/src/Unison/Merge/PrettyPrintEnv.hs +++ b/unison-merge/src/Unison/Merge/PrettyPrintEnv.hs @@ -3,8 +3,6 @@ module Unison.Merge.PrettyPrintEnv ) where -import Unison.Merge.ThreeWay (ThreeWay) -import Unison.Merge.ThreeWay qualified as ThreeWay import Unison.Merge.TwoWay (TwoWay) import Unison.Names (Names) import Unison.Prelude @@ -13,8 +11,8 @@ import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl) import Unison.PrettyPrintEnvDecl.Names qualified as PPED -- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names -makePrettyPrintEnvs :: ThreeWay Names -> TwoWay PrettyPrintEnvDecl -makePrettyPrintEnvs names3 = - ThreeWay.forgetLca names3 <&> \names -> PPED.makePPED (PPE.namer (names <> names3.lca)) suffixifier +makePrettyPrintEnvs :: TwoWay Names -> Names -> TwoWay PrettyPrintEnvDecl +makePrettyPrintEnvs names2 libdepsNames = + names2 <&> \names -> PPED.makePPED (PPE.namer (names <> libdepsNames)) suffixifier where - suffixifier = PPE.suffixifyByName (fold names3) + suffixifier = PPE.suffixifyByName (fold names2 <> libdepsNames) From c88c4a3643df05395dbb4e70e3a39667b131c8b1 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 6 Aug 2024 13:25:02 -0400 Subject: [PATCH 556/631] rename a couple things --- .../Codebase/Editor/HandleInput/Merge2.hs | 24 +++++++------------ 1 file changed, 9 insertions(+), 15 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 93c0047aa8..853cf95a1f 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -299,7 +299,7 @@ doMerge info = do let blob3 = makeMergeblob3 blob2 dependents0 (Branch.toNames mergedLibdeps) - liftIO (debugFunctions.debugDependents blob3.dependents) + liftIO (debugFunctions.debugDependents (bimap Map.keysSet Map.keysSet <$> blob3.dependents)) liftIO (debugFunctions.debugStageOne blob3.stageOne) @@ -318,19 +318,15 @@ doMerge info = do Nothing -> "" Just name -> Name.toText name } - blob3.renderedConflicts - blob3.renderedDependents + blob3.conflicts + blob3.dependents let stageOneBranch = defnsAndLibdepsToBranch0 env.codebase blob3.stageOne mergedLibdeps maybeTypecheckedUnisonFile <- let thisMergeHasConflicts = - or - [ not (Map.null blob3.renderedConflicts.alice.terms), - not (Map.null blob3.renderedConflicts.alice.types), - not (Map.null blob3.renderedConflicts.bob.terms), - not (Map.null blob3.renderedConflicts.bob.types) - ] + -- Eh, they'd either both be null, or neither, but just check both maps anyway + not (defnsAreEmpty blob3.conflicts.alice) || not (defnsAreEmpty blob3.conflicts.bob) in if thisMergeHasConflicts then pure Nothing else do @@ -547,9 +543,8 @@ makeMergeblob2 blob = do } data Mergeblob3 = Mergeblob3 - { dependents :: Merge.TwoWay (DefnsF Set Name Name), - renderedConflicts :: Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), - renderedDependents :: Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), + { conflicts :: Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), + dependents :: Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), stageOne :: DefnsF (Map Name) Referent TypeReference } @@ -601,9 +596,8 @@ makeMergeblob3 blob dependents0 libdeps = (defnsToNames <$> ThreeWay.forgetLca blob.defns) libdeps in Mergeblob3 - { dependents, - renderedConflicts, - renderedDependents, + { conflicts = renderedConflicts, + dependents = renderedDependents, stageOne } From 53209c3b6939a712ae402db426d35891661b79cf Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 8 Aug 2024 11:16:43 -0400 Subject: [PATCH 557/631] more mergeblob work --- .../Codebase/Editor/HandleInput/Merge2.hs | 191 ++++++++++-------- unison-src/transcripts/merge.md | 7 +- unison-src/transcripts/merge.output.md | 14 +- 3 files changed, 112 insertions(+), 100 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 853cf95a1f..543ee1aca4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -49,7 +49,6 @@ import Unison.Cli.UpdateUtils ( getNamespaceDependentsOf3, hydrateDefns, loadNamespaceDefinitions, - parseAndTypecheck, renderDefnsForUnisonFile, ) import Unison.Codebase (Codebase) @@ -73,6 +72,7 @@ import Unison.ConstructorType (ConstructorType) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration import Unison.Debug qualified as Debug +import Unison.FileParsers qualified as FileParsers import Unison.Hash qualified as Hash import Unison.Merge qualified as Merge import Unison.Merge.DeclNameLookup (expectConstructorNames) @@ -84,9 +84,10 @@ import Unison.Merge.Unconflicts qualified as Unconflicts import Unison.Name (Name) import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment -import Unison.Names (Names) +import Unison.Names (Names (..)) import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) +import Unison.Parsers qualified as Parsers import Unison.Prelude import Unison.Project ( ProjectAndBranch (..), @@ -101,13 +102,18 @@ import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.ReferentPrime qualified as Referent' +import Unison.Result qualified as Result import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name +import Unison.Syntax.Parser (ParsingEnv (..), UniqueName) +import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Type (Type) -import Unison.UnisonFile (TypecheckedUnisonFile) +import Unison.Typechecker qualified as Typechecker +import Unison.Typechecker.TypeLookup (TypeLookup) +import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile) import Unison.UnisonFile qualified as UnisonFile import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap @@ -297,14 +303,16 @@ doMerge info = do mergedLibdeps <- Cli.runTransaction (libdepsToBranch0 (Codebase.getDeclType env.codebase) blob2.libdeps) - let blob3 = makeMergeblob3 blob2 dependents0 (Branch.toNames mergedLibdeps) + uniqueName <- liftIO env.generateUniqueName - liftIO (debugFunctions.debugDependents (bimap Map.keysSet Map.keysSet <$> blob3.dependents)) + let hasConflicts = + blob2.hasConflicts - liftIO (debugFunctions.debugStageOne blob3.stageOne) - - let prettyUnisonFile = - makePrettyUnisonFile + let blob3 = + makeMergeblob3 + blob2 + dependents0 + (Branch.toNames mergedLibdeps) Merge.TwoWay { alice = into @Text aliceBranchNames, bob = @@ -318,27 +326,25 @@ doMerge info = do Nothing -> "" Just name -> Name.toText name } - blob3.conflicts - blob3.dependents - let stageOneBranch = defnsAndLibdepsToBranch0 env.codebase blob3.stageOne mergedLibdeps + maybeBlob5 <- + if hasConflicts + then pure Nothing + else case makeMergeblob4 blob3 uniqueName of + Left _parseErr -> pure Nothing + Right blob4 -> do + typeLookup <- Cli.runTransaction (Codebase.typeLookupForDependencies env.codebase blob4.dependencies) + pure case makeMergeblob5 blob4 typeLookup of + Left _typecheckErr -> Nothing + Right blob5 -> Just blob5 - maybeTypecheckedUnisonFile <- - let thisMergeHasConflicts = - -- Eh, they'd either both be null, or neither, but just check both maps anyway - not (defnsAreEmpty blob3.conflicts.alice) || not (defnsAreEmpty blob3.conflicts.bob) - in if thisMergeHasConflicts - then pure Nothing - else do - currentPath <- Cli.getCurrentProjectPath - parsingEnv <- Cli.makeParsingEnv currentPath (Branch.toNames stageOneBranch) - parseAndTypecheck prettyUnisonFile parsingEnv + let stageOneBranch = defnsAndLibdepsToBranch0 env.codebase blob3.stageOne mergedLibdeps let parents = causals <&> \causal -> (causal.causalHash, Codebase.expectBranchForHash env.codebase causal.causalHash) - case maybeTypecheckedUnisonFile of - Nothing -> do + blob5 <- + maybeBlob5 & onNothing do Cli.Env {writeSource} <- ask (_temporaryBranchId, temporaryBranchName) <- HandleInput.Branch.createBranch @@ -349,21 +355,20 @@ doMerge info = do ) info.alice.projectAndBranch.project (findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget) - scratchFilePath <- Cli.getLatestFile <&> \case Nothing -> "scratch.u" Just (file, _) -> file - liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) - pure (Output.MergeFailure scratchFilePath mergeSourceAndTarget temporaryBranchName) - Just tuf -> do - Cli.runTransaction (Codebase.addDefsToCodebase env.codebase tuf) - let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch - Cli.updateProjectBranchRoot_ - info.alice.projectAndBranch.branch - info.description - (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) - pure (Output.MergeSuccess mergeSourceAndTarget) + liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 blob3.unparsedFile) + done (Output.MergeFailure scratchFilePath mergeSourceAndTarget temporaryBranchName) + + Cli.runTransaction (Codebase.addDefsToCodebase env.codebase blob5.file) + let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds blob5.file) stageOneBranch + Cli.updateProjectBranchRoot_ + info.alice.projectAndBranch.branch + info.description + (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) + pure (Output.MergeSuccess mergeSourceAndTarget) Cli.respond finalOutput @@ -496,6 +501,7 @@ data Mergeblob2 libdep = Mergeblob2 coreDependencies :: Merge.TwoWay (DefnsF Set TermReference TypeReference), declNameLookups :: Merge.TwoWay Merge.DeclNameLookup, defns :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), + hasConflicts :: Bool, hydratedDefns :: Merge.TwoWay ( DefnsF @@ -535,6 +541,8 @@ makeMergeblob2 blob = do coreDependencies, declNameLookups = blob.declNameLookups, defns = blob.defns, + -- Eh, they'd either both be null, or neither, but just check both maps anyway + hasConflicts = not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob), hydratedDefns = ThreeWay.forgetLca blob.hydratedDefns, lcaDeclNameLookup = blob.lcaDeclNameLookup, libdeps = blob.libdeps, @@ -543,17 +551,18 @@ makeMergeblob2 blob = do } data Mergeblob3 = Mergeblob3 - { conflicts :: Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), - dependents :: Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), - stageOne :: DefnsF (Map Name) Referent TypeReference + { libdeps :: Names, + stageOne :: DefnsF (Map Name) Referent TypeReference, + unparsedFile :: Pretty ColorText } makeMergeblob3 :: Mergeblob2 libdep -> Merge.TwoWay (DefnsF Set TermReferenceId TypeReferenceId) -> Names -> + Merge.TwoWay Text -> Mergeblob3 -makeMergeblob3 blob dependents0 libdeps = +makeMergeblob3 blob dependents0 libdeps authors = -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if -- there aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) let dependents = @@ -579,14 +588,6 @@ makeMergeblob3 blob dependents0 libdeps = <*> dependents0 ) - stageOne = - makeStageOne - blob.declNameLookups - blob.conflictsNames - blob.unconflicts - dependents - (bimap BiMultimap.range BiMultimap.range blob.defns.lca) - (renderedConflicts, renderedDependents) = renderConflictsAndDependents blob.declNameLookups @@ -596,11 +597,59 @@ makeMergeblob3 blob dependents0 libdeps = (defnsToNames <$> ThreeWay.forgetLca blob.defns) libdeps in Mergeblob3 - { conflicts = renderedConflicts, - dependents = renderedDependents, - stageOne + { libdeps, + stageOne = + makeStageOne + blob.declNameLookups + blob.conflictsNames + blob.unconflicts + dependents + (bimap BiMultimap.range BiMultimap.range blob.defns.lca), + unparsedFile = makePrettyUnisonFile authors renderedConflicts renderedDependents } +data Mergeblob4 = Mergeblob4 + { dependencies :: Set Reference, + file :: UnisonFile Symbol Ann + } + +makeMergeblob4 :: Mergeblob3 -> UniqueName -> Either (Parser.Err Symbol) Mergeblob4 +makeMergeblob4 blob uniqueName = do + let stageOneNames = + Names (Relation.fromMap blob.stageOne.terms) (Relation.fromMap blob.stageOne.types) <> blob.libdeps + + parsingEnv = + ParsingEnv + { uniqueNames = uniqueName, + -- The codebase names are disjoint from the file names, i.e. there aren't any things that + -- would be classified as an update upon parsing. So, there's no need to try to look up any + -- existing unique type GUIDs to reuse. + uniqueTypeGuid = \_ -> Identity Nothing, + names = stageOneNames + } + file <- runIdentity (Parsers.parseFile "" (Pretty.toPlain 80 blob.unparsedFile) parsingEnv) + Right + Mergeblob4 + { dependencies = UnisonFile.dependencies file, + file + } + +data Mergeblob5 = Mergeblob5 + { file :: TypecheckedUnisonFile Symbol Ann + } + +makeMergeblob5 :: Mergeblob4 -> TypeLookup Symbol Ann -> Either (Seq (Result.Note Symbol Ann)) Mergeblob5 +makeMergeblob5 blob typeLookup = + let typecheckingEnv = + Typechecker.Env + { ambientAbilities = [], + termsByShortname = Map.empty, + typeLookup + } + in case runIdentity (Result.runResultT (FileParsers.synthesizeFile typecheckingEnv blob.file)) of + (Nothing, notes) -> Left notes + (Just file, _) -> Right Mergeblob5 {file} + renderConflictsAndDependents :: Merge.TwoWay Merge.DeclNameLookup -> Merge.TwoWay (DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann)) -> @@ -1058,9 +1107,7 @@ data DebugFunctions = DebugFunctions debugPartitionedDiff :: Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> DefnsF Merge.Unconflicts Referent TypeReference -> - IO (), - debugDependents :: Merge.TwoWay (DefnsF Set Name Name) -> IO (), - debugStageOne :: DefnsF (Map Name) Referent TypeReference -> IO () + IO () } realDebugFunctions :: DebugFunctions @@ -1069,14 +1116,12 @@ realDebugFunctions = { debugCausals = realDebugCausals, debugDiffs = realDebugDiffs, debugCombinedDiff = realDebugCombinedDiff, - debugPartitionedDiff = realDebugPartitionedDiff, - debugDependents = realDebugDependents, - debugStageOne = realDebugStageOne + debugPartitionedDiff = realDebugPartitionedDiff } fakeDebugFunctions :: DebugFunctions fakeDebugFunctions = - DebugFunctions mempty mempty mempty mempty mempty mempty + DebugFunctions mempty mempty mempty mempty realDebugCausals :: Merge.TwoOrThreeWay (V2.CausalBranch Transaction) -> IO () realDebugCausals causals = do @@ -1251,38 +1296,6 @@ realDebugPartitionedDiff conflicts unconflicts = do <> " " <> renderRef ref -realDebugDependents :: Merge.TwoWay (DefnsF Set Name Name) -> IO () -realDebugDependents dependents = do - Text.putStrLn (Text.bold "\n=== Alice dependents of Bob deletes, Bob updates, and Alice conflicts ===") - renderThings "termid" dependents.alice.terms - renderThings "typeid" dependents.alice.types - Text.putStrLn (Text.bold "\n=== Bob dependents of Alice deletes, Alice updates, and Bob conflicts ===") - renderThings "termid" dependents.bob.terms - renderThings "typeid" dependents.bob.types - where - renderThings :: Text -> Set Name -> IO () - renderThings label things = - for_ (Set.toList things) \name -> - Text.putStrLn $ - Text.italic label - <> " " - <> Name.toText name - -realDebugStageOne :: DefnsF (Map Name) Referent TypeReference -> IO () -realDebugStageOne defns = do - Text.putStrLn (Text.bold "\n=== Stage 1 ===") - debugDefns1 defns - -debugDefns1 :: DefnsF (Map Name) Referent TypeReference -> IO () -debugDefns1 defns = do - renderThings referentLabel Referent.toText defns.terms - renderThings (const "type") Reference.toText defns.types - where - renderThings :: (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO () - renderThings label renderRef things = - for_ (Map.toList things) \(name, ref) -> - Text.putStrLn (Text.italic (label ref) <> " " <> Name.toText name <> " " <> renderRef ref) - referentLabel :: Referent -> Text referentLabel ref | Referent'.isConstructor ref = "constructor" diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 1d28320c84..292ccdb278 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -699,11 +699,8 @@ project/main> branch bob ``` Bob's renames `Qux` to `BobQux`: -```unison:hide -unique type Foo = Baz Nat | BobQux Text -``` -```ucm:hide -project/bob> update +```ucm +project/bob> move.term Foo.Qux Foo.BobQux ``` ```ucm:error project/alice> merge /bob diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 8495f8f273..6f4eba070d 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -789,10 +789,12 @@ unique type Foo = Baz Nat Nat | Qux Text Bob's renames `Qux` to `BobQux`: -``` unison -unique type Foo = Baz Nat | BobQux Text -``` +``` ucm +project/bob> move.term Foo.Qux Foo.BobQux + Done. + +``` ``` ucm project/alice> merge /bob @@ -818,7 +820,7 @@ project/alice> merge /bob type Foo = Baz Nat Nat | Qux Text -- project/bob -type Foo = Baz Nat | BobQux Text +type Foo = BobQux Text | Baz Nat ``` @@ -1022,7 +1024,7 @@ Bob, meanwhile, first deletes the term, then sort of deletes the type and re-add ``` ucm project/bob> view Foo.Bar - type Foo.Bar = Baz Nat | Hello Nat Nat + type Foo.Bar = Hello Nat Nat | Baz Nat ``` At this point, Bob and alice have both updated the name `Foo.Bar.Hello` in different ways, so that's a conflict. Therefore, Bob's entire type (`Foo.Bar` with constructors `Foo.Bar.Baz` and `Foo.Bar.Hello`) gets rendered into the scratch file. @@ -1059,7 +1061,7 @@ Foo.Bar.Hello : Nat Foo.Bar.Hello = 18 -- project/bob -type Foo.Bar = Baz Nat | Hello Nat Nat +type Foo.Bar = Hello Nat Nat | Baz Nat ``` From 3b37c4b349ecd4b5a032b91ab27bedcaf1683e90 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 8 Aug 2024 11:50:26 -0400 Subject: [PATCH 558/631] move some of the mergeblob API over to unison-merge --- .../Codebase/Editor/HandleInput/Merge2.hs | 511 +----------------- unison-merge/package.yaml | 1 + unison-merge/src/Unison/Merge.hs | 59 +- unison-merge/src/Unison/Merge/Mergeblob0.hs | 32 ++ unison-merge/src/Unison/Merge/Mergeblob1.hs | 141 +++++ unison-merge/src/Unison/Merge/Mergeblob2.hs | 141 +++++ unison-merge/src/Unison/Merge/Mergeblob3.hs | 293 ++++++++++ unison-merge/unison-merge.cabal | 5 + 8 files changed, 665 insertions(+), 518 deletions(-) create mode 100644 unison-merge/src/Unison/Merge/Mergeblob0.hs create mode 100644 unison-merge/src/Unison/Merge/Mergeblob1.hs create mode 100644 unison-merge/src/Unison/Merge/Mergeblob2.hs create mode 100644 unison-merge/src/Unison/Merge/Mergeblob3.hs diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 543ee1aca4..0e09e7a45c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -15,15 +15,9 @@ module Unison.Codebase.Editor.HandleInput.Merge2 ) where -import Control.Lens (mapped) import Control.Monad.Reader (ask) -import Data.Bifoldable (bifoldMap) -import Data.List qualified as List import Data.Map.Strict qualified as Map -import Data.Semialign (align, unzip, zipWith) -import Data.Set qualified as Set -import Data.Set.NonEmpty (NESet) -import Data.Set.NonEmpty qualified as Set.NonEmpty +import Data.Semialign (zipWith) import Data.Text qualified as Text import Data.Text.IO qualified as Text import Data.These (These (..)) @@ -49,7 +43,6 @@ import Unison.Cli.UpdateUtils ( getNamespaceDependentsOf3, hydrateDefns, loadNamespaceDefinitions, - renderDefnsForUnisonFile, ) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase @@ -67,7 +60,6 @@ import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache) import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions import Unison.Codebase.SqliteCodebase.Operations qualified as Operations -import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType (ConstructorType) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration @@ -75,17 +67,13 @@ import Unison.Debug qualified as Debug import Unison.FileParsers qualified as FileParsers import Unison.Hash qualified as Hash import Unison.Merge qualified as Merge -import Unison.Merge.DeclNameLookup (expectConstructorNames) import Unison.Merge.EitherWayI qualified as EitherWayI import Unison.Merge.Synhashed qualified as Synhashed import Unison.Merge.ThreeWay qualified as ThreeWay -import Unison.Merge.TwoWay qualified as TwoWay -import Unison.Merge.Unconflicts qualified as Unconflicts import Unison.Name (Name) import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment import Unison.Names (Names (..)) -import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Parsers qualified as Parsers import Unison.Prelude @@ -97,7 +85,6 @@ import Unison.Project Semver (..), classifyProjectBranchName, ) -import Unison.Reference (Reference' (..), TermReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -115,14 +102,12 @@ import Unison.Typechecker qualified as Typechecker import Unison.Typechecker.TypeLookup (TypeLookup) import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile) import Unison.UnisonFile qualified as UnisonFile -import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Conflicted (Conflicted) import Unison.Util.Defn (Defn) -import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3, alignDefnsWith, defnsAreEmpty, zipDefnsWith, zipDefnsWith3) +import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3, alignDefnsWith) import Unison.Util.Monoid qualified as Monoid -import Unison.Util.Nametree (Nametree (..), flattenNametrees, unflattenNametree) -import Unison.Util.Pretty (ColorText, Pretty) +import Unison.Util.Nametree (Nametree (..), unflattenNametree) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Relation @@ -253,7 +238,7 @@ doMerge info = do libdeps3 <- Cli.runTransaction (loadLibdeps branches) - let blob0 = makeMergeblob0 nametrees3 libdeps3 + let blob0 = Merge.makeMergeblob0 nametrees3 libdeps3 -- Hydrate hydratedDefns :: @@ -275,7 +260,7 @@ doMerge info = do ) blob1 <- - makeMergeblob1 blob0 hydratedDefns & onLeft \case + Merge.makeMergeblob1 blob0 hydratedDefns & onLeft \case Merge.Alice reason -> done (Output.IncoherentDeclDuringMerge mergeTarget reason) Merge.Bob reason -> done (Output.IncoherentDeclDuringMerge mergeSource reason) @@ -284,13 +269,13 @@ doMerge info = do liftIO (debugFunctions.debugCombinedDiff blob1.diff) blob2 <- - makeMergeblob2 blob1 & onLeft \err -> + Merge.makeMergeblob2 blob1 & onLeft \err -> done case err of - Mergeblob2Error'ConflictedAlias defn0 -> + Merge.Mergeblob2Error'ConflictedAlias defn0 -> case defn0 of Merge.Alice defn -> Output.MergeConflictedAliases mergeTarget defn Merge.Bob defn -> Output.MergeConflictedAliases mergeSource defn - Mergeblob2Error'ConflictedBuiltin defn -> Output.MergeConflictInvolvingBuiltin defn + Merge.Mergeblob2Error'ConflictedBuiltin defn -> Output.MergeConflictInvolvingBuiltin defn liftIO (debugFunctions.debugPartitionedDiff blob2.conflicts blob2.unconflicts) @@ -309,7 +294,7 @@ doMerge info = do blob2.hasConflicts let blob3 = - makeMergeblob3 + Merge.makeMergeblob3 blob2 dependents0 (Branch.toNames mergedLibdeps) @@ -372,248 +357,12 @@ doMerge info = do Cli.respond finalOutput -data Mergeblob0 libdep = Mergeblob0 - { defns :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), - libdeps :: Merge.ThreeWay (Map NameSegment libdep), - nametrees :: Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) - } - -makeMergeblob0 :: - Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> - Merge.ThreeWay (Map NameSegment libdep) -> - Mergeblob0 libdep -makeMergeblob0 nametrees libdeps = - Mergeblob0 - { defns = flattenNametrees <$> nametrees, - libdeps, - nametrees - } - -data Mergeblob1 libdep = Mergeblob1 - { conflicts :: Merge.TwoWay (DefnsF (Map Name) TermReference TypeReference), - declNameLookups :: Merge.TwoWay Merge.DeclNameLookup, - defns :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), - diff :: DefnsF2 (Map Name) Merge.CombinedDiffOp Referent TypeReference, - diffs :: Merge.TwoWay (DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference), - hydratedDefns :: - Merge.ThreeWay - ( DefnsF - (Map Name) - (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) - (TypeReferenceId, Decl Symbol Ann) - ), - lcaDeclNameLookup :: Merge.PartialDeclNameLookup, - libdeps :: Map NameSegment libdep, - libdepsDiff :: Map NameSegment (Merge.LibdepDiffOp libdep), - unconflicts :: DefnsF Merge.Unconflicts Referent TypeReference - } - -makeMergeblob1 :: - forall libdep. - (Eq libdep) => - Mergeblob0 libdep -> - Merge.ThreeWay - ( DefnsF - (Map Name) - (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) - (TypeReferenceId, Decl Symbol Ann) - ) -> - Either (Merge.EitherWay Merge.IncoherentDeclReason) (Mergeblob1 libdep) -makeMergeblob1 blob hydratedDefns = do - -- Make one big constructor count lookup for all type decls - let numConstructors = - Map.empty - & f (Map.elems hydratedDefns.alice.types) - & f (Map.elems hydratedDefns.bob.types) - & f (Map.elems hydratedDefns.lca.types) - where - f :: [(TypeReferenceId, Decl Symbol Ann)] -> Map TypeReferenceId Int -> Map TypeReferenceId Int - f types acc = - List.foldl' - ( \acc (ref, decl) -> - Map.insert ref (DataDeclaration.constructorCount (DataDeclaration.asDataDecl decl)) acc - ) - acc - types - - -- Make Alice/Bob decl name lookups, which can fail if either have an incoherent decl - declNameLookups <- do - alice <- Merge.checkDeclCoherency blob.nametrees.alice numConstructors & mapLeft Merge.Alice - bob <- Merge.checkDeclCoherency blob.nametrees.bob numConstructors & mapLeft Merge.Bob - pure Merge.TwoWay {alice, bob} - - -- Make LCA decl name lookup - let lcaDeclNameLookup = - Merge.lenientCheckDeclCoherency blob.nametrees.lca numConstructors - - -- Diff LCA->Alice and LCA->Bob - let diffs = - Merge.nameBasedNamespaceDiff - declNameLookups - lcaDeclNameLookup - blob.defns - Defns - { terms = - foldMap - (List.foldl' (\acc (ref, (term, _)) -> Map.insert ref term acc) Map.empty . Map.elems . (.terms)) - hydratedDefns, - types = - foldMap - (List.foldl' (\acc (ref, typ) -> Map.insert ref typ acc) Map.empty . Map.elems . (.types)) - hydratedDefns - } - - -- Combine the LCA->Alice and LCA->Bob diffs together - let diff = - Merge.combineDiffs diffs - - -- Partition the combined diff into the conflicted things and the unconflicted things - let (conflicts, unconflicts) = - Merge.partitionCombinedDiffs (ThreeWay.forgetLca blob.defns) declNameLookups diff - - -- Diff and merge libdeps - let libdepsDiff :: Map NameSegment (Merge.LibdepDiffOp libdep) - libdepsDiff = - Merge.diffLibdeps blob.libdeps - - let libdeps :: Map NameSegment libdep - libdeps = - Merge.applyLibdepsDiff Merge.getTwoFreshLibdepNames blob.libdeps libdepsDiff - - pure - Mergeblob1 - { conflicts, - declNameLookups, - defns = blob.defns, - diff, - diffs, - hydratedDefns, - lcaDeclNameLookup, - libdeps, - libdepsDiff, - unconflicts - } - -data Mergeblob2 libdep = Mergeblob2 - { conflicts :: Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId), - conflictsIds :: Merge.TwoWay (DefnsF Set TermReferenceId TypeReferenceId), - conflictsNames :: Merge.TwoWay (DefnsF Set Name Name), - coreDependencies :: Merge.TwoWay (DefnsF Set TermReference TypeReference), - declNameLookups :: Merge.TwoWay Merge.DeclNameLookup, - defns :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), - hasConflicts :: Bool, - hydratedDefns :: - Merge.TwoWay - ( DefnsF - (Map Name) - (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) - (TypeReferenceId, Decl Symbol Ann) - ), - lcaDeclNameLookup :: Merge.PartialDeclNameLookup, - libdeps :: Map NameSegment libdep, - soloUpdatesAndDeletes :: Merge.TwoWay (DefnsF Set Name Name), - unconflicts :: DefnsF Merge.Unconflicts Referent TypeReference - } - -data Mergeblob2Error - = Mergeblob2Error'ConflictedAlias (Merge.EitherWay (Defn (Name, Name) (Name, Name))) - | Mergeblob2Error'ConflictedBuiltin (Defn Name Name) - -makeMergeblob2 :: Mergeblob1 libdep -> Either Mergeblob2Error (Mergeblob2 libdep) -makeMergeblob2 blob = do - -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias - for_ ((,) <$> Merge.TwoWay Merge.Alice Merge.Bob <*> blob.diffs) \(who, diff) -> - whenJust (Merge.findConflictedAlias blob.defns.lca diff) $ - Left . Mergeblob2Error'ConflictedAlias . who - - conflicts <- Merge.narrowConflictsToNonBuiltins blob.conflicts & mapLeft Mergeblob2Error'ConflictedBuiltin - let conflictsIds = bimap (Set.fromList . Map.elems) (Set.fromList . Map.elems) <$> conflicts - let conflictsNames = bimap Map.keysSet Map.keysSet <$> conflicts - - let soloUpdatesAndDeletes = Unconflicts.soloUpdatesAndDeletes blob.unconflicts - let coreDependencies = identifyCoreDependencies (ThreeWay.forgetLca blob.defns) conflictsIds soloUpdatesAndDeletes - - pure - Mergeblob2 - { conflicts, - conflictsIds, - conflictsNames, - coreDependencies, - declNameLookups = blob.declNameLookups, - defns = blob.defns, - -- Eh, they'd either both be null, or neither, but just check both maps anyway - hasConflicts = not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob), - hydratedDefns = ThreeWay.forgetLca blob.hydratedDefns, - lcaDeclNameLookup = blob.lcaDeclNameLookup, - libdeps = blob.libdeps, - soloUpdatesAndDeletes, - unconflicts = blob.unconflicts - } - -data Mergeblob3 = Mergeblob3 - { libdeps :: Names, - stageOne :: DefnsF (Map Name) Referent TypeReference, - unparsedFile :: Pretty ColorText - } - -makeMergeblob3 :: - Mergeblob2 libdep -> - Merge.TwoWay (DefnsF Set TermReferenceId TypeReferenceId) -> - Names -> - Merge.TwoWay Text -> - Mergeblob3 -makeMergeblob3 blob dependents0 libdeps authors = - -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if - -- there aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) - let dependents = - filterDependents - blob.conflictsNames - blob.soloUpdatesAndDeletes - ( let f :: Set TermReferenceId -> Referent -> NESet Name -> Set Name - f deps defn0 names - | Just defn <- Referent.toTermReferenceId defn0, - Set.member defn deps = - Set.NonEmpty.toSet names - | otherwise = Set.empty - g :: Set TypeReferenceId -> TypeReference -> NESet Name -> Set Name - g deps defn0 names - | ReferenceDerived defn <- defn0, - Set.member defn deps = - Set.NonEmpty.toSet names - | otherwise = Set.empty - in zipDefnsWith - (\defns deps -> Map.foldMapWithKey (f deps) (BiMultimap.domain defns)) - (\defns deps -> Map.foldMapWithKey (g deps) (BiMultimap.domain defns)) - <$> ThreeWay.forgetLca blob.defns - <*> dependents0 - ) - - (renderedConflicts, renderedDependents) = - renderConflictsAndDependents - blob.declNameLookups - blob.hydratedDefns - blob.conflictsNames - dependents - (defnsToNames <$> ThreeWay.forgetLca blob.defns) - libdeps - in Mergeblob3 - { libdeps, - stageOne = - makeStageOne - blob.declNameLookups - blob.conflictsNames - blob.unconflicts - dependents - (bimap BiMultimap.range BiMultimap.range blob.defns.lca), - unparsedFile = makePrettyUnisonFile authors renderedConflicts renderedDependents - } - data Mergeblob4 = Mergeblob4 { dependencies :: Set Reference, file :: UnisonFile Symbol Ann } -makeMergeblob4 :: Mergeblob3 -> UniqueName -> Either (Parser.Err Symbol) Mergeblob4 +makeMergeblob4 :: Merge.Mergeblob3 -> UniqueName -> Either (Parser.Err Symbol) Mergeblob4 makeMergeblob4 blob uniqueName = do let stageOneNames = Names (Relation.fromMap blob.stageOne.terms) (Relation.fromMap blob.stageOne.types) <> blob.libdeps @@ -650,41 +399,6 @@ makeMergeblob5 blob typeLookup = (Nothing, notes) -> Left notes (Just file, _) -> Right Mergeblob5 {file} -renderConflictsAndDependents :: - Merge.TwoWay Merge.DeclNameLookup -> - Merge.TwoWay (DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann)) -> - Merge.TwoWay (DefnsF Set Name Name) -> - Merge.TwoWay (DefnsF Set Name Name) -> - Merge.TwoWay Names -> - Names -> - ( Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), - Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) - ) -renderConflictsAndDependents declNameLookups hydratedDefns conflicts dependents names libdepsNames = - unzip $ - ( \declNameLookup (conflicts, dependents) ppe -> - let render = renderDefnsForUnisonFile declNameLookup ppe . over (#terms . mapped) snd - in (render conflicts, render dependents) - ) - <$> declNameLookups - <*> hydratedConflictsAndDependents - <*> Merge.makePrettyPrintEnvs names libdepsNames - where - hydratedConflictsAndDependents :: - Merge.TwoWay - ( DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann), - DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann) - ) - hydratedConflictsAndDependents = - ( \as bs cs -> - ( zipDefnsWith Map.restrictKeys Map.restrictKeys as bs, - zipDefnsWith Map.restrictKeys Map.restrictKeys as cs - ) - ) - <$> hydratedDefns - <*> conflicts - <*> dependents - doMergeLocalBranch :: Merge.TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () doMergeLocalBranch branches = do (aliceCausalHash, bobCausalHash, lcaCausalHash) <- @@ -749,105 +463,9 @@ hasDefnsInLib branch = do Just libdeps -> libdeps.value pure (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) ------------------------------------------------------------------------------------------------------------------------- --- Creating Unison files - -makePrettyUnisonFile :: - Merge.TwoWay Text -> - Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> - Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> - Pretty ColorText -makePrettyUnisonFile authors conflicts dependents = - fold - [ conflicts - -- Merge the two maps together into one, remembering who authored what - & TwoWay.twoWay (zipDefnsWith align align) - -- Sort alphabetically - & inAlphabeticalOrder - -- Render each conflict, types then terms (even though a type can conflict with a term, in which case they - -- would not be adjacent in the file), with an author comment above each conflicted thing - & ( let f = - foldMap \case - This x -> alice x - That y -> bob y - These x y -> alice x <> bob y - where - alice = prettyBinding (Just (Pretty.text authors.alice)) - bob = prettyBinding (Just (Pretty.text authors.bob)) - in bifoldMap f f - ), - -- Show message that delineates where conflicts end and dependents begin only when there are both conflicts and - -- dependents - let thereAre defns = TwoWay.or (not . defnsAreEmpty <$> defns) - in if thereAre conflicts && thereAre dependents - then - fold - [ "-- The definitions below are not conflicted, but they each depend on one or more\n", - "-- conflicted definitions above.\n\n" - ] - else mempty, - dependents - -- Merge dependents together into one map (they are disjoint) - & TwoWay.twoWay (zipDefnsWith Map.union Map.union) - -- Sort alphabetically - & inAlphabeticalOrder - -- Render each dependent, types then terms, without bothering to comment attribution - & (let f = foldMap (prettyBinding Nothing) in bifoldMap f f) - ] - where - prettyBinding maybeComment binding = - fold - [ case maybeComment of - Nothing -> mempty - Just comment -> "-- " <> comment <> "\n", - binding, - "\n", - "\n" - ] - - inAlphabeticalOrder :: DefnsF (Map Name) a b -> DefnsF [] a b - inAlphabeticalOrder = - bimap f f - where - f = map snd . List.sortOn (Name.toText . fst) . Map.toList - ------------------------------------------------------------------------------------------------------------------------ -- --- Given just named term/type reference ids, fill out all names that occupy the term and type namespaces. This is simply --- the given names plus all of the types' constructors. --- --- For example, if the input is --- --- declNameLookup = { --- "Maybe" => ["Maybe.Nothing", "Maybe.Just"] --- } --- defns = { --- terms = { "foo" => #foo } --- types = { "Maybe" => #Maybe } --- } --- --- then the output is --- --- defns = { --- terms = { "foo", "Maybe.Nothing", "Maybe.Just" } --- types = { "Maybe" } --- } -refIdsToNames :: Merge.DeclNameLookup -> DefnsF Set Name Name -> DefnsF Set Name Name -refIdsToNames declNameLookup = - bifoldMap goTerms goTypes - where - goTerms :: Set Name -> DefnsF Set Name Name - goTerms terms = - Defns {terms, types = Set.empty} - - goTypes :: Set Name -> DefnsF Set Name Name - goTypes types = - Defns - { terms = foldMap (Set.fromList . expectConstructorNames declNameLookup) types, - types - } - defnsAndLibdepsToBranch0 :: Codebase IO v a -> DefnsF (Map Name) Referent TypeReference -> @@ -893,115 +511,6 @@ nametreeToBranch0 nametree = rel2star rel = Star2.Star2 {fact = Relation.dom rel, d1 = rel, d2 = Relation.empty} -identifyCoreDependencies :: - Merge.TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - Merge.TwoWay (DefnsF Set TermReferenceId TypeReferenceId) -> - Merge.TwoWay (DefnsF Set Name Name) -> - Merge.TwoWay (DefnsF Set TermReference TypeReference) -identifyCoreDependencies defns conflicts soloUpdatesAndDeletes = do - fold - [ -- One source of dependencies: Alice's versions of Bob's unconflicted deletes and updates, and vice-versa. - -- - -- This is name-based: if Bob updates the *name* "foo", then we go find the thing that Alice calls "foo" (if - -- anything), no matter what its hash is. - defnsReferences - <$> ( zipDefnsWith BiMultimap.restrictRan BiMultimap.restrictRan - <$> TwoWay.swap soloUpdatesAndDeletes - <*> defns - ), - -- The other source of dependencies: Alice's own conflicted things, and ditto for Bob. - -- - -- An example: suppose Alice has foo#alice and Bob has foo#bob, so foo is conflicted. Furthermore, suppose - -- Alice has bar#bar that depends on foo#alice. - -- - -- We want Alice's #alice to be considered a dependency, so that when we go off and find dependents of these - -- dependencies to put in the scratch file for type checking and propagation, we find bar#bar. - -- - -- Note that this is necessary even if bar#bar is unconflicted! We don't want bar#bar to be put directly - -- into the namespace / parsing context for the conflicted merge, because it has an unnamed reference on - -- foo#alice. It rather ought to be in the scratchfile alongside the conflicted foo#alice and foo#bob, so - -- that when that conflict is resolved, it will propagate to bar. - bimap (Set.map Reference.DerivedId) (Set.map Reference.DerivedId) <$> conflicts - ] - -filterDependents :: - (Ord name) => - Merge.TwoWay (DefnsF Set name name) -> - Merge.TwoWay (DefnsF Set name name) -> - Merge.TwoWay (DefnsF Set name name) -> - Merge.TwoWay (DefnsF Set name name) -filterDependents conflicts soloUpdatesAndDeletes dependents0 = - -- There is some subset of Alice's dependents (and ditto for Bob of course) that we don't ultimately want/need to put - -- into the scratch file: those for which any of the following are true: - -- - -- 1. It is Alice-conflicted (since we only want to return *unconflicted* things). - -- 2. It was deleted by Bob. - -- 3. It was updated by Bob and not updated by Alice. - let dependents1 = - zipDefnsWith Set.difference Set.difference - <$> dependents0 - <*> (conflicts <> TwoWay.swap soloUpdatesAndDeletes) - - -- Of the remaining dependents, it's still possible that the maps are not disjoint. But whenever the same name key - -- exists in Alice's and Bob's dependents, the value will either be equal (by Unison hash)... - -- - -- { alice = { terms = {"foo" => #alice} } } - -- { bob = { terms = {"foo" => #alice} } } - -- - -- ...or synhash-equal (i.e. the term or type received different auto-propagated updates)... - -- - -- { alice = { terms = {"foo" => #alice} } } - -- { bob = { terms = {"foo" => #bob} } } - -- - -- So, we can arbitrarily keep Alice's, because they will render the same. - -- - -- { alice = { terms = {"foo" => #alice} } } - -- { bob = { terms = {} } } - dependents2 = - dependents1 & over #bob \bob -> - zipDefnsWith Set.difference Set.difference bob dependents1.alice - in dependents2 - -makeStageOne :: - Merge.TwoWay Merge.DeclNameLookup -> - Merge.TwoWay (DefnsF Set Name Name) -> - DefnsF Merge.Unconflicts term typ -> - Merge.TwoWay (DefnsF Set Name Name) -> - DefnsF (Map Name) term typ -> - DefnsF (Map Name) term typ -makeStageOne declNameLookups conflicts unconflicts dependents = - zipDefnsWith3 makeStageOneV makeStageOneV unconflicts (f conflicts <> f dependents) - where - f :: Merge.TwoWay (DefnsF Set Name Name) -> DefnsF Set Name Name - f defns = - fold (refIdsToNames <$> declNameLookups <*> defns) - -makeStageOneV :: Merge.Unconflicts v -> Set Name -> Map Name v -> Map Name v -makeStageOneV unconflicts namesToDelete = - (`Map.withoutKeys` namesToDelete) . Unconflicts.apply unconflicts - -defnsReferences :: - Defns (BiMultimap Referent name) (BiMultimap TypeReference name) -> - DefnsF Set TermReference TypeReference -defnsReferences defns = - List.foldl' f Defns {terms = Set.empty, types = BiMultimap.dom defns.types} (Set.toList (BiMultimap.dom defns.terms)) - where - f :: DefnsF Set TermReference TypeReference -> Referent -> DefnsF Set TermReference TypeReference - f acc = \case - Referent.Con (ConstructorReference ref _) _ -> - let !types = Set.insert ref acc.types - in Defns {terms = acc.terms, types} - Referent.Ref ref -> - let !terms = Set.insert ref acc.terms - in Defns {terms, types = acc.types} - -defnsToNames :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> Names -defnsToNames defns = - Names.Names - { terms = Relation.fromMap (BiMultimap.range defns.terms), - types = Relation.fromMap (BiMultimap.range defns.types) - } - findTemporaryBranchName :: ProjectId -> MergeSourceAndTarget -> Transaction ProjectBranchName findTemporaryBranchName projectId mergeSourceAndTarget = do ProjectUtils.findTemporaryBranchName projectId preferred diff --git a/unison-merge/package.yaml b/unison-merge/package.yaml index 5a81188e65..33aa2bac68 100644 --- a/unison-merge/package.yaml +++ b/unison-merge/package.yaml @@ -31,6 +31,7 @@ dependencies: - unison-hash - unison-parser-typechecker - unison-prelude + - unison-pretty-printer - unison-sqlite - unison-syntax - unison-util-cache diff --git a/unison-merge/src/Unison/Merge.hs b/unison-merge/src/Unison/Merge.hs index 3ebe8be048..d8d8198cb7 100644 --- a/unison-merge/src/Unison/Merge.hs +++ b/unison-merge/src/Unison/Merge.hs @@ -1,5 +1,16 @@ module Unison.Merge - ( -- * Decl coherency checks + ( Mergeblob0 (..), + makeMergeblob0, + Mergeblob1 (..), + makeMergeblob1, + Mergeblob2 (..), + Mergeblob2Error (..), + makeMergeblob2, + Mergeblob3 (..), + makeMergeblob3, + + -- * Decl coherency checks + DeclNameLookup (..), PartialDeclNameLookup (..), IncoherentDeclReason (..), @@ -9,38 +20,48 @@ module Unison.Merge checkAllDeclCoherency, -- * 3-way namespace diff - DiffOp (..), - nameBasedNamespaceDiff, + + -- DiffOp (..), + -- nameBasedNamespaceDiff, -- * Finding conflicted aliases - findConflictedAlias, + + -- findConflictedAlias, -- * Combining namespace diffs - CombinedDiffOp (..), - combineDiffs, + + -- CombinedDiffOp (..), + -- combineDiffs, -- * Partitioning combined namespace diffs - Unconflicts (..), - partitionCombinedDiffs, - narrowConflictsToNonBuiltins, + + -- Unconflicts (..), + -- partitionCombinedDiffs, + -- narrowConflictsToNonBuiltins, -- * Merging libdeps - LibdepDiffOp (..), - diffLibdeps, - applyLibdepsDiff, - getTwoFreshLibdepNames, + + -- LibdepDiffOp (..), + -- diffLibdeps, + -- applyLibdepsDiff, + -- getTwoFreshLibdepNames, -- * Making a pretty-print environment - makePrettyPrintEnvs, - -- * Utility types + -- makePrettyPrintEnvs, + + -- * Types + CombinedDiffOp(..), + DiffOp(..), EitherWay (..), - ThreeWay (..), - TwoOrThreeWay (..), EitherWayI (..), + LibdepDiffOp(..), Synhashed (..), + ThreeWay (..), + TwoOrThreeWay (..), TwoWay (..), TwoWayI (..), + Unconflicts(..), Updated (..), ) where @@ -60,6 +81,10 @@ import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.EitherWayI (EitherWayI (..)) import Unison.Merge.FindConflictedAlias (findConflictedAlias) import Unison.Merge.Libdeps (LibdepDiffOp (..), applyLibdepsDiff, diffLibdeps, getTwoFreshLibdepNames) +import Unison.Merge.Mergeblob0 (Mergeblob0 (..), makeMergeblob0) +import Unison.Merge.Mergeblob1 (Mergeblob1 (..), makeMergeblob1) +import Unison.Merge.Mergeblob2 (Mergeblob2 (..), Mergeblob2Error (..), makeMergeblob2) +import Unison.Merge.Mergeblob3 (Mergeblob3 (..), makeMergeblob3) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) import Unison.Merge.PartitionCombinedDiffs (narrowConflictsToNonBuiltins, partitionCombinedDiffs) import Unison.Merge.PrettyPrintEnv (makePrettyPrintEnvs) diff --git a/unison-merge/src/Unison/Merge/Mergeblob0.hs b/unison-merge/src/Unison/Merge/Mergeblob0.hs new file mode 100644 index 0000000000..97fea83cac --- /dev/null +++ b/unison-merge/src/Unison/Merge/Mergeblob0.hs @@ -0,0 +1,32 @@ +module Unison.Merge.Mergeblob0 + ( Mergeblob0 (..), + makeMergeblob0, + ) +where + +import Unison.Merge.ThreeWay (ThreeWay) +import Unison.Name (Name) +import Unison.NameSegment (NameSegment) +import Unison.Prelude +import Unison.Reference (TypeReference) +import Unison.Referent (Referent) +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.Defns (Defns, DefnsF) +import Unison.Util.Nametree (Nametree, flattenNametrees) + +data Mergeblob0 libdep = Mergeblob0 + { defns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), + libdeps :: ThreeWay (Map NameSegment libdep), + nametrees :: ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) + } + +makeMergeblob0 :: + ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + ThreeWay (Map NameSegment libdep) -> + Mergeblob0 libdep +makeMergeblob0 nametrees libdeps = + Mergeblob0 + { defns = flattenNametrees <$> nametrees, + libdeps, + nametrees + } diff --git a/unison-merge/src/Unison/Merge/Mergeblob1.hs b/unison-merge/src/Unison/Merge/Mergeblob1.hs new file mode 100644 index 0000000000..10efa84398 --- /dev/null +++ b/unison-merge/src/Unison/Merge/Mergeblob1.hs @@ -0,0 +1,141 @@ +module Unison.Merge.Mergeblob1 + ( Mergeblob1 (..), + makeMergeblob1, + ) +where + +import Data.List qualified as List +import Data.Map.Strict qualified as Map +import Unison.DataDeclaration (Decl) +import Unison.DataDeclaration qualified as DataDeclaration +import Unison.Merge.CombineDiffs (CombinedDiffOp, combineDiffs) +import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason, checkDeclCoherency, lenientCheckDeclCoherency) +import Unison.Merge.DeclNameLookup (DeclNameLookup) +import Unison.Merge.Diff (nameBasedNamespaceDiff) +import Unison.Merge.DiffOp (DiffOp) +import Unison.Merge.EitherWay (EitherWay (..)) +import Unison.Merge.Libdeps (LibdepDiffOp, applyLibdepsDiff, diffLibdeps, getTwoFreshLibdepNames) +import Unison.Merge.Mergeblob0 (Mergeblob0 (..)) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) +import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs) +import Unison.Merge.Synhashed (Synhashed) +import Unison.Merge.ThreeWay (ThreeWay) +import Unison.Merge.ThreeWay qualified as ThreeWay +import Unison.Merge.TwoWay (TwoWay (..)) +import Unison.Merge.Unconflicts (Unconflicts) +import Unison.Name (Name) +import Unison.NameSegment (NameSegment) +import Unison.Parser.Ann (Ann) +import Unison.Prelude +import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId) +import Unison.Referent (Referent) +import Unison.Symbol (Symbol) +import Unison.Term (Term) +import Unison.Type (Type) +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3) + +data Mergeblob1 libdep = Mergeblob1 + { conflicts :: TwoWay (DefnsF (Map Name) TermReference TypeReference), + declNameLookups :: TwoWay DeclNameLookup, + defns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), + diff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference, + diffs :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference), + hydratedDefns :: + ThreeWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ), + lcaDeclNameLookup :: PartialDeclNameLookup, + libdeps :: Map NameSegment libdep, + libdepsDiff :: Map NameSegment (LibdepDiffOp libdep), + unconflicts :: DefnsF Unconflicts Referent TypeReference + } + +makeMergeblob1 :: + forall libdep. + (Eq libdep) => + Mergeblob0 libdep -> + ThreeWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ) -> + Either (EitherWay IncoherentDeclReason) (Mergeblob1 libdep) +makeMergeblob1 blob hydratedDefns = do + -- Make one big constructor count lookup for all type decls + let numConstructors = + Map.empty + & f (Map.elems hydratedDefns.alice.types) + & f (Map.elems hydratedDefns.bob.types) + & f (Map.elems hydratedDefns.lca.types) + where + f :: [(TypeReferenceId, Decl Symbol Ann)] -> Map TypeReferenceId Int -> Map TypeReferenceId Int + f types acc = + List.foldl' + ( \acc (ref, decl) -> + Map.insert ref (DataDeclaration.constructorCount (DataDeclaration.asDataDecl decl)) acc + ) + acc + types + + -- Make Alice/Bob decl name lookups, which can fail if either have an incoherent decl + declNameLookups <- do + alice <- checkDeclCoherency blob.nametrees.alice numConstructors & mapLeft Alice + bob <- checkDeclCoherency blob.nametrees.bob numConstructors & mapLeft Bob + pure TwoWay {alice, bob} + + -- Make LCA decl name lookup + let lcaDeclNameLookup = + lenientCheckDeclCoherency blob.nametrees.lca numConstructors + + -- Diff LCA->Alice and LCA->Bob + let diffs = + nameBasedNamespaceDiff + declNameLookups + lcaDeclNameLookup + blob.defns + Defns + { terms = + foldMap + (List.foldl' (\acc (ref, (term, _)) -> Map.insert ref term acc) Map.empty . Map.elems . (.terms)) + hydratedDefns, + types = + foldMap + (List.foldl' (\acc (ref, typ) -> Map.insert ref typ acc) Map.empty . Map.elems . (.types)) + hydratedDefns + } + + -- Combine the LCA->Alice and LCA->Bob diffs together + let diff = + combineDiffs diffs + + -- Partition the combined diff into the conflicted things and the unconflicted things + let (conflicts, unconflicts) = + partitionCombinedDiffs (ThreeWay.forgetLca blob.defns) declNameLookups diff + + -- Diff and merge libdeps + let libdepsDiff :: Map NameSegment (LibdepDiffOp libdep) + libdepsDiff = + diffLibdeps blob.libdeps + + let libdeps :: Map NameSegment libdep + libdeps = + applyLibdepsDiff getTwoFreshLibdepNames blob.libdeps libdepsDiff + + pure + Mergeblob1 + { conflicts, + declNameLookups, + defns = blob.defns, + diff, + diffs, + hydratedDefns, + lcaDeclNameLookup, + libdeps, + libdepsDiff, + unconflicts + } diff --git a/unison-merge/src/Unison/Merge/Mergeblob2.hs b/unison-merge/src/Unison/Merge/Mergeblob2.hs new file mode 100644 index 0000000000..321e94e2e4 --- /dev/null +++ b/unison-merge/src/Unison/Merge/Mergeblob2.hs @@ -0,0 +1,141 @@ +module Unison.Merge.Mergeblob2 + ( Mergeblob2 (..), + Mergeblob2Error (..), + makeMergeblob2, + ) +where + +import Data.List qualified as List +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Unison.ConstructorReference (GConstructorReference (..)) +import Unison.DataDeclaration (Decl) +import Unison.Merge.DeclNameLookup (DeclNameLookup) +import Unison.Merge.EitherWay (EitherWay (..)) +import Unison.Merge.FindConflictedAlias (findConflictedAlias) +import Unison.Merge.Mergeblob1 (Mergeblob1 (..)) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) +import Unison.Merge.PartitionCombinedDiffs (narrowConflictsToNonBuiltins) +import Unison.Merge.ThreeWay (ThreeWay) +import Unison.Merge.ThreeWay qualified as ThreeWay +import Unison.Merge.TwoWay (TwoWay (..)) +import Unison.Merge.TwoWay qualified as TwoWay +import Unison.Merge.Unconflicts (Unconflicts) +import Unison.Merge.Unconflicts qualified as Unconflicts +import Unison.Name (Name) +import Unison.NameSegment (NameSegment) +import Unison.Parser.Ann (Ann) +import Unison.Prelude +import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId) +import Unison.Reference qualified as Reference +import Unison.Referent (Referent) +import Unison.Referent qualified as Referent +import Unison.Symbol (Symbol) +import Unison.Term (Term) +import Unison.Type (Type) +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defn (Defn) +import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty, zipDefnsWith) + +data Mergeblob2 libdep = Mergeblob2 + { conflicts :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId), + conflictsIds :: TwoWay (DefnsF Set TermReferenceId TypeReferenceId), + conflictsNames :: TwoWay (DefnsF Set Name Name), + coreDependencies :: TwoWay (DefnsF Set TermReference TypeReference), + declNameLookups :: TwoWay DeclNameLookup, + defns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), + hasConflicts :: Bool, + hydratedDefns :: + TwoWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ), + lcaDeclNameLookup :: PartialDeclNameLookup, + libdeps :: Map NameSegment libdep, + soloUpdatesAndDeletes :: TwoWay (DefnsF Set Name Name), + unconflicts :: DefnsF Unconflicts Referent TypeReference + } + +data Mergeblob2Error + = Mergeblob2Error'ConflictedAlias (EitherWay (Defn (Name, Name) (Name, Name))) + | Mergeblob2Error'ConflictedBuiltin (Defn Name Name) + +makeMergeblob2 :: Mergeblob1 libdep -> Either Mergeblob2Error (Mergeblob2 libdep) +makeMergeblob2 blob = do + -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias + for_ ((,) <$> TwoWay Alice Bob <*> blob.diffs) \(who, diff) -> + whenJust (findConflictedAlias blob.defns.lca diff) $ + Left . Mergeblob2Error'ConflictedAlias . who + + conflicts <- narrowConflictsToNonBuiltins blob.conflicts & mapLeft Mergeblob2Error'ConflictedBuiltin + let conflictsIds = bimap (Set.fromList . Map.elems) (Set.fromList . Map.elems) <$> conflicts + let conflictsNames = bimap Map.keysSet Map.keysSet <$> conflicts + + let soloUpdatesAndDeletes = Unconflicts.soloUpdatesAndDeletes blob.unconflicts + let coreDependencies = identifyCoreDependencies (ThreeWay.forgetLca blob.defns) conflictsIds soloUpdatesAndDeletes + + pure + Mergeblob2 + { conflicts, + conflictsIds, + conflictsNames, + coreDependencies, + declNameLookups = blob.declNameLookups, + defns = blob.defns, + -- Eh, they'd either both be null, or neither, but just check both maps anyway + hasConflicts = not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob), + hydratedDefns = ThreeWay.forgetLca blob.hydratedDefns, + lcaDeclNameLookup = blob.lcaDeclNameLookup, + libdeps = blob.libdeps, + soloUpdatesAndDeletes, + unconflicts = blob.unconflicts + } + +identifyCoreDependencies :: + TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> + TwoWay (DefnsF Set TermReferenceId TypeReferenceId) -> + TwoWay (DefnsF Set Name Name) -> + TwoWay (DefnsF Set TermReference TypeReference) +identifyCoreDependencies defns conflicts soloUpdatesAndDeletes = do + fold + [ -- One source of dependencies: Alice's versions of Bob's unconflicted deletes and updates, and vice-versa. + -- + -- This is name-based: if Bob updates the *name* "foo", then we go find the thing that Alice calls "foo" (if + -- anything), no matter what its hash is. + defnsReferences + <$> ( zipDefnsWith BiMultimap.restrictRan BiMultimap.restrictRan + <$> TwoWay.swap soloUpdatesAndDeletes + <*> defns + ), + -- The other source of dependencies: Alice's own conflicted things, and ditto for Bob. + -- + -- An example: suppose Alice has foo#alice and Bob has foo#bob, so foo is conflicted. Furthermore, suppose + -- Alice has bar#bar that depends on foo#alice. + -- + -- We want Alice's #alice to be considered a dependency, so that when we go off and find dependents of these + -- dependencies to put in the scratch file for type checking and propagation, we find bar#bar. + -- + -- Note that this is necessary even if bar#bar is unconflicted! We don't want bar#bar to be put directly + -- into the namespace / parsing context for the conflicted merge, because it has an unnamed reference on + -- foo#alice. It rather ought to be in the scratchfile alongside the conflicted foo#alice and foo#bob, so + -- that when that conflict is resolved, it will propagate to bar. + bimap (Set.map Reference.DerivedId) (Set.map Reference.DerivedId) <$> conflicts + ] + +defnsReferences :: + Defns (BiMultimap Referent name) (BiMultimap TypeReference name) -> + DefnsF Set TermReference TypeReference +defnsReferences defns = + List.foldl' f Defns {terms = Set.empty, types = BiMultimap.dom defns.types} (Set.toList (BiMultimap.dom defns.terms)) + where + f :: DefnsF Set TermReference TypeReference -> Referent -> DefnsF Set TermReference TypeReference + f acc = \case + Referent.Con (ConstructorReference ref _) _ -> + let !types = Set.insert ref acc.types + in Defns {terms = acc.terms, types} + Referent.Ref ref -> + let !terms = Set.insert ref acc.terms + in Defns {terms, types = acc.types} diff --git a/unison-merge/src/Unison/Merge/Mergeblob3.hs b/unison-merge/src/Unison/Merge/Mergeblob3.hs new file mode 100644 index 0000000000..3b8e58729c --- /dev/null +++ b/unison-merge/src/Unison/Merge/Mergeblob3.hs @@ -0,0 +1,293 @@ +module Unison.Merge.Mergeblob3 + ( Mergeblob3 (..), + makeMergeblob3, + ) +where + +import Control.Lens (mapped) +import Data.Align (align) +import Data.Bifoldable (bifoldMap) +import Data.List qualified as List +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Set.NonEmpty (NESet) +import Data.Set.NonEmpty qualified as Set.NonEmpty +import Data.These (These (..)) +import Data.Zip (unzip) +import Unison.DataDeclaration (Decl) +import Unison.Merge.DeclNameLookup (DeclNameLookup, expectConstructorNames) +import Unison.Merge.Mergeblob2 (Mergeblob2 (..)) +import Unison.Merge.PrettyPrintEnv (makePrettyPrintEnvs) +import Unison.Merge.ThreeWay qualified as ThreeWay +import Unison.Merge.TwoWay (TwoWay) +import Unison.Merge.TwoWay qualified as TwoWay +import Unison.Merge.Unconflicts (Unconflicts) +import Unison.Merge.Unconflicts qualified as Unconflicts +import Unison.Name (Name) +import Unison.Names (Names (..)) +import Unison.Parser.Ann (Ann) +import Unison.Prelude +import Unison.Reference (Reference' (..), TermReferenceId, TypeReference, TypeReferenceId) +import Unison.Referent (Referent) +import Unison.Referent qualified as Referent +import Unison.Symbol (Symbol) +import Unison.Syntax.Name qualified as Name +import Unison.Term (Term) +import Unison.Type (Type) +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty, zipDefnsWith, zipDefnsWith3) +import Unison.Util.Pretty (ColorText, Pretty) +import Unison.Util.Pretty qualified as Pretty +import Unison.Util.Relation qualified as Relation +import Prelude hiding (unzip) + +data Mergeblob3 = Mergeblob3 + { libdeps :: Names, + stageOne :: DefnsF (Map Name) Referent TypeReference, + unparsedFile :: Pretty ColorText + } + +makeMergeblob3 :: + Mergeblob2 libdep -> + TwoWay (DefnsF Set TermReferenceId TypeReferenceId) -> + Names -> + TwoWay Text -> + Mergeblob3 +makeMergeblob3 blob dependents0 libdeps authors = + -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if + -- there aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) + let dependents = + filterDependents + blob.conflictsNames + blob.soloUpdatesAndDeletes + ( let f :: Set TermReferenceId -> Referent -> NESet Name -> Set Name + f deps defn0 names + | Just defn <- Referent.toTermReferenceId defn0, + Set.member defn deps = + Set.NonEmpty.toSet names + | otherwise = Set.empty + g :: Set TypeReferenceId -> TypeReference -> NESet Name -> Set Name + g deps defn0 names + | ReferenceDerived defn <- defn0, + Set.member defn deps = + Set.NonEmpty.toSet names + | otherwise = Set.empty + in zipDefnsWith + (\defns deps -> Map.foldMapWithKey (f deps) (BiMultimap.domain defns)) + (\defns deps -> Map.foldMapWithKey (g deps) (BiMultimap.domain defns)) + <$> ThreeWay.forgetLca blob.defns + <*> dependents0 + ) + + (renderedConflicts, renderedDependents) = + renderConflictsAndDependents + blob.declNameLookups + blob.hydratedDefns + blob.conflictsNames + dependents + (defnsToNames <$> ThreeWay.forgetLca blob.defns) + libdeps + in Mergeblob3 + { libdeps, + stageOne = + makeStageOne + blob.declNameLookups + blob.conflictsNames + blob.unconflicts + dependents + (bimap BiMultimap.range BiMultimap.range blob.defns.lca), + unparsedFile = makePrettyUnisonFile authors renderedConflicts renderedDependents + } + +filterDependents :: + (Ord name) => + TwoWay (DefnsF Set name name) -> + TwoWay (DefnsF Set name name) -> + TwoWay (DefnsF Set name name) -> + TwoWay (DefnsF Set name name) +filterDependents conflicts soloUpdatesAndDeletes dependents0 = + -- There is some subset of Alice's dependents (and ditto for Bob of course) that we don't ultimately want/need to put + -- into the scratch file: those for which any of the following are true: + -- + -- 1. It is Alice-conflicted (since we only want to return *unconflicted* things). + -- 2. It was deleted by Bob. + -- 3. It was updated by Bob and not updated by Alice. + let dependents1 = + zipDefnsWith Set.difference Set.difference + <$> dependents0 + <*> (conflicts <> TwoWay.swap soloUpdatesAndDeletes) + + -- Of the remaining dependents, it's still possible that the maps are not disjoint. But whenever the same name key + -- exists in Alice's and Bob's dependents, the value will either be equal (by Unison hash)... + -- + -- { alice = { terms = {"foo" => #alice} } } + -- { bob = { terms = {"foo" => #alice} } } + -- + -- ...or synhash-equal (i.e. the term or type received different auto-propagated updates)... + -- + -- { alice = { terms = {"foo" => #alice} } } + -- { bob = { terms = {"foo" => #bob} } } + -- + -- So, we can arbitrarily keep Alice's, because they will render the same. + -- + -- { alice = { terms = {"foo" => #alice} } } + -- { bob = { terms = {} } } + dependents2 = + dependents1 & over #bob \bob -> + zipDefnsWith Set.difference Set.difference bob dependents1.alice + in dependents2 + +makeStageOne :: + TwoWay DeclNameLookup -> + TwoWay (DefnsF Set Name Name) -> + DefnsF Unconflicts term typ -> + TwoWay (DefnsF Set Name Name) -> + DefnsF (Map Name) term typ -> + DefnsF (Map Name) term typ +makeStageOne declNameLookups conflicts unconflicts dependents = + zipDefnsWith3 makeStageOneV makeStageOneV unconflicts (f conflicts <> f dependents) + where + f :: TwoWay (DefnsF Set Name Name) -> DefnsF Set Name Name + f defns = + fold (refIdsToNames <$> declNameLookups <*> defns) + +makeStageOneV :: Unconflicts v -> Set Name -> Map Name v -> Map Name v +makeStageOneV unconflicts namesToDelete = + (`Map.withoutKeys` namesToDelete) . Unconflicts.apply unconflicts + +-- Given just named term/type reference ids, fill out all names that occupy the term and type namespaces. This is simply +-- the given names plus all of the types' constructors. +-- +-- For example, if the input is +-- +-- declNameLookup = { +-- "Maybe" => ["Maybe.Nothing", "Maybe.Just"] +-- } +-- defns = { +-- terms = { "foo" => #foo } +-- types = { "Maybe" => #Maybe } +-- } +-- +-- then the output is +-- +-- defns = { +-- terms = { "foo", "Maybe.Nothing", "Maybe.Just" } +-- types = { "Maybe" } +-- } +refIdsToNames :: DeclNameLookup -> DefnsF Set Name Name -> DefnsF Set Name Name +refIdsToNames declNameLookup = + bifoldMap goTerms goTypes + where + goTerms :: Set Name -> DefnsF Set Name Name + goTerms terms = + Defns {terms, types = Set.empty} + + goTypes :: Set Name -> DefnsF Set Name Name + goTypes types = + Defns + { terms = foldMap (Set.fromList . expectConstructorNames declNameLookup) types, + types + } + +renderConflictsAndDependents :: + TwoWay DeclNameLookup -> + TwoWay (DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann)) -> + TwoWay (DefnsF Set Name Name) -> + TwoWay (DefnsF Set Name Name) -> + TwoWay Names -> + Names -> + ( TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), + TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) + ) +renderConflictsAndDependents declNameLookups hydratedDefns conflicts dependents names libdepsNames = + unzip $ + ( \declNameLookup (conflicts, dependents) ppe -> + let renderDefnsForUnisonFile = wundefined + render = renderDefnsForUnisonFile declNameLookup ppe . over (#terms . mapped) snd + in (render conflicts, render dependents) + ) + <$> declNameLookups + <*> hydratedConflictsAndDependents + <*> makePrettyPrintEnvs names libdepsNames + where + hydratedConflictsAndDependents :: + TwoWay + ( DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann), + DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann) + ) + hydratedConflictsAndDependents = + ( \as bs cs -> + ( zipDefnsWith Map.restrictKeys Map.restrictKeys as bs, + zipDefnsWith Map.restrictKeys Map.restrictKeys as cs + ) + ) + <$> hydratedDefns + <*> conflicts + <*> dependents + +defnsToNames :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> Names +defnsToNames defns = + Names + { terms = Relation.fromMap (BiMultimap.range defns.terms), + types = Relation.fromMap (BiMultimap.range defns.types) + } + +makePrettyUnisonFile :: + TwoWay Text -> + TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> + TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> + Pretty ColorText +makePrettyUnisonFile authors conflicts dependents = + fold + [ conflicts + -- Merge the two maps together into one, remembering who authored what + & TwoWay.twoWay (zipDefnsWith align align) + -- Sort alphabetically + & inAlphabeticalOrder + -- Render each conflict, types then terms (even though a type can conflict with a term, in which case they + -- would not be adjacent in the file), with an author comment above each conflicted thing + & ( let f = + foldMap \case + This x -> alice x + That y -> bob y + These x y -> alice x <> bob y + where + alice = prettyBinding (Just (Pretty.text authors.alice)) + bob = prettyBinding (Just (Pretty.text authors.bob)) + in bifoldMap f f + ), + -- Show message that delineates where conflicts end and dependents begin only when there are both conflicts and + -- dependents + let thereAre defns = TwoWay.or (not . defnsAreEmpty <$> defns) + in if thereAre conflicts && thereAre dependents + then + fold + [ "-- The definitions below are not conflicted, but they each depend on one or more\n", + "-- conflicted definitions above.\n\n" + ] + else mempty, + dependents + -- Merge dependents together into one map (they are disjoint) + & TwoWay.twoWay (zipDefnsWith Map.union Map.union) + -- Sort alphabetically + & inAlphabeticalOrder + -- Render each dependent, types then terms, without bothering to comment attribution + & (let f = foldMap (prettyBinding Nothing) in bifoldMap f f) + ] + where + prettyBinding maybeComment binding = + fold + [ case maybeComment of + Nothing -> mempty + Just comment -> "-- " <> comment <> "\n", + binding, + "\n", + "\n" + ] + + inAlphabeticalOrder :: DefnsF (Map Name) a b -> DefnsF [] a b + inAlphabeticalOrder = + bimap f f + where + f = map snd . List.sortOn (Name.toText . fst) . Map.toList diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index 40f347cf70..4aa8b21073 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -27,6 +27,10 @@ library Unison.Merge.EitherWayI Unison.Merge.FindConflictedAlias Unison.Merge.Libdeps + Unison.Merge.Mergeblob0 + Unison.Merge.Mergeblob1 + Unison.Merge.Mergeblob2 + Unison.Merge.Mergeblob3 Unison.Merge.PartialDeclNameLookup Unison.Merge.PartitionCombinedDiffs Unison.Merge.PrettyPrintEnv @@ -103,6 +107,7 @@ library , unison-hash , unison-parser-typechecker , unison-prelude + , unison-pretty-printer , unison-sqlite , unison-syntax , unison-util-cache From 2b3311616368cf00a364dd70372288f67f42fafc Mon Sep 17 00:00:00 2001 From: mitchellwrosen Date: Thu, 8 Aug 2024 15:51:13 +0000 Subject: [PATCH 559/631] automatically run ormolu --- unison-merge/src/Unison/Merge.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/unison-merge/src/Unison/Merge.hs b/unison-merge/src/Unison/Merge.hs index d8d8198cb7..5b3cdbcc1a 100644 --- a/unison-merge/src/Unison/Merge.hs +++ b/unison-merge/src/Unison/Merge.hs @@ -10,7 +10,6 @@ module Unison.Merge makeMergeblob3, -- * Decl coherency checks - DeclNameLookup (..), PartialDeclNameLookup (..), IncoherentDeclReason (..), @@ -51,17 +50,17 @@ module Unison.Merge -- makePrettyPrintEnvs, -- * Types - CombinedDiffOp(..), - DiffOp(..), + CombinedDiffOp (..), + DiffOp (..), EitherWay (..), EitherWayI (..), - LibdepDiffOp(..), + LibdepDiffOp (..), Synhashed (..), ThreeWay (..), TwoOrThreeWay (..), TwoWay (..), TwoWayI (..), - Unconflicts(..), + Unconflicts (..), Updated (..), ) where From a40bfd64ad3c4acc992f6097cece80372a7edc55 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 8 Aug 2024 11:57:14 -0400 Subject: [PATCH 560/631] move the rest of the mergeblobs over --- .../Codebase/Editor/HandleInput/Merge2.hs | 56 +------------------ unison-merge/src/Unison/Merge.hs | 45 +++------------ unison-merge/src/Unison/Merge/Mergeblob4.hs | 46 +++++++++++++++ unison-merge/src/Unison/Merge/Mergeblob5.hs | 32 +++++++++++ unison-merge/unison-merge.cabal | 2 + 5 files changed, 91 insertions(+), 90 deletions(-) create mode 100644 unison-merge/src/Unison/Merge/Mergeblob4.hs create mode 100644 unison-merge/src/Unison/Merge/Mergeblob5.hs diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 0e09e7a45c..c3fb06f800 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -64,7 +64,6 @@ import Unison.ConstructorType (ConstructorType) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration import Unison.Debug qualified as Debug -import Unison.FileParsers qualified as FileParsers import Unison.Hash qualified as Hash import Unison.Merge qualified as Merge import Unison.Merge.EitherWayI qualified as EitherWayI @@ -73,9 +72,7 @@ import Unison.Merge.ThreeWay qualified as ThreeWay import Unison.Name (Name) import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment -import Unison.Names (Names (..)) import Unison.Parser.Ann (Ann) -import Unison.Parsers qualified as Parsers import Unison.Prelude import Unison.Project ( ProjectAndBranch (..), @@ -89,18 +86,13 @@ import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.ReferentPrime qualified as Referent' -import Unison.Result qualified as Result import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name -import Unison.Syntax.Parser (ParsingEnv (..), UniqueName) -import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Type (Type) -import Unison.Typechecker qualified as Typechecker -import Unison.Typechecker.TypeLookup (TypeLookup) -import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile) +import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.UnisonFile qualified as UnisonFile import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Conflicted (Conflicted) @@ -315,11 +307,11 @@ doMerge info = do maybeBlob5 <- if hasConflicts then pure Nothing - else case makeMergeblob4 blob3 uniqueName of + else case Merge.makeMergeblob4 blob3 uniqueName of Left _parseErr -> pure Nothing Right blob4 -> do typeLookup <- Cli.runTransaction (Codebase.typeLookupForDependencies env.codebase blob4.dependencies) - pure case makeMergeblob5 blob4 typeLookup of + pure case Merge.makeMergeblob5 blob4 typeLookup of Left _typecheckErr -> Nothing Right blob5 -> Just blob5 @@ -357,48 +349,6 @@ doMerge info = do Cli.respond finalOutput -data Mergeblob4 = Mergeblob4 - { dependencies :: Set Reference, - file :: UnisonFile Symbol Ann - } - -makeMergeblob4 :: Merge.Mergeblob3 -> UniqueName -> Either (Parser.Err Symbol) Mergeblob4 -makeMergeblob4 blob uniqueName = do - let stageOneNames = - Names (Relation.fromMap blob.stageOne.terms) (Relation.fromMap blob.stageOne.types) <> blob.libdeps - - parsingEnv = - ParsingEnv - { uniqueNames = uniqueName, - -- The codebase names are disjoint from the file names, i.e. there aren't any things that - -- would be classified as an update upon parsing. So, there's no need to try to look up any - -- existing unique type GUIDs to reuse. - uniqueTypeGuid = \_ -> Identity Nothing, - names = stageOneNames - } - file <- runIdentity (Parsers.parseFile "" (Pretty.toPlain 80 blob.unparsedFile) parsingEnv) - Right - Mergeblob4 - { dependencies = UnisonFile.dependencies file, - file - } - -data Mergeblob5 = Mergeblob5 - { file :: TypecheckedUnisonFile Symbol Ann - } - -makeMergeblob5 :: Mergeblob4 -> TypeLookup Symbol Ann -> Either (Seq (Result.Note Symbol Ann)) Mergeblob5 -makeMergeblob5 blob typeLookup = - let typecheckingEnv = - Typechecker.Env - { ambientAbilities = [], - termsByShortname = Map.empty, - typeLookup - } - in case runIdentity (Result.runResultT (FileParsers.synthesizeFile typecheckingEnv blob.file)) of - (Nothing, notes) -> Left notes - (Just file, _) -> Right Mergeblob5 {file} - doMergeLocalBranch :: Merge.TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () doMergeLocalBranch branches = do (aliceCausalHash, bobCausalHash, lcaCausalHash) <- diff --git a/unison-merge/src/Unison/Merge.hs b/unison-merge/src/Unison/Merge.hs index 5b3cdbcc1a..e2d6da587c 100644 --- a/unison-merge/src/Unison/Merge.hs +++ b/unison-merge/src/Unison/Merge.hs @@ -8,6 +8,10 @@ module Unison.Merge makeMergeblob2, Mergeblob3 (..), makeMergeblob3, + Mergeblob4 (..), + makeMergeblob4, + Mergeblob5 (..), + makeMergeblob5, -- * Decl coherency checks DeclNameLookup (..), @@ -18,37 +22,6 @@ module Unison.Merge IncoherentDeclReasons (..), checkAllDeclCoherency, - -- * 3-way namespace diff - - -- DiffOp (..), - -- nameBasedNamespaceDiff, - - -- * Finding conflicted aliases - - -- findConflictedAlias, - - -- * Combining namespace diffs - - -- CombinedDiffOp (..), - -- combineDiffs, - - -- * Partitioning combined namespace diffs - - -- Unconflicts (..), - -- partitionCombinedDiffs, - -- narrowConflictsToNonBuiltins, - - -- * Merging libdeps - - -- LibdepDiffOp (..), - -- diffLibdeps, - -- applyLibdepsDiff, - -- getTwoFreshLibdepNames, - - -- * Making a pretty-print environment - - -- makePrettyPrintEnvs, - -- * Types CombinedDiffOp (..), DiffOp (..), @@ -65,7 +38,7 @@ module Unison.Merge ) where -import Unison.Merge.CombineDiffs (CombinedDiffOp (..), combineDiffs) +import Unison.Merge.CombineDiffs (CombinedDiffOp (..)) import Unison.Merge.DeclCoherencyCheck ( IncoherentDeclReason (..), IncoherentDeclReasons (..), @@ -74,19 +47,17 @@ import Unison.Merge.DeclCoherencyCheck lenientCheckDeclCoherency, ) import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) -import Unison.Merge.Diff (nameBasedNamespaceDiff) import Unison.Merge.DiffOp (DiffOp (..)) import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.EitherWayI (EitherWayI (..)) -import Unison.Merge.FindConflictedAlias (findConflictedAlias) -import Unison.Merge.Libdeps (LibdepDiffOp (..), applyLibdepsDiff, diffLibdeps, getTwoFreshLibdepNames) +import Unison.Merge.Libdeps (LibdepDiffOp (..)) import Unison.Merge.Mergeblob0 (Mergeblob0 (..), makeMergeblob0) import Unison.Merge.Mergeblob1 (Mergeblob1 (..), makeMergeblob1) import Unison.Merge.Mergeblob2 (Mergeblob2 (..), Mergeblob2Error (..), makeMergeblob2) import Unison.Merge.Mergeblob3 (Mergeblob3 (..), makeMergeblob3) +import Unison.Merge.Mergeblob4 (Mergeblob4 (..), makeMergeblob4) +import Unison.Merge.Mergeblob5 (Mergeblob5 (..), makeMergeblob5) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) -import Unison.Merge.PartitionCombinedDiffs (narrowConflictsToNonBuiltins, partitionCombinedDiffs) -import Unison.Merge.PrettyPrintEnv (makePrettyPrintEnvs) import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.ThreeWay (ThreeWay (..)) import Unison.Merge.TwoOrThreeWay (TwoOrThreeWay (..)) diff --git a/unison-merge/src/Unison/Merge/Mergeblob4.hs b/unison-merge/src/Unison/Merge/Mergeblob4.hs new file mode 100644 index 0000000000..6a3631111d --- /dev/null +++ b/unison-merge/src/Unison/Merge/Mergeblob4.hs @@ -0,0 +1,46 @@ +module Unison.Merge.Mergeblob4 + ( Mergeblob4 (..), + makeMergeblob4, + ) +where + +import Unison.Merge.Mergeblob3 (Mergeblob3 (..)) +import Unison.Names (Names (..)) +import Unison.Parser.Ann (Ann) +import Unison.Parsers qualified as Parsers +import Unison.Prelude +import Unison.Reference (Reference) +import Unison.Symbol (Symbol) +import Unison.Syntax.Parser (ParsingEnv (..), UniqueName) +import Unison.Syntax.Parser qualified as Parser +import Unison.UnisonFile (UnisonFile) +import Unison.UnisonFile qualified as UnisonFile +import Unison.Util.Defns (Defns (..)) +import Unison.Util.Pretty qualified as Pretty +import Unison.Util.Relation qualified as Relation + +data Mergeblob4 = Mergeblob4 + { dependencies :: Set Reference, + file :: UnisonFile Symbol Ann + } + +makeMergeblob4 :: Mergeblob3 -> UniqueName -> Either (Parser.Err Symbol) Mergeblob4 +makeMergeblob4 blob uniqueName = do + let stageOneNames = + Names (Relation.fromMap blob.stageOne.terms) (Relation.fromMap blob.stageOne.types) <> blob.libdeps + + parsingEnv = + ParsingEnv + { uniqueNames = uniqueName, + -- The codebase names are disjoint from the file names, i.e. there aren't any things that + -- would be classified as an update upon parsing. So, there's no need to try to look up any + -- existing unique type GUIDs to reuse. + uniqueTypeGuid = \_ -> Identity Nothing, + names = stageOneNames + } + file <- runIdentity (Parsers.parseFile "" (Pretty.toPlain 80 blob.unparsedFile) parsingEnv) + Right + Mergeblob4 + { dependencies = UnisonFile.dependencies file, + file + } diff --git a/unison-merge/src/Unison/Merge/Mergeblob5.hs b/unison-merge/src/Unison/Merge/Mergeblob5.hs new file mode 100644 index 0000000000..dc9c634fcb --- /dev/null +++ b/unison-merge/src/Unison/Merge/Mergeblob5.hs @@ -0,0 +1,32 @@ +module Unison.Merge.Mergeblob5 + ( Mergeblob5 (..), + makeMergeblob5, + ) +where + +import Data.Map.Strict qualified as Map +import Unison.FileParsers qualified as FileParsers +import Unison.Merge.Mergeblob4 (Mergeblob4 (..)) +import Unison.Parser.Ann (Ann) +import Unison.Prelude +import Unison.Result qualified as Result +import Unison.Symbol (Symbol) +import Unison.Typechecker qualified as Typechecker +import Unison.Typechecker.TypeLookup (TypeLookup) +import Unison.UnisonFile (TypecheckedUnisonFile) + +data Mergeblob5 = Mergeblob5 + { file :: TypecheckedUnisonFile Symbol Ann + } + +makeMergeblob5 :: Mergeblob4 -> TypeLookup Symbol Ann -> Either (Seq (Result.Note Symbol Ann)) Mergeblob5 +makeMergeblob5 blob typeLookup = + let typecheckingEnv = + Typechecker.Env + { ambientAbilities = [], + termsByShortname = Map.empty, + typeLookup + } + in case runIdentity (Result.runResultT (FileParsers.synthesizeFile typecheckingEnv blob.file)) of + (Nothing, notes) -> Left notes + (Just file, _) -> Right Mergeblob5 {file} diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index 4aa8b21073..2d515dd615 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -31,6 +31,8 @@ library Unison.Merge.Mergeblob1 Unison.Merge.Mergeblob2 Unison.Merge.Mergeblob3 + Unison.Merge.Mergeblob4 + Unison.Merge.Mergeblob5 Unison.Merge.PartialDeclNameLookup Unison.Merge.PartitionCombinedDiffs Unison.Merge.PrettyPrintEnv From c230be29aaed0fa2871f0b7a5c48e1806b5a7a36 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 8 Aug 2024 12:19:53 -0400 Subject: [PATCH 561/631] move more code around --- .../src/Unison/Syntax/FilePrinter.hs | 97 +++++++++++++++++++ .../unison-parser-typechecker.cabal | 1 + unison-cli/src/Unison/Cli/UpdateUtils.hs | 90 +---------------- .../Codebase/Editor/HandleInput/Update2.hs | 10 +- .../src/Unison}/DeclNameLookup.hs | 2 +- unison-core/unison-core1.cabal | 1 + unison-merge/src/Unison/Merge.hs | 2 - .../src/Unison/Merge/DeclCoherencyCheck.hs | 2 +- unison-merge/src/Unison/Merge/Diff.hs | 4 +- unison-merge/src/Unison/Merge/Mergeblob1.hs | 2 +- unison-merge/src/Unison/Merge/Mergeblob2.hs | 2 +- unison-merge/src/Unison/Merge/Mergeblob3.hs | 6 +- .../Unison/Merge/PartitionCombinedDiffs.hs | 2 +- unison-merge/unison-merge.cabal | 1 - 14 files changed, 114 insertions(+), 108 deletions(-) create mode 100644 parser-typechecker/src/Unison/Syntax/FilePrinter.hs rename {unison-merge/src/Unison/Merge => unison-core/src/Unison}/DeclNameLookup.hs (97%) diff --git a/parser-typechecker/src/Unison/Syntax/FilePrinter.hs b/parser-typechecker/src/Unison/Syntax/FilePrinter.hs new file mode 100644 index 0000000000..0c0d3b0443 --- /dev/null +++ b/parser-typechecker/src/Unison/Syntax/FilePrinter.hs @@ -0,0 +1,97 @@ +module Unison.Syntax.FilePrinter + ( renderDefnsForUnisonFile, + ) +where + +import Control.Lens (mapped, _1) +import Control.Monad.Writer (Writer) +import Control.Monad.Writer qualified as Writer +import Data.List qualified as List +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Unison.Builtin.Decls qualified as Builtin.Decls +import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) +import Unison.DataDeclaration (Decl) +import Unison.DeclNameLookup (DeclNameLookup, expectConstructorNames) +import Unison.HashQualified qualified as HQ +import Unison.HashQualifiedPrime qualified as HQ' +import Unison.Name (Name) +import Unison.Prelude +import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) +import Unison.Reference (TypeReferenceId) +import Unison.Reference qualified as Reference +import Unison.Referent (Referent) +import Unison.Referent qualified as Referent +import Unison.Syntax.DeclPrinter (AccessorName) +import Unison.Syntax.DeclPrinter qualified as DeclPrinter +import Unison.Syntax.TermPrinter qualified as TermPrinter +import Unison.Term (Term) +import Unison.Type (Type) +import Unison.Typechecker qualified as Typechecker +import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Util.Pretty (ColorText, Pretty) +import Unison.Util.Pretty qualified as Pretty +import Unison.Var (Var) + +-- | Render definitions destined for a Unison file. +-- +-- This first renders the types (discovering which record accessors will be generated upon parsing), then renders the +-- terms (being careful not to render any record accessors, since those would cause duplicate binding errors upon +-- parsing). +renderDefnsForUnisonFile :: + forall a v. + (Var v, Monoid a) => + DeclNameLookup -> + PrettyPrintEnvDecl -> + DefnsF (Map Name) (Term v a, Type v a) (TypeReferenceId, Decl v a) -> + DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) +renderDefnsForUnisonFile declNameLookup ppe defns = + let (types, accessorNames) = Writer.runWriter (Map.traverseWithKey renderType defns.types) + in Defns + { terms = Map.mapMaybeWithKey (renderTerm accessorNames) defns.terms, + types + } + where + renderType :: Name -> (TypeReferenceId, Decl v a) -> Writer (Set AccessorName) (Pretty ColorText) + renderType name (ref, typ) = + fmap Pretty.syntaxToColor $ + DeclPrinter.prettyDeclW + -- Sort of a hack; since the decl printer looks in the PPE for names of constructors, + -- we just delete all term names out and add back the constructors... + -- probably no need to wipe out the suffixified side but we do it anyway + (setPpedToConstructorNames declNameLookup name ref ppe) + (Reference.fromId ref) + (HQ.NameOnly name) + typ + + renderTerm :: Set Name -> Name -> (Term v a, Type v a) -> Maybe (Pretty ColorText) + renderTerm accessorNames name (term, typ) = do + guard (not (Set.member name accessorNames)) + let hqName = HQ.NameOnly name + let rendered + | Typechecker.isEqual (Builtin.Decls.testResultListType mempty) typ = + "test> " <> TermPrinter.prettyBindingWithoutTypeSignature ppe.suffixifiedPPE hqName term + | otherwise = TermPrinter.prettyBinding ppe.suffixifiedPPE hqName term + Just (Pretty.syntaxToColor rendered) + +setPpedToConstructorNames :: DeclNameLookup -> Name -> TypeReferenceId -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl +setPpedToConstructorNames declNameLookup name ref = + set (#unsuffixifiedPPE . #termNames) referentNames + . set (#suffixifiedPPE . #termNames) referentNames + where + constructorNameMap :: Map ConstructorReference Name + constructorNameMap = + Map.fromList + ( name + & expectConstructorNames declNameLookup + & List.zip [0 ..] + & over (mapped . _1) (ConstructorReference (Reference.fromId ref)) + ) + + referentNames :: Referent -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)] + referentNames = \case + Referent.Con conRef _ -> + case Map.lookup conRef constructorNameMap of + Nothing -> [] + Just conName -> let hqConName = HQ'.NameOnly conName in [(hqConName, hqConName)] + Referent.Ref _ -> [] diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 018ec3eb7b..b97cc70bb1 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -158,6 +158,7 @@ library Unison.Syntax.DeclParser Unison.Syntax.DeclPrinter Unison.Syntax.FileParser + Unison.Syntax.FilePrinter Unison.Syntax.NamePrinter Unison.Syntax.TermParser Unison.Syntax.TermPrinter diff --git a/unison-cli/src/Unison/Cli/UpdateUtils.hs b/unison-cli/src/Unison/Cli/UpdateUtils.hs index c976af6184..45a478d6eb 100644 --- a/unison-cli/src/Unison/Cli/UpdateUtils.hs +++ b/unison-cli/src/Unison/Cli/UpdateUtils.hs @@ -17,19 +17,13 @@ module Unison.Cli.UpdateUtils -- * Hydrating definitions hydrateDefns, - -- * Rendering definitions - renderDefnsForUnisonFile, - -- * Parsing and typechecking parseAndTypecheck, ) where -import Control.Lens (mapped, _1) import Control.Monad.Reader (ask) -import Control.Monad.Writer (Writer) -import Control.Monad.Writer qualified as Writer -import Data.Bifoldable (bifoldMap, bifold) +import Data.Bifoldable (bifold, bifoldMap) import Data.Bitraversable (bitraverse) import Data.Foldable qualified as Foldable import Data.List qualified as List @@ -43,18 +37,12 @@ import U.Codebase.Causal qualified import U.Codebase.Reference (TermReferenceId, TypeReferenceId) import U.Codebase.Referent qualified as V2 import U.Codebase.Sqlite.Operations qualified as Operations -import Unison.Builtin.Decls qualified as Builtin.Decls import Unison.Cli.Monad (Cli, Env (..)) import Unison.Cli.Monad qualified as Cli import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) -import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) -import Unison.DataDeclaration (Decl) import Unison.Debug qualified as Debug import Unison.FileParsers qualified as FileParsers import Unison.Hash (Hash) -import Unison.HashQualified qualified as HQ -import Unison.HashQualifiedPrime qualified as HQ' -import Unison.Merge.DeclNameLookup (DeclNameLookup (..), expectConstructorNames) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) @@ -64,7 +52,6 @@ import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Parsers qualified as Parsers import Unison.Prelude -import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.Reference (Reference, TermReference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) @@ -72,13 +59,7 @@ import Unison.Referent qualified as Referent import Unison.Result qualified as Result import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) -import Unison.Syntax.DeclPrinter (AccessorName) -import Unison.Syntax.DeclPrinter qualified as DeclPrinter import Unison.Syntax.Parser qualified as Parser -import Unison.Syntax.TermPrinter qualified as TermPrinter -import Unison.Term (Term) -import Unison.Type (Type) -import Unison.Typechecker qualified as Typechecker import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap @@ -86,12 +67,11 @@ import Unison.Util.Conflicted (Conflicted (..)) import Unison.Util.Defn (Defn (..)) import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2) import Unison.Util.Nametree (Nametree (..), traverseNametreeWithName, unflattenNametrees) -import Unison.Util.Pretty (ColorText, Pretty) +import Unison.Util.Pretty (Pretty) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Relation import Unison.Util.Set qualified as Set -import Unison.Var (Var) import Prelude hiding (unzip, zip, zipWith) ------------------------------------------------------------------------------------------------------------------------ @@ -286,72 +266,6 @@ hydrateDefns_ getComponent defns modify = defns2 = BiMultimap.fromRange defns ------------------------------------------------------------------------------------------------------------------------- --- Rendering definitions - --- | Render definitions destined for a Unison file. --- --- This first renders the types (discovering which record accessors will be generated upon parsing), then renders the --- terms (being careful not to render any record accessors, since those would cause duplicate binding errors upon --- parsing). -renderDefnsForUnisonFile :: - forall a v. - (Var v, Monoid a) => - DeclNameLookup -> - PrettyPrintEnvDecl -> - DefnsF (Map Name) (Term v a, Type v a) (TypeReferenceId, Decl v a) -> - DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) -renderDefnsForUnisonFile declNameLookup ppe defns = - let (types, accessorNames) = Writer.runWriter (Map.traverseWithKey renderType defns.types) - in Defns - { terms = Map.mapMaybeWithKey (renderTerm accessorNames) defns.terms, - types - } - where - renderType :: Name -> (TypeReferenceId, Decl v a) -> Writer (Set AccessorName) (Pretty ColorText) - renderType name (ref, typ) = - fmap Pretty.syntaxToColor $ - DeclPrinter.prettyDeclW - -- Sort of a hack; since the decl printer looks in the PPE for names of constructors, - -- we just delete all term names out and add back the constructors... - -- probably no need to wipe out the suffixified side but we do it anyway - (setPpedToConstructorNames declNameLookup name ref ppe) - (Reference.fromId ref) - (HQ.NameOnly name) - typ - - renderTerm :: Set Name -> Name -> (Term v a, Type v a) -> Maybe (Pretty ColorText) - renderTerm accessorNames name (term, typ) = do - guard (not (Set.member name accessorNames)) - let hqName = HQ.NameOnly name - let rendered - | Typechecker.isEqual (Builtin.Decls.testResultListType mempty) typ = - "test> " <> TermPrinter.prettyBindingWithoutTypeSignature ppe.suffixifiedPPE hqName term - | otherwise = TermPrinter.prettyBinding ppe.suffixifiedPPE hqName term - Just (Pretty.syntaxToColor rendered) - -setPpedToConstructorNames :: DeclNameLookup -> Name -> TypeReferenceId -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl -setPpedToConstructorNames declNameLookup name ref = - set (#unsuffixifiedPPE . #termNames) referentNames - . set (#suffixifiedPPE . #termNames) referentNames - where - constructorNameMap :: Map ConstructorReference Name - constructorNameMap = - Map.fromList - ( name - & expectConstructorNames declNameLookup - & List.zip [0 ..] - & over (mapped . _1) (ConstructorReference (Reference.fromId ref)) - ) - - referentNames :: Referent -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)] - referentNames = \case - Referent.Con conRef _ -> - case Map.lookup conRef constructorNameMap of - Nothing -> [] - Just conName -> let hqConName = HQ'.NameOnly conName in [(hqConName, hqConName)] - Referent.Ref _ -> [] - ------------------------------------------------------------------------------------------------------------------------ -- Parsing and typechecking diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 13a5fbbaba..93c484e987 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -21,13 +21,7 @@ import Unison.Cli.Monad (Cli, Env (..)) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.Pretty qualified as Pretty -import Unison.Cli.UpdateUtils - ( getNamespaceDependentsOf2, - hydrateDefns, - narrowDefns, - parseAndTypecheck, - renderDefnsForUnisonFile, - ) +import Unison.Cli.UpdateUtils (getNamespaceDependentsOf2, hydrateDefns, narrowDefns, parseAndTypecheck) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch @@ -40,6 +34,7 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.SqliteCodebase.Operations qualified as Operations import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as Decl +import Unison.DeclNameLookup (DeclNameLookup (..)) import Unison.Merge qualified as Merge import Unison.Name (Name) import Unison.Names (Names) @@ -56,6 +51,7 @@ import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) +import Unison.Syntax.FilePrinter (renderDefnsForUnisonFile) import Unison.Syntax.Name qualified as Name import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF diff --git a/unison-merge/src/Unison/Merge/DeclNameLookup.hs b/unison-core/src/Unison/DeclNameLookup.hs similarity index 97% rename from unison-merge/src/Unison/Merge/DeclNameLookup.hs rename to unison-core/src/Unison/DeclNameLookup.hs index 35e5b5e10f..70543061fc 100644 --- a/unison-merge/src/Unison/Merge/DeclNameLookup.hs +++ b/unison-core/src/Unison/DeclNameLookup.hs @@ -1,4 +1,4 @@ -module Unison.Merge.DeclNameLookup +module Unison.DeclNameLookup ( DeclNameLookup (..), expectDeclName, expectConstructorNames, diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal index aff6128306..f6cfed41d8 100644 --- a/unison-core/unison-core1.cabal +++ b/unison-core/unison-core1.cabal @@ -32,6 +32,7 @@ library Unison.DataDeclaration.ConstructorId Unison.DataDeclaration.Names Unison.DataDeclaration.Records + Unison.DeclNameLookup Unison.Hashable Unison.HashQualified Unison.HashQualifiedPrime diff --git a/unison-merge/src/Unison/Merge.hs b/unison-merge/src/Unison/Merge.hs index e2d6da587c..908e776cd0 100644 --- a/unison-merge/src/Unison/Merge.hs +++ b/unison-merge/src/Unison/Merge.hs @@ -14,7 +14,6 @@ module Unison.Merge makeMergeblob5, -- * Decl coherency checks - DeclNameLookup (..), PartialDeclNameLookup (..), IncoherentDeclReason (..), checkDeclCoherency, @@ -46,7 +45,6 @@ import Unison.Merge.DeclCoherencyCheck checkDeclCoherency, lenientCheckDeclCoherency, ) -import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) import Unison.Merge.DiffOp (DiffOp (..)) import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.EitherWayI (EitherWayI (..)) diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index c927ce44d0..697e693d6b 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -105,7 +105,7 @@ import Data.Set qualified as Set import U.Codebase.Reference (Reference' (..), TypeReference, TypeReferenceId) import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration.ConstructorId (ConstructorId) -import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) +import Unison.DeclNameLookup (DeclNameLookup (..)) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) import Unison.Name (Name) import Unison.Name qualified as Name diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index 219bc70b6a..39be392c28 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -11,10 +11,10 @@ import U.Codebase.Reference (TypeReference) import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration +import Unison.DeclNameLookup (DeclNameLookup) +import Unison.DeclNameLookup qualified as DeclNameLookup import Unison.Hash (Hash (Hash)) import Unison.HashQualifiedPrime qualified as HQ' -import Unison.Merge.DeclNameLookup (DeclNameLookup) -import Unison.Merge.DeclNameLookup qualified as DeclNameLookup import Unison.Merge.DiffOp (DiffOp (..)) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) import Unison.Merge.Synhash qualified as Synhash diff --git a/unison-merge/src/Unison/Merge/Mergeblob1.hs b/unison-merge/src/Unison/Merge/Mergeblob1.hs index 10efa84398..83cfd58b16 100644 --- a/unison-merge/src/Unison/Merge/Mergeblob1.hs +++ b/unison-merge/src/Unison/Merge/Mergeblob1.hs @@ -8,9 +8,9 @@ import Data.List qualified as List import Data.Map.Strict qualified as Map import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration +import Unison.DeclNameLookup (DeclNameLookup) import Unison.Merge.CombineDiffs (CombinedDiffOp, combineDiffs) import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason, checkDeclCoherency, lenientCheckDeclCoherency) -import Unison.Merge.DeclNameLookup (DeclNameLookup) import Unison.Merge.Diff (nameBasedNamespaceDiff) import Unison.Merge.DiffOp (DiffOp) import Unison.Merge.EitherWay (EitherWay (..)) diff --git a/unison-merge/src/Unison/Merge/Mergeblob2.hs b/unison-merge/src/Unison/Merge/Mergeblob2.hs index 321e94e2e4..4f3491efe8 100644 --- a/unison-merge/src/Unison/Merge/Mergeblob2.hs +++ b/unison-merge/src/Unison/Merge/Mergeblob2.hs @@ -10,7 +10,7 @@ import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration (Decl) -import Unison.Merge.DeclNameLookup (DeclNameLookup) +import Unison.DeclNameLookup (DeclNameLookup) import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.FindConflictedAlias (findConflictedAlias) import Unison.Merge.Mergeblob1 (Mergeblob1 (..)) diff --git a/unison-merge/src/Unison/Merge/Mergeblob3.hs b/unison-merge/src/Unison/Merge/Mergeblob3.hs index 3b8e58729c..6133c404d0 100644 --- a/unison-merge/src/Unison/Merge/Mergeblob3.hs +++ b/unison-merge/src/Unison/Merge/Mergeblob3.hs @@ -15,7 +15,7 @@ import Data.Set.NonEmpty qualified as Set.NonEmpty import Data.These (These (..)) import Data.Zip (unzip) import Unison.DataDeclaration (Decl) -import Unison.Merge.DeclNameLookup (DeclNameLookup, expectConstructorNames) +import Unison.DeclNameLookup (DeclNameLookup, expectConstructorNames) import Unison.Merge.Mergeblob2 (Mergeblob2 (..)) import Unison.Merge.PrettyPrintEnv (makePrettyPrintEnvs) import Unison.Merge.ThreeWay qualified as ThreeWay @@ -41,6 +41,7 @@ import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation qualified as Relation import Prelude hiding (unzip) +import Unison.Syntax.FilePrinter (renderDefnsForUnisonFile) data Mergeblob3 = Mergeblob3 { libdeps :: Names, @@ -203,8 +204,7 @@ renderConflictsAndDependents :: renderConflictsAndDependents declNameLookups hydratedDefns conflicts dependents names libdepsNames = unzip $ ( \declNameLookup (conflicts, dependents) ppe -> - let renderDefnsForUnisonFile = wundefined - render = renderDefnsForUnisonFile declNameLookup ppe . over (#terms . mapped) snd + let render = renderDefnsForUnisonFile declNameLookup ppe . over (#terms . mapped) snd in (render conflicts, render dependents) ) <$> declNameLookups diff --git a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs index 8283194f75..1f144638bb 100644 --- a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs +++ b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs @@ -7,8 +7,8 @@ where import Control.Lens (Lens') import Data.Bitraversable (bitraverse) import Data.Map.Strict qualified as Map +import Unison.DeclNameLookup (DeclNameLookup (..), expectConstructorNames, expectDeclName) import Unison.Merge.CombineDiffs (CombinedDiffOp (..)) -import Unison.Merge.DeclNameLookup (DeclNameLookup (..), expectConstructorNames, expectDeclName) import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.EitherWay qualified as EitherWay import Unison.Merge.EitherWayI (EitherWayI (..)) diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index 2d515dd615..01f9170c4c 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -20,7 +20,6 @@ library Unison.Merge Unison.Merge.CombineDiffs Unison.Merge.DeclCoherencyCheck - Unison.Merge.DeclNameLookup Unison.Merge.Diff Unison.Merge.DiffOp Unison.Merge.EitherWay From 0d560d209a62eef4c0a06591d5d770ccc6b9fddd Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 8 Aug 2024 13:34:18 -0400 Subject: [PATCH 562/631] delete unused import --- unison-cli/src/Unison/LSP/Completion.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/unison-cli/src/Unison/LSP/Completion.hs b/unison-cli/src/Unison/LSP/Completion.hs index d822c62be2..90c8108d8d 100644 --- a/unison-cli/src/Unison/LSP/Completion.hs +++ b/unison-cli/src/Unison/LSP/Completion.hs @@ -42,7 +42,6 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment -import Unison.NameSegment.Internal qualified as NameSegment import Unison.Names (Names (..)) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE From bcf0ff68f4c3f59124cd551fe18db3bb8d4b2556 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 8 Aug 2024 11:34:07 -0700 Subject: [PATCH 563/631] Only emit annotation changes if it's a hash change --- .../src/Unison/Server/Backend/DefinitionDiff.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs b/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs index d69f0ac8a3..c38c532574 100644 --- a/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs +++ b/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs @@ -59,5 +59,17 @@ diffSyntaxText (AnnotatedText fromST) (AnnotatedText toST) = detectSpecialCase fromSegment toSegment | fromSegment == toSegment = Left fromSegment | AT.annotation fromSegment == AT.annotation toSegment = Right (SegmentChange (AT.segment fromSegment, AT.segment toSegment) (AT.annotation fromSegment)) - | AT.segment fromSegment == AT.segment toSegment = Right (AnnotationChange (AT.segment fromSegment) (AT.annotation fromSegment, AT.annotation toSegment)) + -- We only emit an annotation change if it's a change in just the hash of the element (optionally the KIND of hash reference can change too). + | AT.segment fromSegment == AT.segment toSegment, + Just _fromHash <- AT.annotation fromSegment >>= elementHash, + Just _toHash <- AT.annotation toSegment >>= elementHash = + Right (AnnotationChange (AT.segment fromSegment) (AT.annotation fromSegment, AT.annotation toSegment)) | otherwise = error "diffSyntaxText: found Syntax Elements in 'both' which have nothing in common." + where + elementHash :: Syntax.Element -> Maybe Syntax.UnisonHash + elementHash = \case + Syntax.TypeReference hash -> Just hash + Syntax.TermReference hash -> Just hash + Syntax.DataConstructorReference hash -> Just hash + Syntax.AbilityConstructorReference hash -> Just hash + _ -> Nothing From c341cc431e32ca822a759f95aa8548a61c42fbe4 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 9 Aug 2024 10:21:19 -0700 Subject: [PATCH 564/631] Add regression test --- unison-src/transcripts/definition-diff-api.md | 41 +- .../transcripts/definition-diff-api.output.md | 2802 ++++++++++++++++- 2 files changed, 2837 insertions(+), 6 deletions(-) diff --git a/unison-src/transcripts/definition-diff-api.md b/unison-src/transcripts/definition-diff-api.md index f8d21d0687..9779866c23 100644 --- a/unison-src/transcripts/definition-diff-api.md +++ b/unison-src/transcripts/definition-diff-api.md @@ -1,5 +1,7 @@ ```ucm -diffs/main> builtins.merge +diffs/main> builtins.mergeio lib.builtins +diffs/main> alias.term lib.builtins.Nat.gt lib.builtins.Nat.> +diffs/main> alias.term lib.builtins.Nat.drop lib.builtins.Nat.- ``` ```unison @@ -8,6 +10,20 @@ term = 1 + 1 type Type = Type Nat + +ability Stream a where + emit : a -> () + +take n s = + use Nat > - + h n = cases + { emit a -> k } -> if n > 0 + then + emit a + handle k() with h (n - 1) + else None + { r } -> Some r + handle s() with h n ``` ```ucm @@ -21,6 +37,22 @@ term = 1 + 2 type Type a = Type a Text + +ability Stream a where + emit : a -> () + +take n s = + use Nat > - + h n = cases + { emit a -> k } -> + emit a + if n > 0 + then handle k() with h (n - 1) + else None + { r } -> Some r + if n > 0 + then handle s () with h (n - 1) + else None ``` ```ucm @@ -33,6 +65,13 @@ Diff terms GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=term&newTerm=term ``` +More complex diff + +```api +GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=take&newTerm=take +``` + + Diff types ```api diff --git a/unison-src/transcripts/definition-diff-api.output.md b/unison-src/transcripts/definition-diff-api.output.md index 1670f2b05d..8934749d03 100644 --- a/unison-src/transcripts/definition-diff-api.output.md +++ b/unison-src/transcripts/definition-diff-api.output.md @@ -1,5 +1,13 @@ ``` ucm -diffs/main> builtins.merge +diffs/main> builtins.mergeio lib.builtins + + Done. + +diffs/main> alias.term lib.builtins.Nat.gt lib.builtins.Nat.> + + Done. + +diffs/main> alias.term lib.builtins.Nat.drop lib.builtins.Nat.- Done. @@ -10,6 +18,20 @@ term = 1 + 1 type Type = Type Nat + +ability Stream a where + emit : a -> () + +take n s = + use Nat > - + h n = cases + { emit a -> k } -> if n > 0 + then + emit a + handle k() with h (n - 1) + else None + { r } -> Some r + handle s() with h n ``` ``` ucm @@ -22,7 +44,9 @@ type Type = Type Nat ⍟ These new definitions are ok to `add`: + ability Stream a type Type + take : Nat -> '{g} t ->{g, Stream a} Optional t term : Nat ``` @@ -31,7 +55,9 @@ diffs/main> add ⍟ I've added these definitions: + ability Stream a type Type + take : Nat -> '{g} t ->{g, Stream a} Optional t term : Nat diffs/main> branch.create new @@ -48,6 +74,22 @@ term = 1 + 2 type Type a = Type a Text + +ability Stream a where + emit : a -> () + +take n s = + use Nat > - + h n = cases + { emit a -> k } -> + emit a + if n > 0 + then handle k() with h (n - 1) + else None + { r } -> Some r + if n > 0 + then handle s () with h (n - 1) + else None ``` ``` ucm @@ -58,10 +100,13 @@ type Type a = Type a Text do an `add` or `update`, here's how your codebase would change: + ⊡ Previously added definitions will be ignored: Stream + ⍟ These names already exist. You can `update` them to your new definition: type Type a + take : Nat -> '{g} t ->{g, Stream a} Optional t term : Nat ``` @@ -560,6 +605,2753 @@ GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=te } ``` +More complex diff + +``` api +GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=take&newTerm=take +{ + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "contents": "take", + "tag": "HashQualifier" + }, + "segment": "take" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelayForceChar" + }, + "segment": "'" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro", + "tag": "TypeReference" + }, + "segment": "Stream" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Optional" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "take", + "tag": "HashQualifier" + }, + "segment": "take" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "s" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseKeyword" + }, + "segment": "use " + }, + { + "annotation": { + "tag": "UsePrefix" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": "-" + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "h", + "tag": "HashQualifier" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "cases" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "k" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "if " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.>", + "tag": "TermReference" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "0" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " then" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + } + ] + }, + { + "annotation": null, + "diffTag": "segmentChange", + "fromSegment": "\n", + "toSegment": " " + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + } + ] + }, + { + "annotation": null, + "diffTag": "segmentChange", + "fromSegment": " ", + "toSegment": "\n" + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "if" + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": null, + "segment": " " + } + ] + }, + { + "annotation": { + "tag": "Var" + }, + "diffTag": "segmentChange", + "fromSegment": "a", + "toSegment": "n" + }, + { + "annotation": null, + "diffTag": "segmentChange", + "fromSegment": "\n", + "toSegment": " " + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "contents": "##Nat.>", + "tag": "TermReference" + }, + "segment": ">" + } + ] + }, + { + "annotation": null, + "diffTag": "segmentChange", + "fromSegment": " ", + "toSegment": " " + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "0" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " then" + } + ] + }, + { + "annotation": null, + "diffTag": "segmentChange", + "fromSegment": " ", + "toSegment": " " + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "k" + }, + { + "annotation": { + "tag": "Unit" + }, + "segment": "()" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "with" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.drop", + "tag": "TermReference" + }, + "segment": "-" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + } + ] + }, + { + "annotation": null, + "diffTag": "segmentChange", + "fromSegment": "\n", + "toSegment": " " + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "else" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d1", + "tag": "TermReference" + }, + "segment": "None" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "r" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d0", + "tag": "TermReference" + }, + "segment": "Some" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "r" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "diffTag": "segmentChange", + "fromSegment": "handle", + "toSegment": "if" + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": null, + "segment": " " + } + ] + }, + { + "annotation": { + "tag": "Var" + }, + "diffTag": "segmentChange", + "fromSegment": "s", + "toSegment": "n" + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.>", + "tag": "TermReference" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "0" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " then" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "s" + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "Unit" + }, + "segment": "()" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "with" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.drop", + "tag": "TermReference" + }, + "segment": "-" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "else" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d1", + "tag": "TermReference" + }, + "segment": "None" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff", + "newBranchRef": "new", + "newTerm": { + "bestTermName": "take", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelayForceChar" + }, + "segment": "'" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro", + "tag": "TypeReference" + }, + "segment": "Stream" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Optional" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "take", + "tag": "HashQualifier" + }, + "segment": "take" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelayForceChar" + }, + "segment": "'" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro", + "tag": "TypeReference" + }, + "segment": "Stream" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Optional" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "take", + "tag": "HashQualifier" + }, + "segment": "take" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "s" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseKeyword" + }, + "segment": "use " + }, + { + "annotation": { + "tag": "UsePrefix" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": "-" + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "h", + "tag": "HashQualifier" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "cases" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "k" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "if" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.>", + "tag": "TermReference" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "0" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " then" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "k" + }, + { + "annotation": { + "tag": "Unit" + }, + "segment": "()" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "with" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.drop", + "tag": "TermReference" + }, + "segment": "-" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "else" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d1", + "tag": "TermReference" + }, + "segment": "None" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "r" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d0", + "tag": "TermReference" + }, + "segment": "Some" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "r" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "if" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.>", + "tag": "TermReference" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "0" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " then" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "s" + }, + { + "annotation": { + "tag": "Unit" + }, + "segment": "()" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "with" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.drop", + "tag": "TermReference" + }, + "segment": "-" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "else" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d1", + "tag": "TermReference" + }, + "segment": "None" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "take" + ] + }, + "oldBranchRef": "main", + "oldTerm": { + "bestTermName": "take", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelayForceChar" + }, + "segment": "'" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro", + "tag": "TypeReference" + }, + "segment": "Stream" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Optional" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "take", + "tag": "HashQualifier" + }, + "segment": "take" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelayForceChar" + }, + "segment": "'" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro", + "tag": "TypeReference" + }, + "segment": "Stream" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Optional" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "take", + "tag": "HashQualifier" + }, + "segment": "take" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "s" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseKeyword" + }, + "segment": "use " + }, + { + "annotation": { + "tag": "UsePrefix" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": "-" + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "h", + "tag": "HashQualifier" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "cases" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "k" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "if " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.>", + "tag": "TermReference" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "0" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " then" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "k" + }, + { + "annotation": { + "tag": "Unit" + }, + "segment": "()" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "with" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.drop", + "tag": "TermReference" + }, + "segment": "-" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "else" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d1", + "tag": "TermReference" + }, + "segment": "None" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "r" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d0", + "tag": "TermReference" + }, + "segment": "Some" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "r" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "s" + }, + { + "annotation": { + "tag": "Unit" + }, + "segment": "()" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "with" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "take" + ] + }, + "project": "diffs" +} +``` + Diff types ``` api @@ -618,12 +3410,12 @@ GET /api/projects/diffs/diff/types?oldBranchRef=main&newBranchRef=new&oldType=Ty { "diffTag": "annotationChange", "fromAnnotation": { - "contents": "#0tc9e438eurvtevfa6k9pg04qvv66is75hs8iqejkuoaef140g8vvu92hc1ks4gamgc3i1ukgdn0blchp3038l43vffijpsbjh14igo#d0", + "contents": "#m5hlrmkn9a3kuqabta2e9qs934em1qmkotpsh9tjvta2u86nuesbjbk2k2sprbdiljq7uqibp49vku4gfpg2u60ceiv8net1f0bu2n8#d0", "tag": "TermReference" }, "segment": "Type", "toAnnotation": { - "contents": "#mft8mne9i92b6k4m512rn2608rsp6ilq4ejufeof6mbh5aintes4tih1fo93fospmu2t3f0h67uu0mrk2qj75o7k0lj1juefhaidt4g#d0", + "contents": "#uik7pl3klg4u2obtf2fattdaeldui46ohmsi0knpp5hu8tn4d5o8vp570qgh7esgap0pmq9cfrh9dfg1r8qa7qh33g45a3tric24o20#d0", "tag": "TermReference" } }, @@ -715,7 +3507,7 @@ GET /api/projects/diffs/diff/types?oldBranchRef=main&newBranchRef=new&oldType=Ty }, { "annotation": { - "contents": "#mft8mne9i92b6k4m512rn2608rsp6ilq4ejufeof6mbh5aintes4tih1fo93fospmu2t3f0h67uu0mrk2qj75o7k0lj1juefhaidt4g#d0", + "contents": "#uik7pl3klg4u2obtf2fattdaeldui46ohmsi0knpp5hu8tn4d5o8vp570qgh7esgap0pmq9cfrh9dfg1r8qa7qh33g45a3tric24o20#d0", "tag": "TermReference" }, "segment": "Type" @@ -780,7 +3572,7 @@ GET /api/projects/diffs/diff/types?oldBranchRef=main&newBranchRef=new&oldType=Ty }, { "annotation": { - "contents": "#0tc9e438eurvtevfa6k9pg04qvv66is75hs8iqejkuoaef140g8vvu92hc1ks4gamgc3i1ukgdn0blchp3038l43vffijpsbjh14igo#d0", + "contents": "#m5hlrmkn9a3kuqabta2e9qs934em1qmkotpsh9tjvta2u86nuesbjbk2k2sprbdiljq7uqibp49vku4gfpg2u60ceiv8net1f0bu2n8#d0", "tag": "TermReference" }, "segment": "Type" From 01cae7efdb83663247c8a169418f1aab9128b126 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 9 Aug 2024 15:44:35 -0400 Subject: [PATCH 565/631] failing transcript --- unison-src/transcripts/fix3424.md | 26 ++++++++++++ unison-src/transcripts/fix3424.output.md | 50 ++++++++++++++++++++++++ 2 files changed, 76 insertions(+) create mode 100644 unison-src/transcripts/fix3424.md create mode 100644 unison-src/transcripts/fix3424.output.md diff --git a/unison-src/transcripts/fix3424.md b/unison-src/transcripts/fix3424.md new file mode 100644 index 0000000000..29624e5c01 --- /dev/null +++ b/unison-src/transcripts/fix3424.md @@ -0,0 +1,26 @@ +```ucm +scratch/main> builtins.merge lib.builtins +``` + +```unison:hide +a = do b +b = "Hello, " ++ c ++ "!" +c = "World" +``` + +```ucm +scratch/main> add +scratch/main> run a +``` + +```unison:hide +a = do b +c = "Unison" +``` + +```ucm +scratch/main> update +scratch/main> run a +``` + +The result should be "Hello, Unison!". diff --git a/unison-src/transcripts/fix3424.output.md b/unison-src/transcripts/fix3424.output.md new file mode 100644 index 0000000000..1b6abedd73 --- /dev/null +++ b/unison-src/transcripts/fix3424.output.md @@ -0,0 +1,50 @@ +``` ucm +scratch/main> builtins.merge lib.builtins + + Done. + +``` +``` unison +a = do b +b = "Hello, " ++ c ++ "!" +c = "World" +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + a : 'Text + b : Text + c : Text + +scratch/main> run a + + "Hello, World!" + +``` +``` unison +a = do b +c = "Unison" +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +scratch/main> run a + + "Hello, World!" + +``` +The result should be "Hello, Unison\!". + From c4f8ffcf399d59f80b7f17a2fd9a7f2fc8b0d9e9 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 9 Aug 2024 15:45:50 -0400 Subject: [PATCH 566/631] clear `latestTypecheckedFile` on `update` fixes #3424 --- unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs | 2 ++ unison-src/transcripts/fix3424.output.md | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 104f8063bb..efb9039430 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -7,6 +7,7 @@ module Unison.Codebase.Editor.HandleInput.Update2 ) where +import Control.Lens ((.=)) import Control.Monad.RWS (ask) import Data.Bifoldable (bifoldMap) import Data.List qualified as List @@ -148,6 +149,7 @@ handleUpdate2 = do (\typeName -> Right (Map.lookup typeName declNameLookup.declToConstructors)) secondTuf Cli.stepAt "update" (path, Branch.batchUpdates branchUpdates) + #latestTypecheckedFile .= Nothing Cli.respond Output.Success diff --git a/unison-src/transcripts/fix3424.output.md b/unison-src/transcripts/fix3424.output.md index 1b6abedd73..dbf435bc65 100644 --- a/unison-src/transcripts/fix3424.output.md +++ b/unison-src/transcripts/fix3424.output.md @@ -43,7 +43,7 @@ scratch/main> update scratch/main> run a - "Hello, World!" + "Hello, Unison!" ``` The result should be "Hello, Unison\!". From 24b5aa55137374491bbb677afaf77cc8311a57b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Sat, 10 Aug 2024 22:29:59 -0400 Subject: [PATCH 567/631] Added precedence rules to term parser --- .../src/Unison/Syntax/TermParser.hs | 119 ++++++++++++++++-- 1 file changed, 108 insertions(+), 11 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 85406c84bf..d68edbeb27 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -20,6 +20,7 @@ import Data.List qualified as List import Data.List.Extra qualified as List.Extra import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as NonEmpty +import Data.Map qualified as Map import Data.Maybe qualified as Maybe import Data.Sequence qualified as Sequence import Data.Set qualified as Set @@ -419,9 +420,6 @@ list = Parser.seq Term.list hashQualifiedPrefixTerm :: (Monad m, Var v) => TermP v m hashQualifiedPrefixTerm = resolveHashQualified =<< hqPrefixId -hashQualifiedInfixTerm :: (Monad m, Var v) => TermP v m -hashQualifiedInfixTerm = resolveHashQualified =<< hqInfixId - quasikeyword :: (Ord v) => Text -> P v m (L.Token ()) quasikeyword kw = queryToken \case L.WordyId (HQ'.NameOnly n) | nameIsKeyword n kw -> Just () @@ -1041,17 +1039,116 @@ term4 = f <$> some termLeaf f (func : args) = Term.apps func ((\a -> (ann func <> ann a, a)) <$> args) f [] = error "'some' shouldn't produce an empty list" +-- Operators in order of precedence, based on the first character of the operator: +-- 1. Any symbol character not in the list below +-- 2. * / % +-- 3. + - +-- 4. : +-- 5. < > +-- 6. = ! +-- 7. & +-- 8. ^ +-- 9. | + +data InfixParse v + = InfixOp (L.Token (HQ.HashQualified Name)) (Term v Ann) (InfixParse v) (InfixParse v) + | InfixAnd (L.Token String) (InfixParse v) (InfixParse v) + | InfixOr (L.Token String) (InfixParse v) (InfixParse v) + | InfixOperand (Term v Ann) + -- e.g. term4 + term4 - term4 -- or term4 || term4 && term4 -infixAppOrBooleanOp :: (Monad m, Var v) => TermP v m -infixAppOrBooleanOp = chainl1 term4 (or <|> and <|> infixApp) +infixAppOrBooleanOp :: forall m v. (Monad m, Var v) => TermP v m +infixAppOrBooleanOp = + applyInfixOps <$> prelimParse where - or = orf <$> label "or" (reserved "||") - orf op lhs rhs = Term.or (ann lhs <> ann op <> ann rhs) lhs rhs - and = andf <$> label "and" (reserved "&&") - andf op lhs rhs = Term.and (ann lhs <> ann op <> ann rhs) lhs rhs - infixApp = infixAppf <$> label "infixApp" (hashQualifiedInfixTerm <* optional semi) - infixAppf op lhs rhs = Term.apps' op [lhs, rhs] + precedenceRules = + Map.fromList $ + zip + [ ["*", "/", "%"], + ["+", "-"], + ["<", ">", ">=", "<="], + ["==", "!==", "!=", "==="], + ["&&", "&"], + ["^", "^^"], + ["||", "|"] + ] + [0 ..] + >>= \(ops, prec) -> map (,prec) ops + prelimParse :: P v m (InfixParse v) + prelimParse = + reassociate <$> chainl1 (InfixOperand <$> term4) genericInfixApp + genericInfixApp = + (InfixAnd <$> (label "and" (reserved "&&"))) + <|> (InfixOr <$> (label "or" (reserved "||"))) + <|> (uncurry InfixOp <$> parseInfix) + parseInfix = label "infixApp" do + op <- hqInfixId <* optional semi + resolved <- resolveHashQualified op + pure (op, resolved) + reassociate x = fst $ go Nothing x + where + go parentPrec = \case + InfixOp op tm lhs rhs -> + let prec = Map.lookup (unqualified op) precedenceRules + in rotate prec (InfixOp op tm) lhs rhs + InfixOperand tm -> (InfixOperand tm, False) + InfixAnd op lhs rhs -> rotate (Just 4) (InfixAnd op) lhs rhs + InfixOr op lhs rhs -> rotate (Just 6) (InfixOr op) lhs rhs + where + rotate :: + Maybe Int -> + ( InfixParse v -> + InfixParse v -> + InfixParse v + ) -> + InfixParse v -> + InfixParse v -> + (InfixParse v, Bool) + rotate prec ctor lhs rhs = + let (lhs', shouldRotLeft) = go prec lhs + shouldRotate = (((>) <$> prec <*> parentPrec) == (Just True)) + in if shouldRotLeft + then case lhs' of + InfixOp lop ltm ll lr -> go prec (InfixOp lop ltm ll (ctor lr rhs)) + InfixAnd lop ll lr -> go prec (InfixAnd lop ll (ctor lr rhs)) + InfixOr lop ll lr -> go prec (InfixOr lop ll (ctor lr rhs)) + _ -> (ctor lhs' rhs, shouldRotate) + else (ctor lhs' rhs, shouldRotate) + applyInfixOps :: InfixParse v -> Term v Ann + applyInfixOps t = case t of + InfixOp _ tm lhs rhs -> + Term.apps' tm [applyInfixOps lhs, applyInfixOps rhs] + InfixOperand tm -> tm + InfixAnd op lhs rhs -> + let lhs' = applyInfixOps lhs + rhs' = applyInfixOps rhs + in Term.and (ann lhs' <> ann op <> ann rhs') lhs' rhs' + InfixOr op lhs rhs -> + let lhs' = applyInfixOps lhs + rhs' = applyInfixOps rhs + in Term.or (ann lhs' <> ann op <> ann rhs') lhs' rhs' + unqualified t = Maybe.fromJust $ Text.unpack . NameSegment.toEscapedText . Name.lastSegment <$> (HQ.toName $ L.payload t) + +-- or = orf <$> label "or" (reserved "||") +-- orf op lhs rhs = Term.or (ann lhs <> ann op <> ann rhs) lhs rhs +-- and = andf <$> label "and" (reserved "&&") +-- andf op lhs rhs = Term.and (ann lhs <> ann op <> ann rhs) lhs rhs +-- infixAppPrec c = infixAppNoPrec c <|> otherOp +-- infixAppNoPrec c = +-- infixAppf +-- <$> label "infixApp" (hashQualifiedInfixTermStartingWith c <* optional semi) +-- infixAppf :: Term v Ann -> Term v Ann -> Term v Ann -> Term v Ann +-- infixAppf op lhs rhs = Term.apps' op [lhs, rhs] + +-- chainl1 term4 (or <|> and <|> infixApp) +-- where +-- or = orf <$> label "or" (reserved "||") +-- orf op lhs rhs = Term.or (ann lhs <> ann op <> ann rhs) lhs rhs +-- and = andf <$> label "and" (reserved "&&") +-- andf op lhs rhs = Term.and (ann lhs <> ann op <> ann rhs) lhs rhs +-- infixApp = infixAppf <$> label "infixApp" (hashQualifiedInfixTerm <* optional semi) +-- infixAppf op lhs rhs = Term.apps' op [lhs, rhs] typedecl :: (Monad m, Var v) => P v m (L.Token v, Type v Ann) typedecl = From 9d4e2ebe25365b360ddb72de0952fe7e16c8f1c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Sat, 10 Aug 2024 22:38:48 -0400 Subject: [PATCH 568/631] Cleanup --- .../src/Unison/Syntax/TermParser.hs | 49 ++++++++----------- 1 file changed, 21 insertions(+), 28 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index d68edbeb27..e2aea4149f 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -70,13 +70,30 @@ import Prelude hiding (and, or, seq) {- Precedence of language constructs is identical to Haskell, except that all operators (like +, <*>, or any sequence of non-alphanumeric characters) are -left-associative and equal precedence, and operators must have surrounding -whitespace (a + b, not a+b) to distinguish from identifiers that may contain -operator characters (like empty? or fold-left). +left-associative and equal precedence (with a few exceptions), and operators +must have surrounding whitespace (a + b, not a+b) to distinguish from +identifiers that may contain operator characters (like empty? or fold-left). Sections / partial application of infix operators is not implemented. -} +-- Precedence rules for infix operators. +-- Lower number means higher precedence (tighter binding). +precedenceRules :: Map Text Int +precedenceRules = + Map.fromList $ + zip + [ ["*", "/", "%"], + ["+", "-"], + ["<", ">", ">=", "<="], + ["==", "!==", "!=", "==="], + ["&&", "&"], + ["^", "^^"], + ["||", "|"] + ] + [0 ..] + >>= \(ops, prec) -> map (,prec) ops + type TermP v m = P v m (Term v Ann) term :: (Monad m, Var v) => TermP v m @@ -1039,17 +1056,6 @@ term4 = f <$> some termLeaf f (func : args) = Term.apps func ((\a -> (ann func <> ann a, a)) <$> args) f [] = error "'some' shouldn't produce an empty list" --- Operators in order of precedence, based on the first character of the operator: --- 1. Any symbol character not in the list below --- 2. * / % --- 3. + - --- 4. : --- 5. < > --- 6. = ! --- 7. & --- 8. ^ --- 9. | - data InfixParse v = InfixOp (L.Token (HQ.HashQualified Name)) (Term v Ann) (InfixParse v) (InfixParse v) | InfixAnd (L.Token String) (InfixParse v) (InfixParse v) @@ -1062,19 +1068,6 @@ infixAppOrBooleanOp :: forall m v. (Monad m, Var v) => TermP v m infixAppOrBooleanOp = applyInfixOps <$> prelimParse where - precedenceRules = - Map.fromList $ - zip - [ ["*", "/", "%"], - ["+", "-"], - ["<", ">", ">=", "<="], - ["==", "!==", "!=", "==="], - ["&&", "&"], - ["^", "^^"], - ["||", "|"] - ] - [0 ..] - >>= \(ops, prec) -> map (,prec) ops prelimParse :: P v m (InfixParse v) prelimParse = reassociate <$> chainl1 (InfixOperand <$> term4) genericInfixApp @@ -1128,7 +1121,7 @@ infixAppOrBooleanOp = let lhs' = applyInfixOps lhs rhs' = applyInfixOps rhs in Term.or (ann lhs' <> ann op <> ann rhs') lhs' rhs' - unqualified t = Maybe.fromJust $ Text.unpack . NameSegment.toEscapedText . Name.lastSegment <$> (HQ.toName $ L.payload t) + unqualified t = Maybe.fromJust $ NameSegment.toEscapedText . Name.lastSegment <$> (HQ.toName $ L.payload t) -- or = orf <$> label "or" (reserved "||") -- orf op lhs rhs = Term.or (ann lhs <> ann op <> ann rhs) lhs rhs From 8efd8d5cb9f6a45e3db389da72e5a57694cf0841 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Sat, 10 Aug 2024 22:45:19 -0400 Subject: [PATCH 569/631] Add comments --- parser-typechecker/src/Unison/Syntax/TermParser.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index e2aea4149f..8ada041d23 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -79,6 +79,8 @@ Sections / partial application of infix operators is not implemented. -- Precedence rules for infix operators. -- Lower number means higher precedence (tighter binding). +-- Operators not in this list have no precedence and will simply be parsed +-- left-to-right. precedenceRules :: Map Text Int precedenceRules = Map.fromList $ @@ -1068,6 +1070,9 @@ infixAppOrBooleanOp :: forall m v. (Monad m, Var v) => TermP v m infixAppOrBooleanOp = applyInfixOps <$> prelimParse where + -- To handle a mix of infix operators with and without precedence rules, + -- we first parse the expression left-associated, then reassociate it + -- according to the precedence rules. prelimParse :: P v m (InfixParse v) prelimParse = reassociate <$> chainl1 (InfixOperand <$> term4) genericInfixApp From fce96a54012927ef58659c0954bf57e974e5f2a8 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 12 Aug 2024 09:12:21 -0700 Subject: [PATCH 570/631] Fix non-deterministic sorting of rows in transcripts --- .../U/Codebase/Sqlite/Queries.hs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 822cdd125e..d2ded0758e 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3500,7 +3500,11 @@ getProjectReflog numEntries projectId = SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason FROM project_branch_reflog WHERE project_id = :projectId - ORDER BY time DESC + ORDER BY + time DESC, + -- Strictly for breaking ties in transcripts with the same time, + -- this will break ties in the correct order, sorting later inserted rows first. + ROWID DESC LIMIT :numEntries |] @@ -3512,7 +3516,11 @@ getProjectBranchReflog numEntries projectBranchId = SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason FROM project_branch_reflog WHERE project_branch_id = :projectBranchId - ORDER BY time DESC + ORDER BY + time DESC, + -- Strictly for breaking ties in transcripts with the same time, + -- this will break ties in the correct order, sorting later inserted rows first. + ROWID DESC LIMIT :numEntries |] @@ -3523,7 +3531,11 @@ getGlobalReflog numEntries = [sql| SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason FROM project_branch_reflog - ORDER BY time DESC + ORDER BY + time DESC, + -- Strictly for breaking ties in transcripts with the same time, + -- this will break ties in the correct order, sorting later inserted rows first. + ROWID DESC LIMIT :numEntries |] From 84b45c6d10bf1e46ebcb30d24163128ffc35f993 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 12 Aug 2024 15:40:24 -0400 Subject: [PATCH 571/631] don't prefer the unison file for type name suffixes --- parser-typechecker/src/Unison/PrintError.hs | 15 +- .../src/Unison/UnisonFile/Names.hs | 6 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 2 +- unison-core/src/Unison/DataDeclaration.hs | 2 +- .../src/Unison/DataDeclaration/Names.hs | 42 +++-- unison-core/src/Unison/Names.hs | 2 +- .../src/Unison/Names/ResolutionResult.hs | 28 +++- unison-core/src/Unison/Term.hs | 11 +- unison-core/src/Unison/Type/Names.hs | 101 ++++++++++-- unison-src/transcripts/fix3759.md | 57 ------- unison-src/transcripts/fix3759.output.md | 104 ------------ unison-src/transcripts/name-resolution.md | 60 +++++++ .../transcripts/name-resolution.output.md | 151 ++++++++++++++++++ 13 files changed, 359 insertions(+), 222 deletions(-) delete mode 100644 unison-src/transcripts/fix3759.md delete mode 100644 unison-src/transcripts/fix3759.output.md create mode 100644 unison-src/transcripts/name-resolution.md create mode 100644 unison-src/transcripts/name-resolution.output.md diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 691d7cd3ef..4b46cdd03f 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -1996,12 +1996,19 @@ prettyResolutionFailures s allFailures = toAmbiguityPair :: Names.ResolutionFailure v annotation -> (v, Maybe (NESet String)) toAmbiguityPair = \case - (Names.TermResolutionFailure v _ (Names.Ambiguous names refs)) -> do + (Names.TermResolutionFailure v _ (Names.Ambiguous names refs localNames)) -> do let ppe = ppeFromNames names - in (v, Just $ NES.map (showTermRef ppe) refs) - (Names.TypeResolutionFailure v _ (Names.Ambiguous names refs)) -> do + in ( v, + Just $ + NES.unsafeFromSet + (Set.map (showTermRef ppe) refs <> Set.map (Text.unpack . Name.toText) localNames) + ) + (Names.TypeResolutionFailure v _ (Names.Ambiguous names refs localNames)) -> do let ppe = ppeFromNames names - in (v, Just $ NES.map (showTypeRef ppe) refs) + in ( v, + Just $ + NES.unsafeFromSet (Set.map (showTypeRef ppe) refs <> Set.map (Text.unpack . Name.toText) localNames) + ) (Names.TermResolutionFailure v _ Names.NotFound) -> (v, Nothing) (Names.TypeResolutionFailure v _ Names.NotFound) -> (v, Nothing) diff --git a/parser-typechecker/src/Unison/UnisonFile/Names.hs b/parser-typechecker/src/Unison/UnisonFile/Names.hs index 00fdd5f115..1214dcee16 100644 --- a/parser-typechecker/src/Unison/UnisonFile/Names.hs +++ b/parser-typechecker/src/Unison/UnisonFile/Names.hs @@ -130,12 +130,12 @@ environmentFor :: Map v (EffectDeclaration v a) -> Names.ResolutionResult v a (Either [Error v a] (Env v a)) environmentFor names dataDecls0 effectDecls0 = do - let locallyBoundTypes = variableCanonicalizer (Map.keys dataDecls0 <> Map.keys effectDecls0) + let locallyBoundTypes = Map.keysSet dataDecls0 <> Map.keysSet effectDecls0 -- data decls and hash decls may reference each other, and thus must be hashed together dataDecls :: Map v (DataDeclaration v a) <- - traverse (DD.Names.bindNames Name.unsafeParseVar locallyBoundTypes names) dataDecls0 + traverse (DD.Names.bindNames Name.unsafeParseVar Name.toVar locallyBoundTypes names) dataDecls0 effectDecls :: Map v (EffectDeclaration v a) <- - traverse (DD.withEffectDeclM (DD.Names.bindNames Name.unsafeParseVar locallyBoundTypes names)) effectDecls0 + traverse (DD.withEffectDeclM (DD.Names.bindNames Name.unsafeParseVar Name.toVar locallyBoundTypes names)) effectDecls0 let allDecls0 :: Map v (DataDeclaration v a) allDecls0 = Map.union dataDecls (toDataDecl <$> effectDecls) hashDecls' :: [(v, Reference.Id, DataDeclaration v a)] <- Hashing.hashDataDecls allDecls0 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index df44a8d9ea..7e00fe534c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -1678,7 +1678,7 @@ parseType input src = do Parsers.parseType (Text.unpack (fst lexed)) parsingEnv & onLeftM \err -> Cli.returnEarly (TypeParseError src err) - Type.bindNames Name.unsafeParseVar mempty names (Type.generalizeLowercase mempty typ) & onLeft \errs -> + Type.bindNames Name.unsafeParseVar Name.toVar Set.empty names (Type.generalizeLowercase mempty typ) & onLeft \errs -> Cli.returnEarly (ParseResolutionFailures src (toList errs)) -- Adds a watch expression of the given name to the file, if diff --git a/unison-core/src/Unison/DataDeclaration.hs b/unison-core/src/Unison/DataDeclaration.hs index 513759ac07..8c5fde3a7e 100644 --- a/unison-core/src/Unison/DataDeclaration.hs +++ b/unison-core/src/Unison/DataDeclaration.hs @@ -108,7 +108,7 @@ data DataDeclaration v a = DataDeclaration bound :: [v], constructors' :: [(a, v, Type v a)] } - deriving (Eq, Ord, Show, Functor) + deriving (Eq, Ord, Show, Functor, Generic) constructorCount :: DataDeclaration v a -> Int constructorCount DataDeclaration {constructors'} = length constructors' diff --git a/unison-core/src/Unison/DataDeclaration/Names.hs b/unison-core/src/Unison/DataDeclaration/Names.hs index e1e7549308..5aba864f3f 100644 --- a/unison-core/src/Unison/DataDeclaration/Names.hs +++ b/unison-core/src/Unison/DataDeclaration/Names.hs @@ -1,28 +1,30 @@ {-# LANGUAGE RecordWildCards #-} -module Unison.DataDeclaration.Names (bindNames, dataDeclToNames', effectDeclToNames') where - -import Data.Map qualified as Map -import Data.Set qualified as Set -import Unison.ABT qualified as ABT +module Unison.DataDeclaration.Names + ( bindNames, + dataDeclToNames', + effectDeclToNames', + ) +where + +import Control.Lens (traverseOf, _3) import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType qualified as CT -import Unison.DataDeclaration (DataDeclaration (DataDeclaration), EffectDeclaration) +import Unison.DataDeclaration (DataDeclaration (..), EffectDeclaration) import Unison.DataDeclaration qualified as DD -import Unison.Name qualified as Name +import Unison.Name (Name) import Unison.Names (Names (Names)) import Unison.Names.ResolutionResult qualified as Names import Unison.Prelude import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent -import Unison.Type qualified as Type import Unison.Type.Names qualified as Type.Names import Unison.Util.Relation qualified as Rel import Unison.Var (Var) import Prelude hiding (cycle) -- implementation of dataDeclToNames and effectDeclToNames -toNames :: (Var v) => (v -> Name.Name) -> CT.ConstructorType -> v -> Reference.Id -> DataDeclaration v a -> Names +toNames :: (Var v) => (v -> Name) -> CT.ConstructorType -> v -> Reference.Id -> DataDeclaration v a -> Names toNames varToName ct typeSymbol (Reference.DerivedId -> r) dd = -- constructor names foldMap names (DD.constructorVars dd `zip` [0 ..]) @@ -32,29 +34,25 @@ toNames varToName ct typeSymbol (Reference.DerivedId -> r) dd = names (ctor, i) = Names (Rel.singleton (varToName ctor) (Referent.Con (ConstructorReference r i) ct)) mempty -dataDeclToNames :: (Var v) => (v -> Name.Name) -> v -> Reference.Id -> DataDeclaration v a -> Names +dataDeclToNames :: (Var v) => (v -> Name) -> v -> Reference.Id -> DataDeclaration v a -> Names dataDeclToNames varToName = toNames varToName CT.Data -effectDeclToNames :: (Var v) => (v -> Name.Name) -> v -> Reference.Id -> EffectDeclaration v a -> Names +effectDeclToNames :: (Var v) => (v -> Name) -> v -> Reference.Id -> EffectDeclaration v a -> Names effectDeclToNames varToName typeSymbol r ed = toNames varToName CT.Effect typeSymbol r $ DD.toDataDecl ed -dataDeclToNames' :: (Var v) => (v -> Name.Name) -> (v, (Reference.Id, DataDeclaration v a)) -> Names +dataDeclToNames' :: (Var v) => (v -> Name) -> (v, (Reference.Id, DataDeclaration v a)) -> Names dataDeclToNames' varToName (v, (r, d)) = dataDeclToNames varToName v r d -effectDeclToNames' :: (Var v) => (v -> Name.Name) -> (v, (Reference.Id, EffectDeclaration v a)) -> Names +effectDeclToNames' :: (Var v) => (v -> Name) -> (v, (Reference.Id, EffectDeclaration v a)) -> Names effectDeclToNames' varToName (v, (r, d)) = effectDeclToNames varToName v r d bindNames :: (Var v) => - (v -> Name.Name) -> - Map v v -> + (v -> Name) -> + (Name -> v) -> + Set v -> Names -> DataDeclaration v a -> Names.ResolutionResult v a (DataDeclaration v a) -bindNames varToName localNames names (DataDeclaration m a bound constructors) = do - constructors <- for constructors $ \(a, v, ty) -> - (a,v,) <$> Type.Names.bindNames varToName keepFree names (ABT.substsInheritAnnotation subs ty) - pure $ DataDeclaration m a bound constructors - where - keepFree = Set.fromList (Map.elems localNames) - subs = Map.toList $ Map.map (Type.var ()) localNames +bindNames unsafeVarToName nameToVar localNames namespaceNames = + traverseOf (#constructors' . traverse . _3) (Type.Names.bindNames unsafeVarToName nameToVar localNames namespaceNames) diff --git a/unison-core/src/Unison/Names.hs b/unison-core/src/Unison/Names.hs index d9d222b9c8..9e17160d90 100644 --- a/unison-core/src/Unison/Names.hs +++ b/unison-core/src/Unison/Names.hs @@ -93,7 +93,7 @@ data Names = Names { terms :: Relation Name Referent, types :: Relation Name TypeReference } - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Generic) instance Semigroup (Names) where Names e1 t1 <> Names e2 t2 = diff --git a/unison-core/src/Unison/Names/ResolutionResult.hs b/unison-core/src/Unison/Names/ResolutionResult.hs index e86bf2ac0b..0359ce57ad 100644 --- a/unison-core/src/Unison/Names/ResolutionResult.hs +++ b/unison-core/src/Unison/Names/ResolutionResult.hs @@ -1,21 +1,33 @@ -module Unison.Names.ResolutionResult where +module Unison.Names.ResolutionResult + ( ResolutionError (..), + ResolutionFailure (..), + ResolutionResult, + getAnnotation, + getVar, + ) +where -import Data.Set.NonEmpty +import Unison.Name (Name) import Unison.Names (Names) import Unison.Prelude -import Unison.Reference as Reference (Reference) -import Unison.Referent as Referent (Referent) +import Unison.Reference (TypeReference) +import Unison.Referent (Referent) data ResolutionError ref = NotFound - | -- Contains the names which were in scope and which refs were possible options - -- The NonEmpty set of refs must contain 2 or more refs (otherwise what is ambiguous?). - Ambiguous Names (NESet ref) + | -- Contains: + -- + -- 1. The namespace names + -- 2. The refs among those that we could be referring to + -- 3. The local names that we could be referring to + -- + -- The size of set (2.) + the size of set (3.) is at least 2 (otherwise there wouldn't be any ambiguity). + Ambiguous Names (Set ref) (Set Name) deriving (Eq, Ord, Show) -- | ResolutionFailure represents the failure to resolve a given variable. data ResolutionFailure var annotation - = TypeResolutionFailure var annotation (ResolutionError Reference) + = TypeResolutionFailure var annotation (ResolutionError TypeReference) | TermResolutionFailure var annotation (ResolutionError Referent) deriving (Eq, Ord, Show, Functor, Foldable, Traversable) diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index 5a3ea2127a..289d5fcf76 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -11,7 +11,6 @@ import Data.Generics.Sum (_Ctor) import Data.Map qualified as Map import Data.Sequence qualified as Sequence import Data.Set qualified as Set -import Data.Set.NonEmpty qualified as NES import Data.Text qualified as Text import Text.Show import Unison.ABT qualified as ABT @@ -165,15 +164,13 @@ bindNames unsafeVarToName keepFreeTerms ns e = do rs | Set.size rs == 1 -> pure (v, fromReferent a $ Set.findMin rs) - | otherwise -> case NES.nonEmptySet rs of - Nothing -> Left (pure (Names.TermResolutionFailure v a Names.NotFound)) - Just refs -> Left (pure (Names.TermResolutionFailure v a (Names.Ambiguous ns refs))) + | Set.size rs == 0 -> Left (pure (Names.TermResolutionFailure v a Names.NotFound)) + | otherwise -> Left (pure (Names.TermResolutionFailure v a (Names.Ambiguous ns rs Set.empty))) okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns of rs | Set.size rs == 1 -> pure (v, Type.ref a $ Set.findMin rs) - | otherwise -> case NES.nonEmptySet rs of - Nothing -> Left (pure (Names.TypeResolutionFailure v a Names.NotFound)) - Just refs -> Left (pure (Names.TypeResolutionFailure v a (Names.Ambiguous ns refs))) + | Set.size rs == 0 -> Left (pure (Names.TypeResolutionFailure v a Names.NotFound)) + | otherwise -> Left (pure (Names.TypeResolutionFailure v a (Names.Ambiguous ns rs Set.empty))) termSubsts <- validate okTm freeTmVars typeSubsts <- validate okTy freeTyVars pure . substTypeVars typeSubsts . ABT.substsInheritAnnotation termSubsts $ e diff --git a/unison-core/src/Unison/Type/Names.hs b/unison-core/src/Unison/Type/Names.hs index 5451406cdd..0627aef786 100644 --- a/unison-core/src/Unison/Type/Names.hs +++ b/unison-core/src/Unison/Type/Names.hs @@ -3,33 +3,106 @@ module Unison.Type.Names ) where +import Data.Sequence qualified as Seq import Data.Set qualified as Set -import Data.Set.NonEmpty qualified as NES import Unison.ABT qualified as ABT import Unison.HashQualified qualified as HQ +import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.Names qualified as Names +import Unison.Names (Names) import Unison.Names.ResolutionResult qualified as Names import Unison.NamesWithHistory qualified as Names import Unison.Prelude +import Unison.Reference (TypeReference) import Unison.Type +import Unison.Type qualified as Type import Unison.Util.List qualified as List +import Unison.Util.Relation qualified as Relation import Unison.Var (Var) +data ResolvesTo + = ResolvesToNamespace TypeReference + | ResolvesToLocal Name + bindNames :: + forall a v. (Var v) => - (v -> Name.Name) -> + (v -> Name) -> + (Name -> v) -> Set v -> - Names.Names -> + Names -> Type v a -> Names.ResolutionResult v a (Type v a) -bindNames unsafeVarToName keepFree ns t = - let fvs = ABT.freeVarOccurrences keepFree t - rs = [(v, a, Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns) | (v, a) <- fvs] - ok (v, a, rs) = - if Set.size rs == 1 - then pure (v, Set.findMin rs) - else case NES.nonEmptySet rs of - Nothing -> Left (pure (Names.TypeResolutionFailure v a Names.NotFound)) - Just rs' -> Left (pure (Names.TypeResolutionFailure v a (Names.Ambiguous ns rs'))) - in List.validate ok rs <&> \es -> bindExternal es t +bindNames unsafeVarToName nameToVar localVars namespaceNames ty = + let -- Identify the unresolved variables in the type: those whose names aren't an *exact* match for some locally-bound + -- type. + -- + -- For example: + -- + -- type Foo.Bar = ... + -- type Baz.Qux = ... + -- type Whatever = + -- Whatever + -- Foo.Bar -- this variable is *not* unresolved: it matches locally-bound `Foo.Bar` exactly + -- Qux -- this variable *is* unresolved: it doesn't match any locally-bound type exactly + unresolvedVars :: [(v, a)] + unresolvedVars = + ABT.freeVarOccurrences localVars ty + + -- For each unresolved variable, look up what it might refer to in two places: + -- + -- 1. The names from the namespace, less all of the local names (because exact matches shadow the namespace) + -- 2. The local names. + resolvedVars :: [(v, a, Set TypeReference, Set Name)] + resolvedVars = + map + ( \(v, a) -> + let name = unsafeVarToName v + in (v, a, getNamespaceMatches name, getLocalMatches name) + ) + unresolvedVars + + checkAmbiguity :: (v, a, Set TypeReference, Set Name) -> Either (Seq (Names.ResolutionFailure v a)) (v, ResolvesTo) + checkAmbiguity (v, a, namespaceMatches, localMatches) = + case (Set.size namespaceMatches, Set.size localMatches) of + (0, 0) -> bad Names.NotFound + (1, 0) -> good (ResolvesToNamespace (Set.findMin namespaceMatches)) + (0, 1) -> good (ResolvesToLocal (Set.findMin localMatches)) + _ -> bad (Names.Ambiguous namespaceNames namespaceMatches localMatches) + where + bad = Left . Seq.singleton . Names.TypeResolutionFailure v a + good = Right . (v,) + in List.validate checkAmbiguity resolvedVars <&> \resolutions -> + let -- Partition the resolutions into external/local + namespaceResolutions :: [(v, TypeReference)] + localResolutions :: [(v, Name)] + (namespaceResolutions, localResolutions) = + resolutions + -- Cast our nice informative ResolvesTo type to an Either, just to use `partitionEithers` + -- Is there a `partitonWith :: (a -> Either b c) -> [a] -> ([b], [c])` somewhere? + & map + ( \case + (v, ResolvesToNamespace ref) -> Left (v, ref) + (v, ResolvesToLocal name) -> Right (v, name) + ) + & partitionEithers + in ty + -- Apply namespace resolutions (replacing "Foo" with #Foo where "Foo" refers to namespace) + & bindExternal namespaceResolutions + -- Apply local resolutions (replacing "Foo" with "Full.Name.Foo" where "Full.Name.Foo" is in local vars) + & ABT.substsInheritAnnotation [(v, Type.var () (nameToVar name)) | (v, name) <- localResolutions] + where + localNames :: Set Name + localNames = + Set.map unsafeVarToName localVars + + getNamespaceMatches :: Name -> Set TypeReference + getNamespaceMatches name = + Names.lookupHQType + Names.IncludeSuffixes + (HQ.NameOnly name) + (over #types (Relation.subtractDom localNames) namespaceNames) + + getLocalMatches :: Name -> Set Name + getLocalMatches = + (`Name.searchBySuffix` Relation.fromList (map (\name -> (name, name)) (Set.toList localNames))) diff --git a/unison-src/transcripts/fix3759.md b/unison-src/transcripts/fix3759.md deleted file mode 100644 index 212bae6659..0000000000 --- a/unison-src/transcripts/fix3759.md +++ /dev/null @@ -1,57 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison:hide -unique type codebase.Foo = Foo - -Woot.state : Nat -Woot.state = 42 - -Woot.frobnicate : Nat -Woot.frobnicate = 43 -``` - -```ucm:hide -scratch/main> add -``` - -```unison -unique type Oog.Foo = Foo Text - -unique ability Blah where - foo : Foo -> () - -unique type Something = { state : Text } - -oog = do - foo (Foo "hi" : Oog.Foo) - -ex = do - s = Something "hello" - state s ++ " world!" - --- check that using locally unique suffix shadows the `Foo` in codebase -fn1 : Foo -> Foo -> Nat -fn1 = cases Foo a, Foo b -> Text.size a Nat.+ Text.size b - --- check that using local fully qualified name works fine -fn2 : Oog.Foo -> Oog.Foo -> Text -fn2 = cases Foo a, Foo b -> a Text.++ b - --- check that using fully qualified name works fine -fn3 : codebase.Foo -> codebase.Foo -> Text -fn3 = cases codebase.Foo.Foo, codebase.Foo.Foo -> "!!!!!!" - -> fn3 codebase.Foo.Foo codebase.Foo.Foo - --- now checking that terms fully qualified names work fine -blah.frobnicate = "Yay!" - -> Something.state (Something "hi") -> Woot.state + 1 -> Woot.frobnicate + 2 -> frobnicate Text.++ " 🎉" -> blah.frobnicate Text.++ " 🎉" -``` \ No newline at end of file diff --git a/unison-src/transcripts/fix3759.output.md b/unison-src/transcripts/fix3759.output.md deleted file mode 100644 index 1102f45357..0000000000 --- a/unison-src/transcripts/fix3759.output.md +++ /dev/null @@ -1,104 +0,0 @@ -``` unison -unique type codebase.Foo = Foo - -Woot.state : Nat -Woot.state = 42 - -Woot.frobnicate : Nat -Woot.frobnicate = 43 -``` - -``` unison -unique type Oog.Foo = Foo Text - -unique ability Blah where - foo : Foo -> () - -unique type Something = { state : Text } - -oog = do - foo (Foo "hi" : Oog.Foo) - -ex = do - s = Something "hello" - state s ++ " world!" - --- check that using locally unique suffix shadows the `Foo` in codebase -fn1 : Foo -> Foo -> Nat -fn1 = cases Foo a, Foo b -> Text.size a Nat.+ Text.size b - --- check that using local fully qualified name works fine -fn2 : Oog.Foo -> Oog.Foo -> Text -fn2 = cases Foo a, Foo b -> a Text.++ b - --- check that using fully qualified name works fine -fn3 : codebase.Foo -> codebase.Foo -> Text -fn3 = cases codebase.Foo.Foo, codebase.Foo.Foo -> "!!!!!!" - -> fn3 codebase.Foo.Foo codebase.Foo.Foo - --- now checking that terms fully qualified names work fine -blah.frobnicate = "Yay!" - -> Something.state (Something "hi") -> Woot.state + 1 -> Woot.frobnicate + 2 -> frobnicate Text.++ " 🎉" -> blah.frobnicate Text.++ " 🎉" -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - ability Blah - type Oog.Foo - type Something - Something.state : Something -> Text - Something.state.modify : (Text ->{g} Text) - -> Something - ->{g} Something - Something.state.set : Text -> Something -> Something - blah.frobnicate : Text - ex : 'Text - fn1 : Oog.Foo -> Oog.Foo -> Nat - fn2 : Oog.Foo -> Oog.Foo -> Text - fn3 : codebase.Foo - -> codebase.Foo - -> Text - oog : '{Blah} () - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 27 | > fn3 codebase.Foo.Foo codebase.Foo.Foo - ⧩ - "!!!!!!" - - 32 | > Something.state (Something "hi") - ⧩ - "hi" - - 33 | > Woot.state + 1 - ⧩ - 43 - - 34 | > Woot.frobnicate + 2 - ⧩ - 45 - - 35 | > frobnicate Text.++ " 🎉" - ⧩ - "Yay! 🎉" - - 36 | > blah.frobnicate Text.++ " 🎉" - ⧩ - "Yay! 🎉" - -``` diff --git a/unison-src/transcripts/name-resolution.md b/unison-src/transcripts/name-resolution.md new file mode 100644 index 0000000000..0bc957f4f7 --- /dev/null +++ b/unison-src/transcripts/name-resolution.md @@ -0,0 +1,60 @@ +# Example 1 + +We have a codebase type named `Codebase.Foo` and a file type named `File.Foo`. A reference to the type `Foo` is +ambiguous. A reference to `Codebase.Foo` or `File.Foo` work fine. + +```ucm +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +type Codebase.Foo = Bar +``` + +```ucm +scratch/main> add +``` + +```unison:error +type File.Foo = Baz +type UsesFoo = UsesFoo Foo +``` + +```unison +type File.Foo = Baz +type UsesFoo = UsesFoo Codebase.Foo File.Foo +``` + +```ucm +scratch/main> project.delete scratch +``` + +# Example 2 + +We have a codebase term `Woot.state : Nat` and a file term `Something.state : Text -> Something`. A reference to the +term `state : Text` resolves to `Something.state`, which shadows `Woot.state`. (This behavior will change). + +```ucm +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +Woot.state : Nat +Woot.state = 42 +``` + +```ucm +scratch/main> add +``` + +```unison +type Something = { state : Text } + +ex = do + s = Something "hello" + state s ++ " world!" +``` + +```ucm +scratch/main> project.delete scratch +``` diff --git a/unison-src/transcripts/name-resolution.output.md b/unison-src/transcripts/name-resolution.output.md new file mode 100644 index 0000000000..bb92d29ac2 --- /dev/null +++ b/unison-src/transcripts/name-resolution.output.md @@ -0,0 +1,151 @@ +# Example 1 + +We have a codebase type named `Codebase.Foo` and a file type named `File.Foo`. A reference to the type `Foo` is +ambiguous. A reference to `Codebase.Foo` or `File.Foo` work fine. + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. + +``` +``` unison +type Codebase.Foo = Bar +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type Codebase.Foo + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Codebase.Foo + +``` +``` unison +type File.Foo = Baz +type UsesFoo = UsesFoo Foo +``` + +``` ucm + + Loading changes detected in scratch.u. + + + ❓ + + I couldn't resolve any of these symbols: + + 2 | type UsesFoo = UsesFoo Foo + + + Symbol Suggestions + + Foo Codebase.Foo + File.Foo + + +``` +``` unison +type File.Foo = Baz +type UsesFoo = UsesFoo Codebase.Foo File.Foo +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type File.Foo + type UsesFoo + +``` +``` ucm +scratch/main> project.delete scratch + +``` +# Example 2 + +We have a codebase term `Woot.state : Nat` and a file term `Something.state : Text -> Something`. A reference to the +term `state : Text` resolves to `Something.state`, which shadows `Woot.state`. (This behavior will change). + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. + +``` +``` unison +Woot.state : Nat +Woot.state = 42 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + Woot.state : Nat + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + Woot.state : Nat + +``` +``` unison +type Something = { state : Text } + +ex = do + s = Something "hello" + state s ++ " world!" +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type Something + Something.state : Something -> Text + Something.state.modify : (Text ->{g} Text) + -> Something + ->{g} Something + Something.state.set : Text -> Something -> Something + ex : 'Text + +``` +``` ucm +scratch/main> project.delete scratch + +``` From 25aeacde3089000a7e6d2ad8384a7527bec41ba9 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 12 Aug 2024 16:16:52 -0400 Subject: [PATCH 572/631] beef up transcript and fix a couple bugs --- unison-core/src/Unison/Type/Names.hs | 48 +++--- unison-src/transcripts/name-resolution.md | 72 +++++++- .../transcripts/name-resolution.output.md | 162 +++++++++++++++++- 3 files changed, 248 insertions(+), 34 deletions(-) diff --git a/unison-core/src/Unison/Type/Names.hs b/unison-core/src/Unison/Type/Names.hs index 0627aef786..f1afbb0bc5 100644 --- a/unison-core/src/Unison/Type/Names.hs +++ b/unison-core/src/Unison/Type/Names.hs @@ -41,19 +41,21 @@ bindNames unsafeVarToName nameToVar localVars namespaceNames ty = -- -- type Foo.Bar = ... -- type Baz.Qux = ... - -- type Whatever = - -- Whatever - -- Foo.Bar -- this variable is *not* unresolved: it matches locally-bound `Foo.Bar` exactly - -- Qux -- this variable *is* unresolved: it doesn't match any locally-bound type exactly + -- type Whatever = Whatever Foo.Bar Qux + -- ^^^^^^^ ^^^ + -- | this variable *is* unresolved: it doesn't match any locally-bound type exactly + -- | + -- this variable is *not* unresolved: it matches locally-bound `Foo.Bar` exactly unresolvedVars :: [(v, a)] unresolvedVars = ABT.freeVarOccurrences localVars ty - -- For each unresolved variable, look up what it might refer to in two places: + -- For each unresolved variable, look up what it might refer to: -- - -- 1. The names from the namespace, less all of the local names (because exact matches shadow the namespace) - -- 2. The local names. - resolvedVars :: [(v, a, Set TypeReference, Set Name)] + -- 1. An exact match in the namespace. + -- 2. A suffix match in the namespace. + -- 3. A suffix match in the local names.. + resolvedVars :: [(v, a, (Set TypeReference, Set TypeReference), Set Name)] resolvedVars = map ( \(v, a) -> @@ -62,13 +64,17 @@ bindNames unsafeVarToName nameToVar localVars namespaceNames ty = ) unresolvedVars - checkAmbiguity :: (v, a, Set TypeReference, Set Name) -> Either (Seq (Names.ResolutionFailure v a)) (v, ResolvesTo) - checkAmbiguity (v, a, namespaceMatches, localMatches) = - case (Set.size namespaceMatches, Set.size localMatches) of - (0, 0) -> bad Names.NotFound - (1, 0) -> good (ResolvesToNamespace (Set.findMin namespaceMatches)) - (0, 1) -> good (ResolvesToLocal (Set.findMin localMatches)) - _ -> bad (Names.Ambiguous namespaceNames namespaceMatches localMatches) + checkAmbiguity :: + (v, a, (Set TypeReference, Set TypeReference), Set Name) -> + Either (Seq (Names.ResolutionFailure v a)) (v, ResolvesTo) + checkAmbiguity (v, a, (exactNamespaceMatches, suffixNamespaceMatches), localMatches) = + case (Set.size exactNamespaceMatches, Set.size suffixNamespaceMatches, Set.size localMatches) of + (1, _, _) -> good (ResolvesToNamespace (Set.findMin exactNamespaceMatches)) + (n, _, _) | n > 1 -> bad (Names.Ambiguous namespaceNames exactNamespaceMatches Set.empty) + (_, 0, 0) -> bad Names.NotFound + (_, 1, 0) -> good (ResolvesToNamespace (Set.findMin suffixNamespaceMatches)) + (_, 0, 1) -> good (ResolvesToLocal (Set.findMin localMatches)) + _ -> bad (Names.Ambiguous namespaceNames suffixNamespaceMatches localMatches) where bad = Left . Seq.singleton . Names.TypeResolutionFailure v a good = Right . (v,) @@ -96,12 +102,14 @@ bindNames unsafeVarToName nameToVar localVars namespaceNames ty = localNames = Set.map unsafeVarToName localVars - getNamespaceMatches :: Name -> Set TypeReference + getNamespaceMatches :: Name -> (Set TypeReference, Set TypeReference) getNamespaceMatches name = - Names.lookupHQType - Names.IncludeSuffixes - (HQ.NameOnly name) - (over #types (Relation.subtractDom localNames) namespaceNames) + ( Names.lookupHQType Names.ExactName (HQ.NameOnly name) namespaceNamesLessLocalNames, + Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly name) namespaceNamesLessLocalNames + ) + where + namespaceNamesLessLocalNames = + over #types (Relation.subtractDom localNames) namespaceNames getLocalMatches :: Name -> Set Name getLocalMatches = diff --git a/unison-src/transcripts/name-resolution.md b/unison-src/transcripts/name-resolution.md index 0bc957f4f7..5dac5ee7c2 100644 --- a/unison-src/transcripts/name-resolution.md +++ b/unison-src/transcripts/name-resolution.md @@ -1,14 +1,14 @@ # Example 1 -We have a codebase type named `Codebase.Foo` and a file type named `File.Foo`. A reference to the type `Foo` is -ambiguous. A reference to `Codebase.Foo` or `File.Foo` work fine. +We have a namespace type named `Namespace.Foo` and a file type named `File.Foo`. A reference to the type `Foo` is +ambiguous. A reference to `Namespace.Foo` or `File.Foo` work fine. ```ucm scratch/main> builtins.mergeio lib.builtins ``` ```unison -type Codebase.Foo = Bar +type Namespace.Foo = Bar ``` ```ucm @@ -22,7 +22,7 @@ type UsesFoo = UsesFoo Foo ```unison type File.Foo = Baz -type UsesFoo = UsesFoo Codebase.Foo File.Foo +type UsesFoo = UsesFoo Namespace.Foo File.Foo ``` ```ucm @@ -31,7 +31,69 @@ scratch/main> project.delete scratch # Example 2 -We have a codebase term `Woot.state : Nat` and a file term `Something.state : Text -> Something`. A reference to the +We have a namespace type named `Foo` and a file type named `File.Foo`. A reference to the type `Foo` is not ambiguous: +it refers to the namespace type (because it is an exact match). + +```ucm +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +type Foo = Bar +``` + +```ucm +scratch/main> add +``` + +```unison +type File.Foo = Baz +type UsesFoo = UsesFoo Foo +``` + +```ucm +scratch/main> add +scratch/main> view UsesFoo +``` + +```ucm +scratch/main> project.delete scratch +``` + +# Example 3 + +We have a namespace type named `Namespace.Foo` and a file type named `Foo`. A reference to the type `Foo` is not ambiguous: +it refers to the file type (because it is an exact match). + +```ucm +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +type Namespace.Foo = Bar +``` + +```ucm +scratch/main> add +``` + +```unison +type Foo = Baz +type UsesFoo = UsesFoo Foo +``` + +```ucm +scratch/main> add +scratch/main> view UsesFoo +``` + +```ucm +scratch/main> project.delete scratch +``` + +# Example 4 + +We have a namespace term `Woot.state : Nat` and a file term `Something.state : Text -> Something`. A reference to the term `state : Text` resolves to `Something.state`, which shadows `Woot.state`. (This behavior will change). ```ucm diff --git a/unison-src/transcripts/name-resolution.output.md b/unison-src/transcripts/name-resolution.output.md index bb92d29ac2..0e636b96d6 100644 --- a/unison-src/transcripts/name-resolution.output.md +++ b/unison-src/transcripts/name-resolution.output.md @@ -1,7 +1,7 @@ # Example 1 -We have a codebase type named `Codebase.Foo` and a file type named `File.Foo`. A reference to the type `Foo` is -ambiguous. A reference to `Codebase.Foo` or `File.Foo` work fine. +We have a namespace type named `Namespace.Foo` and a file type named `File.Foo`. A reference to the type `Foo` is +ambiguous. A reference to `Namespace.Foo` or `File.Foo` work fine. ``` ucm scratch/main> builtins.mergeio lib.builtins @@ -10,7 +10,7 @@ scratch/main> builtins.mergeio lib.builtins ``` ``` unison -type Codebase.Foo = Bar +type Namespace.Foo = Bar ``` ``` ucm @@ -23,7 +23,7 @@ type Codebase.Foo = Bar ⍟ These new definitions are ok to `add`: - type Codebase.Foo + type Namespace.Foo ``` ``` ucm @@ -31,7 +31,7 @@ scratch/main> add ⍟ I've added these definitions: - type Codebase.Foo + type Namespace.Foo ``` ``` unison @@ -53,14 +53,14 @@ type UsesFoo = UsesFoo Foo Symbol Suggestions - Foo Codebase.Foo - File.Foo + Foo File.Foo + Namespace.Foo ``` ``` unison type File.Foo = Baz -type UsesFoo = UsesFoo Codebase.Foo File.Foo +type UsesFoo = UsesFoo Namespace.Foo File.Foo ``` ``` ucm @@ -83,7 +83,151 @@ scratch/main> project.delete scratch ``` # Example 2 -We have a codebase term `Woot.state : Nat` and a file term `Something.state : Text -> Something`. A reference to the +We have a namespace type named `Foo` and a file type named `File.Foo`. A reference to the type `Foo` is not ambiguous: +it refers to the namespace type (because it is an exact match). + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. + +``` +``` unison +type Foo = Bar +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type Foo + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + +``` +``` unison +type File.Foo = Baz +type UsesFoo = UsesFoo Foo +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type File.Foo + type UsesFoo + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type File.Foo + type UsesFoo + +scratch/main> view UsesFoo + + type UsesFoo = UsesFoo Foo + +``` +``` ucm +scratch/main> project.delete scratch + +``` +# Example 3 + +We have a namespace type named `Namespace.Foo` and a file type named `Foo`. A reference to the type `Foo` is not ambiguous: +it refers to the file type (because it is an exact match). + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. + +``` +``` unison +type Namespace.Foo = Bar +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type Namespace.Foo + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Namespace.Foo + +``` +``` unison +type Foo = Baz +type UsesFoo = UsesFoo Foo +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type Foo + type UsesFoo + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + type UsesFoo + +scratch/main> view UsesFoo + + type UsesFoo = UsesFoo Foo + +``` +``` ucm +scratch/main> project.delete scratch + +``` +# Example 4 + +We have a namespace term `Woot.state : Nat` and a file term `Something.state : Text -> Something`. A reference to the term `state : Text` resolves to `Something.state`, which shadows `Woot.state`. (This behavior will change). ``` ucm From 7012cc4ba1e9ba74b2729873a89528094a5537f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Tue, 13 Aug 2024 00:03:14 -0400 Subject: [PATCH 573/631] Proper algorithm for reassociation --- .../src/Unison/Syntax/TermParser.hs | 70 ++++++++++--------- unison-syntax/src/Unison/Syntax/Parser.hs | 22 ++++++ 2 files changed, 58 insertions(+), 34 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 8ada041d23..6a364b0190 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -1063,56 +1063,59 @@ data InfixParse v | InfixAnd (L.Token String) (InfixParse v) (InfixParse v) | InfixOr (L.Token String) (InfixParse v) (InfixParse v) | InfixOperand (Term v Ann) + deriving (Show, Eq, Ord) -- e.g. term4 + term4 - term4 -- or term4 || term4 && term4 infixAppOrBooleanOp :: forall m v. (Monad m, Var v) => TermP v m -infixAppOrBooleanOp = - applyInfixOps <$> prelimParse +infixAppOrBooleanOp = do + (p, ps) <- prelimParse + -- traceShowM ("orig" :: String, foldl' (flip ($)) p ps) + let p' = reassociate (p, ps) + -- traceShowM ("reassoc" :: String, p') + return (applyInfixOps p') where -- To handle a mix of infix operators with and without precedence rules, -- we first parse the expression left-associated, then reassociate it -- according to the precedence rules. - prelimParse :: P v m (InfixParse v) prelimParse = - reassociate <$> chainl1 (InfixOperand <$> term4) genericInfixApp + chainl1Accum (InfixOperand <$> term4) genericInfixApp genericInfixApp = (InfixAnd <$> (label "and" (reserved "&&"))) <|> (InfixOr <$> (label "or" (reserved "||"))) <|> (uncurry InfixOp <$> parseInfix) + shouldRotate child parent = case (child, parent) of + (Just p1, Just p2) -> p1 > p2 + _ -> False parseInfix = label "infixApp" do op <- hqInfixId <* optional semi resolved <- resolveHashQualified op pure (op, resolved) - reassociate x = fst $ go Nothing x - where - go parentPrec = \case - InfixOp op tm lhs rhs -> - let prec = Map.lookup (unqualified op) precedenceRules - in rotate prec (InfixOp op tm) lhs rhs - InfixOperand tm -> (InfixOperand tm, False) - InfixAnd op lhs rhs -> rotate (Just 4) (InfixAnd op) lhs rhs - InfixOr op lhs rhs -> rotate (Just 6) (InfixOr op) lhs rhs - where - rotate :: - Maybe Int -> - ( InfixParse v -> - InfixParse v -> - InfixParse v - ) -> - InfixParse v -> - InfixParse v -> - (InfixParse v, Bool) - rotate prec ctor lhs rhs = - let (lhs', shouldRotLeft) = go prec lhs - shouldRotate = (((>) <$> prec <*> parentPrec) == (Just True)) - in if shouldRotLeft - then case lhs' of - InfixOp lop ltm ll lr -> go prec (InfixOp lop ltm ll (ctor lr rhs)) - InfixAnd lop ll lr -> go prec (InfixAnd lop ll (ctor lr rhs)) - InfixOr lop ll lr -> go prec (InfixOr lop ll (ctor lr rhs)) - _ -> (ctor lhs' rhs, shouldRotate) - else (ctor lhs' rhs, shouldRotate) + reassociate (exp, ops) = + foldl' checkOp exp ops + checkOp exp op = fixUp (op exp) + fixUp = \case + InfixOp op tm lhs rhs -> + rotate (unqualified op) (InfixOp op tm) lhs rhs + InfixAnd op lhs rhs -> + rotate "&&" (InfixAnd op) lhs rhs + InfixOr op lhs rhs -> + rotate "||" (InfixOr op) lhs rhs + x -> x + rotate op ctor lhs rhs = + case lhs of + InfixOp lop ltm ll lr + | shouldRotate (precedence (unqualified lop)) (precedence op) -> + InfixOp lop ltm ll (fixUp (ctor lr rhs)) + InfixAnd lop ll lr + | shouldRotate (precedence "&&") (precedence op) -> + InfixAnd lop ll (fixUp (ctor lr rhs)) + InfixOr lop ll lr + | shouldRotate (precedence "||") (precedence op) -> + InfixOr lop ll (fixUp (ctor lr rhs)) + _ -> ctor lhs rhs + precedence op = Map.lookup op precedenceRules + unqualified t = Maybe.fromJust $ NameSegment.toEscapedText . Name.lastSegment <$> (HQ.toName $ L.payload t) applyInfixOps :: InfixParse v -> Term v Ann applyInfixOps t = case t of InfixOp _ tm lhs rhs -> @@ -1126,7 +1129,6 @@ infixAppOrBooleanOp = let lhs' = applyInfixOps lhs rhs' = applyInfixOps rhs in Term.or (ann lhs' <> ann op <> ann rhs') lhs' rhs' - unqualified t = Maybe.fromJust $ NameSegment.toEscapedText . Name.lastSegment <$> (HQ.toName $ L.payload t) -- or = orf <$> label "or" (reserved "||") -- orf op lhs rhs = Term.or (ann lhs <> ann op <> ann rhs) lhs rhs diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 6c4aa74b95..e9a8ec6339 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -15,6 +15,7 @@ module Unison.Syntax.Parser bytesToken, chainl1, chainr1, + chainl1Accum, character, closeBlock, optionalCloseBlock, @@ -444,6 +445,27 @@ chainr1 p op = go1 chainl1 :: (Ord v) => P v m a -> P v m (a -> a -> a) -> P v m a chainl1 p op = foldl (flip ($)) <$> p <*> P.many (flip <$> op <*> p) +-- chainl1Accum is like chainl1, but it accumulates intermediate results +-- instead of applying them immediately. It's used to implement infix +-- operators that may or may not have precedence rules. +chainl1Accum :: + (P.Stream u, Ord s) => + P.ParsecT s u m a -> + P.ParsecT s u m (a -> a -> a) -> + P.ParsecT s u m (a, [a -> a]) +chainl1Accum p op = do + x <- p + fs <- rest [] + pure (x, fs) + where + rest fs = + ( do + f <- op + y <- p + rest (fs ++ [flip f y]) + ) + <|> return fs + -- | If `p` would succeed, this fails uncommitted. -- Otherwise, `failIfOk` used to produce the output failureIf :: (Ord v) => P v m (P v m b) -> P v m a -> P v m b From 8736c4ab49754762d5130833c6b976f5e8cf8e79 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Tue, 13 Aug 2024 00:24:25 -0400 Subject: [PATCH 574/631] Comments --- .../src/Unison/Syntax/TermParser.hs | 31 +++++++------------ 1 file changed, 11 insertions(+), 20 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 6a364b0190..e57f022dcc 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -1067,6 +1067,17 @@ data InfixParse v -- e.g. term4 + term4 - term4 -- or term4 || term4 && term4 +-- The algorithm works as follows: +-- 1. Parse the expression left-associated +-- 2. Starting at the leftmost operator subexpression, see if the next operator +-- has higher precedence. If so, rotate the expression to the right. +-- e.g. in `a + b * c`, we first parse `(a + b) * c` then rotate to `a + (b * c)`. +-- 3. Perform the algorithm on the right-hand side if necessary. +-- e.g. in `a + b + c * d`, we have `(a + (b + c)) * d` and `* d` is the next +-- operator to consider. We rotate to `(a + ((b + c) * d))` in step 2. +-- Step 3 is to rotate the subexpression `(b + c) * d` to be `b + (c * d)`. +-- 4. Proceed to the next operator to the right in the original expression and +-- repeat steps 2-3 until we reach the end. infixAppOrBooleanOp :: forall m v. (Monad m, Var v) => TermP v m infixAppOrBooleanOp = do (p, ps) <- prelimParse @@ -1130,26 +1141,6 @@ infixAppOrBooleanOp = do rhs' = applyInfixOps rhs in Term.or (ann lhs' <> ann op <> ann rhs') lhs' rhs' --- or = orf <$> label "or" (reserved "||") --- orf op lhs rhs = Term.or (ann lhs <> ann op <> ann rhs) lhs rhs --- and = andf <$> label "and" (reserved "&&") --- andf op lhs rhs = Term.and (ann lhs <> ann op <> ann rhs) lhs rhs --- infixAppPrec c = infixAppNoPrec c <|> otherOp --- infixAppNoPrec c = --- infixAppf --- <$> label "infixApp" (hashQualifiedInfixTermStartingWith c <* optional semi) --- infixAppf :: Term v Ann -> Term v Ann -> Term v Ann -> Term v Ann --- infixAppf op lhs rhs = Term.apps' op [lhs, rhs] - --- chainl1 term4 (or <|> and <|> infixApp) --- where --- or = orf <$> label "or" (reserved "||") --- orf op lhs rhs = Term.or (ann lhs <> ann op <> ann rhs) lhs rhs --- and = andf <$> label "and" (reserved "&&") --- andf op lhs rhs = Term.and (ann lhs <> ann op <> ann rhs) lhs rhs --- infixApp = infixAppf <$> label "infixApp" (hashQualifiedInfixTerm <* optional semi) --- infixAppf op lhs rhs = Term.apps' op [lhs, rhs] - typedecl :: (Monad m, Var v) => P v m (L.Token v, Type v Ann) typedecl = (,) From b92dede21af6b905b45d4f752e24184bc2b75b3a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Tue, 13 Aug 2024 00:29:32 -0400 Subject: [PATCH 575/631] Improve comments --- parser-typechecker/src/Unison/Syntax/TermParser.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index e57f022dcc..48f1a3fd92 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -1072,10 +1072,8 @@ data InfixParse v -- 2. Starting at the leftmost operator subexpression, see if the next operator -- has higher precedence. If so, rotate the expression to the right. -- e.g. in `a + b * c`, we first parse `(a + b) * c` then rotate to `a + (b * c)`. --- 3. Perform the algorithm on the right-hand side if necessary. --- e.g. in `a + b + c * d`, we have `(a + (b + c)) * d` and `* d` is the next --- operator to consider. We rotate to `(a + ((b + c) * d))` in step 2. --- Step 3 is to rotate the subexpression `(b + c) * d` to be `b + (c * d)`. +-- 3. Perform the algorithm on the right-hand side if necessary, as `b` might be +-- an infix expression with lower precedence than `*`. -- 4. Proceed to the next operator to the right in the original expression and -- repeat steps 2-3 until we reach the end. infixAppOrBooleanOp :: forall m v. (Monad m, Var v) => TermP v m From 7b315c3b3423a7595c6ca63b5aaa32948d051012 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 13 Aug 2024 12:05:52 -0400 Subject: [PATCH 576/631] delete unused Mergeblob2.lcaDeclNameLookup field --- unison-merge/src/Unison/Merge/Mergeblob2.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/unison-merge/src/Unison/Merge/Mergeblob2.hs b/unison-merge/src/Unison/Merge/Mergeblob2.hs index 4f3491efe8..4b0440f53f 100644 --- a/unison-merge/src/Unison/Merge/Mergeblob2.hs +++ b/unison-merge/src/Unison/Merge/Mergeblob2.hs @@ -14,7 +14,6 @@ import Unison.DeclNameLookup (DeclNameLookup) import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.FindConflictedAlias (findConflictedAlias) import Unison.Merge.Mergeblob1 (Mergeblob1 (..)) -import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) import Unison.Merge.PartitionCombinedDiffs (narrowConflictsToNonBuiltins) import Unison.Merge.ThreeWay (ThreeWay) import Unison.Merge.ThreeWay qualified as ThreeWay @@ -53,7 +52,6 @@ data Mergeblob2 libdep = Mergeblob2 (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann) ), - lcaDeclNameLookup :: PartialDeclNameLookup, libdeps :: Map NameSegment libdep, soloUpdatesAndDeletes :: TwoWay (DefnsF Set Name Name), unconflicts :: DefnsF Unconflicts Referent TypeReference @@ -88,7 +86,6 @@ makeMergeblob2 blob = do -- Eh, they'd either both be null, or neither, but just check both maps anyway hasConflicts = not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob), hydratedDefns = ThreeWay.forgetLca blob.hydratedDefns, - lcaDeclNameLookup = blob.lcaDeclNameLookup, libdeps = blob.libdeps, soloUpdatesAndDeletes, unconflicts = blob.unconflicts From 4c3019255350099dd69915e5ae3f173f02813ec9 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 13 Aug 2024 12:11:32 -0400 Subject: [PATCH 577/631] inline Mergeblob2.conflictsNames and Mergeblob2.conflictsIds --- unison-merge/src/Unison/Merge/Mergeblob2.hs | 18 ++++++++++-------- unison-merge/src/Unison/Merge/Mergeblob3.hs | 20 ++++++++++++-------- 2 files changed, 22 insertions(+), 16 deletions(-) diff --git a/unison-merge/src/Unison/Merge/Mergeblob2.hs b/unison-merge/src/Unison/Merge/Mergeblob2.hs index 4b0440f53f..fc76660bbe 100644 --- a/unison-merge/src/Unison/Merge/Mergeblob2.hs +++ b/unison-merge/src/Unison/Merge/Mergeblob2.hs @@ -39,8 +39,6 @@ import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty, zipDefnsWith) data Mergeblob2 libdep = Mergeblob2 { conflicts :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId), - conflictsIds :: TwoWay (DefnsF Set TermReferenceId TypeReferenceId), - conflictsNames :: TwoWay (DefnsF Set Name Name), coreDependencies :: TwoWay (DefnsF Set TermReference TypeReference), declNameLookups :: TwoWay DeclNameLookup, defns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), @@ -69,17 +67,21 @@ makeMergeblob2 blob = do Left . Mergeblob2Error'ConflictedAlias . who conflicts <- narrowConflictsToNonBuiltins blob.conflicts & mapLeft Mergeblob2Error'ConflictedBuiltin - let conflictsIds = bimap (Set.fromList . Map.elems) (Set.fromList . Map.elems) <$> conflicts - let conflictsNames = bimap Map.keysSet Map.keysSet <$> conflicts - let soloUpdatesAndDeletes = Unconflicts.soloUpdatesAndDeletes blob.unconflicts - let coreDependencies = identifyCoreDependencies (ThreeWay.forgetLca blob.defns) conflictsIds soloUpdatesAndDeletes + let soloUpdatesAndDeletes :: TwoWay (DefnsF Set Name Name) + soloUpdatesAndDeletes = + Unconflicts.soloUpdatesAndDeletes blob.unconflicts + + let coreDependencies :: TwoWay (DefnsF Set TermReference TypeReference) + coreDependencies = + identifyCoreDependencies + (ThreeWay.forgetLca blob.defns) + (bimap (Set.fromList . Map.elems) (Set.fromList . Map.elems) <$> conflicts) + soloUpdatesAndDeletes pure Mergeblob2 { conflicts, - conflictsIds, - conflictsNames, coreDependencies, declNameLookups = blob.declNameLookups, defns = blob.defns, diff --git a/unison-merge/src/Unison/Merge/Mergeblob3.hs b/unison-merge/src/Unison/Merge/Mergeblob3.hs index 6133c404d0..d7dee3d235 100644 --- a/unison-merge/src/Unison/Merge/Mergeblob3.hs +++ b/unison-merge/src/Unison/Merge/Mergeblob3.hs @@ -31,6 +31,7 @@ import Unison.Reference (Reference' (..), TermReferenceId, TypeReference, TypeRe import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Symbol (Symbol) +import Unison.Syntax.FilePrinter (renderDefnsForUnisonFile) import Unison.Syntax.Name qualified as Name import Unison.Term (Term) import Unison.Type (Type) @@ -41,7 +42,6 @@ import Unison.Util.Pretty (ColorText, Pretty) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation qualified as Relation import Prelude hiding (unzip) -import Unison.Syntax.FilePrinter (renderDefnsForUnisonFile) data Mergeblob3 = Mergeblob3 { libdeps :: Names, @@ -56,11 +56,15 @@ makeMergeblob3 :: TwoWay Text -> Mergeblob3 makeMergeblob3 blob dependents0 libdeps authors = - -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if - -- there aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) - let dependents = + let conflictsNames :: TwoWay (DefnsF Set Name Name) + conflictsNames = + bimap Map.keysSet Map.keysSet <$> blob.conflicts + + -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if + -- there aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) + dependents = filterDependents - blob.conflictsNames + conflictsNames blob.soloUpdatesAndDeletes ( let f :: Set TermReferenceId -> Referent -> NESet Name -> Set Name f deps defn0 names @@ -85,7 +89,7 @@ makeMergeblob3 blob dependents0 libdeps authors = renderConflictsAndDependents blob.declNameLookups blob.hydratedDefns - blob.conflictsNames + conflictsNames dependents (defnsToNames <$> ThreeWay.forgetLca blob.defns) libdeps @@ -94,7 +98,7 @@ makeMergeblob3 blob dependents0 libdeps authors = stageOne = makeStageOne blob.declNameLookups - blob.conflictsNames + conflictsNames blob.unconflicts dependents (bimap BiMultimap.range BiMultimap.range blob.defns.lca), @@ -204,7 +208,7 @@ renderConflictsAndDependents :: renderConflictsAndDependents declNameLookups hydratedDefns conflicts dependents names libdepsNames = unzip $ ( \declNameLookup (conflicts, dependents) ppe -> - let render = renderDefnsForUnisonFile declNameLookup ppe . over (#terms . mapped) snd + let render = renderDefnsForUnisonFile declNameLookup ppe . over (#terms . mapped) snd in (render conflicts, render dependents) ) <$> declNameLookups From 28543adcdd7f70ad2f265cd1cc84998779f132cd Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 13 Aug 2024 12:46:42 -0400 Subject: [PATCH 578/631] reuse unique type guids in merge after all --- .../Codebase/Editor/HandleInput/Merge2.hs | 4 +- unison-merge/src/Unison/Merge/Mergeblob3.hs | 46 +++++++++++++++++++ unison-merge/src/Unison/Merge/Mergeblob4.hs | 17 +++---- unison-src/transcripts/merge.output.md | 4 +- unison-syntax/src/Unison/Syntax/Parser.hs | 2 +- 5 files changed, 59 insertions(+), 14 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index c3fb06f800..d8166ae03a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -280,8 +280,6 @@ doMerge info = do mergedLibdeps <- Cli.runTransaction (libdepsToBranch0 (Codebase.getDeclType env.codebase) blob2.libdeps) - uniqueName <- liftIO env.generateUniqueName - let hasConflicts = blob2.hasConflicts @@ -307,7 +305,7 @@ doMerge info = do maybeBlob5 <- if hasConflicts then pure Nothing - else case Merge.makeMergeblob4 blob3 uniqueName of + else case Merge.makeMergeblob4 blob3 of Left _parseErr -> pure Nothing Right blob4 -> do typeLookup <- Cli.runTransaction (Codebase.typeLookupForDependencies env.codebase blob4.dependencies) diff --git a/unison-merge/src/Unison/Merge/Mergeblob3.hs b/unison-merge/src/Unison/Merge/Mergeblob3.hs index d7dee3d235..97e11a8c08 100644 --- a/unison-merge/src/Unison/Merge/Mergeblob3.hs +++ b/unison-merge/src/Unison/Merge/Mergeblob3.hs @@ -15,6 +15,7 @@ import Data.Set.NonEmpty qualified as Set.NonEmpty import Data.These (These (..)) import Data.Zip (unzip) import Unison.DataDeclaration (Decl) +import Unison.DataDeclaration qualified as DataDeclaration import Unison.DeclNameLookup (DeclNameLookup, expectConstructorNames) import Unison.Merge.Mergeblob2 (Mergeblob2 (..)) import Unison.Merge.PrettyPrintEnv (makePrettyPrintEnvs) @@ -46,6 +47,7 @@ import Prelude hiding (unzip) data Mergeblob3 = Mergeblob3 { libdeps :: Names, stageOne :: DefnsF (Map Name) Referent TypeReference, + uniqueTypeGuids :: Map Name Text, unparsedFile :: Pretty ColorText } @@ -102,6 +104,7 @@ makeMergeblob3 blob dependents0 libdeps authors = blob.unconflicts dependents (bimap BiMultimap.range BiMultimap.range blob.defns.lca), + uniqueTypeGuids = makeUniqueTypeGuids blob.hydratedDefns, unparsedFile = makePrettyUnisonFile authors renderedConflicts renderedDependents } @@ -295,3 +298,46 @@ makePrettyUnisonFile authors conflicts dependents = bimap f f where f = map snd . List.sortOn (Name.toText . fst) . Map.toList + +-- Given Alice's and Bob's hydrated defns, make a mapping from unique type name to unique type GUID, preferring Alice's +-- GUID if they both have one. +makeUniqueTypeGuids :: + TwoWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ) -> + Map Name Text +makeUniqueTypeGuids hydratedDefns = + let -- Start off with just Alice's GUIDs + aliceGuids :: Map Name Text + aliceGuids = + Map.mapMaybe (declGuid . snd) hydratedDefns.alice.types + + -- Define a helper that adds a Bob GUID only if it's not already in the map (so, preferring Alice) + addBobGuid :: Map Name Text -> (Name, (TypeReferenceId, Decl Symbol Ann)) -> Map Name Text + addBobGuid acc (name, (_, bobDecl)) = + Map.alter + ( \case + Nothing -> bobGuid + Just aliceGuid -> Just aliceGuid + ) + name + acc + where + bobGuid :: Maybe Text + bobGuid = + declGuid bobDecl + + -- Tumble in all of Bob's GUIDs with that helper + allTheGuids :: Map Name Text + allTheGuids = + List.foldl' addBobGuid aliceGuids (Map.toList hydratedDefns.bob.types) + in allTheGuids + where + declGuid :: Decl v a -> Maybe Text + declGuid decl = + case (DataDeclaration.asDataDecl decl).modifier of + DataDeclaration.Structural -> Nothing + DataDeclaration.Unique guid -> Just guid diff --git a/unison-merge/src/Unison/Merge/Mergeblob4.hs b/unison-merge/src/Unison/Merge/Mergeblob4.hs index 6a3631111d..b7229c766f 100644 --- a/unison-merge/src/Unison/Merge/Mergeblob4.hs +++ b/unison-merge/src/Unison/Merge/Mergeblob4.hs @@ -4,6 +4,7 @@ module Unison.Merge.Mergeblob4 ) where +import Data.Map.Strict qualified as Map import Unison.Merge.Mergeblob3 (Mergeblob3 (..)) import Unison.Names (Names (..)) import Unison.Parser.Ann (Ann) @@ -11,7 +12,7 @@ import Unison.Parsers qualified as Parsers import Unison.Prelude import Unison.Reference (Reference) import Unison.Symbol (Symbol) -import Unison.Syntax.Parser (ParsingEnv (..), UniqueName) +import Unison.Syntax.Parser (ParsingEnv (..)) import Unison.Syntax.Parser qualified as Parser import Unison.UnisonFile (UnisonFile) import Unison.UnisonFile qualified as UnisonFile @@ -24,18 +25,18 @@ data Mergeblob4 = Mergeblob4 file :: UnisonFile Symbol Ann } -makeMergeblob4 :: Mergeblob3 -> UniqueName -> Either (Parser.Err Symbol) Mergeblob4 -makeMergeblob4 blob uniqueName = do +makeMergeblob4 :: Mergeblob3 -> Either (Parser.Err Symbol) Mergeblob4 +makeMergeblob4 blob = do let stageOneNames = Names (Relation.fromMap blob.stageOne.terms) (Relation.fromMap blob.stageOne.types) <> blob.libdeps parsingEnv = ParsingEnv - { uniqueNames = uniqueName, - -- The codebase names are disjoint from the file names, i.e. there aren't any things that - -- would be classified as an update upon parsing. So, there's no need to try to look up any - -- existing unique type GUIDs to reuse. - uniqueTypeGuid = \_ -> Identity Nothing, + { -- We don't expect to have to generate any new GUIDs, since the uniqueTypeGuid lookup function below should + -- cover all name in the merged file we're about to parse and typecheck. So, this might be more correct as a + -- call to `error`. + uniqueNames = Parser.UniqueName \_ _ -> Nothing, + uniqueTypeGuid = \name -> Identity (Map.lookup name blob.uniqueTypeGuids), names = stageOneNames } file <- runIdentity (Parsers.parseFile "" (Pretty.toPlain 80 blob.unparsedFile) parsingEnv) diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 6f4eba070d..9dea5fdcf6 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1024,7 +1024,7 @@ Bob, meanwhile, first deletes the term, then sort of deletes the type and re-add ``` ucm project/bob> view Foo.Bar - type Foo.Bar = Hello Nat Nat | Baz Nat + type Foo.Bar = Baz Nat | Hello Nat Nat ``` At this point, Bob and alice have both updated the name `Foo.Bar.Hello` in different ways, so that's a conflict. Therefore, Bob's entire type (`Foo.Bar` with constructors `Foo.Bar.Baz` and `Foo.Bar.Hello`) gets rendered into the scratch file. @@ -1061,7 +1061,7 @@ Foo.Bar.Hello : Nat Foo.Bar.Hello = 18 -- project/bob -type Foo.Bar = Hello Nat Nat | Baz Nat +type Foo.Bar = Baz Nat | Hello Nat Nat ``` diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 6c4aa74b95..0a7b9bcaf3 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -9,7 +9,7 @@ module Unison.Syntax.Parser Input (..), P, ParsingEnv (..), - UniqueName, + UniqueName(..), anyToken, blank, bytesToken, From 6325d4586b9c827d280c8f395bd6f83c05d61683 Mon Sep 17 00:00:00 2001 From: mitchellwrosen Date: Tue, 13 Aug 2024 16:47:27 +0000 Subject: [PATCH 579/631] automatically run ormolu --- unison-syntax/src/Unison/Syntax/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 0a7b9bcaf3..1ac87e8eb2 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -9,7 +9,7 @@ module Unison.Syntax.Parser Input (..), P, ParsingEnv (..), - UniqueName(..), + UniqueName (..), anyToken, blank, bytesToken, From cc48213b1b2e66cce9aa7043f00d458cc2f8a7c7 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 13 Aug 2024 14:05:22 -0400 Subject: [PATCH 580/631] distinguish between type and term dependencies in UF.dependencies --- parser-typechecker/src/Unison/Codebase.hs | 51 ++++++++++++------ .../src/Unison/Codebase/CodeLookup.hs | 3 +- parser-typechecker/src/Unison/FileParsers.hs | 20 +++++-- parser-typechecker/src/Unison/UnisonFile.hs | 35 +++++++----- .../Unison/Codebase/Editor/HandleInput/Run.hs | 5 +- .../Unison/Codebase/Editor/SlurpComponent.hs | 54 +++++++++---------- unison-core/src/Unison/DataDeclaration.hs | 4 +- unison-core/src/Unison/Term.hs | 33 ++++++------ unison-merge/src/Unison/Merge/Mergeblob4.hs | 6 +-- 9 files changed, 127 insertions(+), 84 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index a741477b0c..7d3fb7b8a1 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -150,7 +150,7 @@ import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Parser import Unison.Prelude import Unison.Project (ProjectAndBranch (ProjectAndBranch), ProjectBranchName, ProjectName) -import Unison.Reference (Reference, TermReferenceId, TypeReference) +import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.Runtime.IOSource qualified as IOSource @@ -163,6 +163,7 @@ import Unison.Type qualified as Type import Unison.Typechecker.TypeLookup (TypeLookup (TypeLookup)) import Unison.Typechecker.TypeLookup qualified as TL import Unison.UnisonFile qualified as UF +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.Relation qualified as Rel import Unison.Var (Var) import Unison.WatchKind qualified as WK @@ -364,35 +365,51 @@ lookupWatchCache codebase h = do -- and all of their type dependencies, including builtins. typeLookupForDependencies :: Codebase IO Symbol Ann -> - Set Reference -> + DefnsF Set TermReference TypeReference -> Sqlite.Transaction (TL.TypeLookup Symbol Ann) typeLookupForDependencies codebase s = do when debug $ traceM $ "typeLookupForDependencies " ++ show s - (<> Builtin.typeLookup) <$> depthFirstAccum mempty s + (<> Builtin.typeLookup) <$> depthFirstAccum s where - depthFirstAccum :: TL.TypeLookup Symbol Ann -> Set Reference -> Sqlite.Transaction (TL.TypeLookup Symbol Ann) - depthFirstAccum tl refs = foldM go tl (Set.filter (unseen tl) refs) + depthFirstAccum :: + DefnsF Set TermReference TypeReference -> + Sqlite.Transaction (TL.TypeLookup Symbol Ann) + depthFirstAccum refs = do + tl <- depthFirstAccumTypes mempty refs.types + foldM goTerm tl (Set.filter (unseen tl) refs.terms) + + depthFirstAccumTypes :: + TL.TypeLookup Symbol Ann -> + Set TypeReference -> + Sqlite.Transaction (TL.TypeLookup Symbol Ann) + depthFirstAccumTypes tl refs = + foldM goType tl (Set.filter (unseen tl) refs) -- We need the transitive dependencies of data decls -- that are scrutinized in a match expression for -- pattern match coverage checking (specifically for -- the inhabitation check). We ensure these are found -- by collecting all transitive type dependencies. - go tl ref@(Reference.DerivedId id) = + goTerm :: TypeLookup Symbol Ann -> TermReference -> Sqlite.Transaction (TypeLookup Symbol Ann) + goTerm tl ref = getTypeOfTerm codebase ref >>= \case Just typ -> let z = tl <> TypeLookup (Map.singleton ref typ) mempty mempty - in depthFirstAccum z (Type.dependencies typ) - Nothing -> - getTypeDeclaration codebase id >>= \case - Just (Left ed) -> - let z = tl <> TypeLookup mempty mempty (Map.singleton ref ed) - in depthFirstAccum z (DD.typeDependencies $ DD.toDataDecl ed) - Just (Right dd) -> - let z = tl <> TypeLookup mempty (Map.singleton ref dd) mempty - in depthFirstAccum z (DD.typeDependencies dd) - Nothing -> pure tl - go tl Reference.Builtin {} = pure tl -- codebase isn't consulted for builtins + in depthFirstAccumTypes z (Type.dependencies typ) + Nothing -> pure tl + + goType :: TypeLookup Symbol Ann -> TypeReference -> Sqlite.Transaction (TypeLookup Symbol Ann) + goType tl ref@(Reference.DerivedId id) = + getTypeDeclaration codebase id >>= \case + Just (Left ed) -> + let z = tl <> TypeLookup mempty mempty (Map.singleton ref ed) + in depthFirstAccumTypes z (DD.typeDependencies $ DD.toDataDecl ed) + Just (Right dd) -> + let z = tl <> TypeLookup mempty (Map.singleton ref dd) mempty + in depthFirstAccumTypes z (DD.typeDependencies dd) + Nothing -> pure tl + goType tl Reference.Builtin {} = pure tl -- codebase isn't consulted for builtins + unseen :: TL.TypeLookup Symbol a -> Reference -> Bool unseen tl r = isNothing diff --git a/parser-typechecker/src/Unison/Codebase/CodeLookup.hs b/parser-typechecker/src/Unison/Codebase/CodeLookup.hs index bca52cecfb..aad2794519 100644 --- a/parser-typechecker/src/Unison/Codebase/CodeLookup.hs +++ b/parser-typechecker/src/Unison/Codebase/CodeLookup.hs @@ -8,6 +8,7 @@ import Unison.Prelude import Unison.Reference qualified as Reference import Unison.Term (Term) import Unison.Term qualified as Term +import Unison.Util.Defns (Defns (..)) import Unison.Util.Set qualified as Set import Unison.Var (Var) @@ -56,7 +57,7 @@ transitiveDependencies code seen0 rid = getIds = Set.mapMaybe Reference.toId in getTerm code rid >>= \case Just t -> - foldM (transitiveDependencies code) seen (getIds $ Term.dependencies t) + foldM (transitiveDependencies code) seen (getIds $ let deps = Term.dependencies t in deps.terms <> deps.types) Nothing -> getTypeDeclaration code rid >>= \case Nothing -> pure seen diff --git a/parser-typechecker/src/Unison/FileParsers.hs b/parser-typechecker/src/Unison/FileParsers.hs index cc02c9f736..d0673074e0 100644 --- a/parser-typechecker/src/Unison/FileParsers.hs +++ b/parser-typechecker/src/Unison/FileParsers.hs @@ -9,6 +9,7 @@ import Control.Lens import Control.Monad.State (evalStateT) import Data.Foldable qualified as Foldable import Data.List (partition) +import Data.List qualified as List import Data.List.NonEmpty qualified as List.NonEmpty import Data.Map qualified as Map import Data.Sequence qualified as Seq @@ -16,13 +17,14 @@ import Data.Set qualified as Set import Unison.ABT qualified as ABT import Unison.Blank qualified as Blank import Unison.Builtin qualified as Builtin +import Unison.ConstructorReference qualified as ConstructorReference import Unison.Name qualified as Name import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnv.Names qualified as PPE -import Unison.Reference (Reference) +import Unison.Reference (TermReference, TypeReference) import Unison.Referent qualified as Referent import Unison.Result (CompilerBug (..), Note (..), ResultT, pattern Result) import Unison.Result qualified as Result @@ -37,6 +39,7 @@ import Unison.Typechecker.TypeLookup qualified as TL import Unison.UnisonFile (definitionLocation) import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.List qualified as List import Unison.Util.Relation qualified as Rel import Unison.Var (Var) @@ -76,7 +79,7 @@ computeTypecheckingEnvironment :: (Var v, Monad m) => ShouldUseTndr m -> [Type v] -> - (Set Reference -> m (TL.TypeLookup v Ann)) -> + (DefnsF Set TermReference TypeReference -> m (TL.TypeLookup v Ann)) -> UnisonFile v -> m (Typechecker.Env v Ann) computeTypecheckingEnvironment shouldUseTndr ambientAbilities typeLookupf uf = @@ -99,8 +102,15 @@ computeTypecheckingEnvironment shouldUseTndr ambientAbilities typeLookupf uf = let shortname = Name.unsafeParseVar v, name `Name.endsWithReverseSegments` List.NonEmpty.toList (Name.reverseSegments shortname) ] - possibleRefs = Referent.toReference . view _3 <$> possibleDeps - tl <- fmap (UF.declsToTypeLookup uf <>) (typeLookupf (UF.dependencies uf <> Set.fromList possibleRefs)) + possibleRefs = + List.foldl' + ( \acc -> \case + (_, _, Referent.Con ref _) -> acc & over #types (Set.insert (ref ^. ConstructorReference.reference_)) + (_, _, Referent.Ref ref) -> acc & over #terms (Set.insert ref) + ) + (Defns Set.empty Set.empty) + possibleDeps + tl <- fmap (UF.declsToTypeLookup uf <>) (typeLookupf (UF.dependencies uf <> possibleRefs)) -- For populating the TDNR environment, we pick definitions -- from the namespace and from the local file whose full name -- has a suffix that equals one of the free variables in the file. @@ -130,7 +140,7 @@ computeTypecheckingEnvironment shouldUseTndr ambientAbilities typeLookupf uf = ] pure Typechecker.Env - { ambientAbilities = ambientAbilities, + { ambientAbilities, typeLookup = tl, termsByShortname = fqnsByShortName } diff --git a/parser-typechecker/src/Unison/UnisonFile.hs b/parser-typechecker/src/Unison/UnisonFile.hs index 7aaa1f5cd2..785482bac6 100644 --- a/parser-typechecker/src/Unison/UnisonFile.hs +++ b/parser-typechecker/src/Unison/UnisonFile.hs @@ -57,7 +57,7 @@ import Unison.Hashing.V2.Convert qualified as Hashing import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Prelude -import Unison.Reference (Reference) +import Unison.Reference (Reference, TermReference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.Term (Term) @@ -66,6 +66,7 @@ import Unison.Type (Type) import Unison.Type qualified as Type import Unison.Typechecker.TypeLookup qualified as TL import Unison.UnisonFile.Type (TypecheckedUnisonFile (..), UnisonFile (..), pattern TypecheckedUnisonFile, pattern UnisonFile) +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.List qualified as List import Unison.Var (Var) import Unison.Var qualified as Var @@ -84,7 +85,7 @@ emptyUnisonFile = leftBiasedMerge :: forall v a. (Ord v) => UnisonFile v a -> UnisonFile v a -> UnisonFile v a leftBiasedMerge lhs rhs = - let mergedTerms = Map.foldlWithKey' (addNotIn lhsTermNames) (terms lhs) (terms rhs) + let mergedTerms = Map.foldlWithKey' (addNotIn lhsTermNames) lhs.terms rhs.terms mergedWatches = Map.foldlWithKey' addWatch (watches lhs) (watches rhs) mergedDataDecls = Map.foldlWithKey' (addNotIn lhsTypeNames) (dataDeclarationsId lhs) (dataDeclarationsId rhs) mergedEffectDecls = Map.foldlWithKey' (addNotIn lhsTypeNames) (effectDeclarationsId lhs) (effectDeclarationsId rhs) @@ -96,7 +97,7 @@ leftBiasedMerge lhs rhs = } where lhsTermNames = - Map.keysSet (terms lhs) + Map.keysSet lhs.terms <> foldMap (\x -> Set.fromList [v | (v, _, _) <- x]) (watches lhs) lhsTypeNames = @@ -132,7 +133,7 @@ allWatches = join . Map.elems . watches -- | Get the location of a given definition in the file. definitionLocation :: (Var v) => v -> UnisonFile v a -> Maybe a definitionLocation v uf = - terms uf ^? ix v . _1 + uf.terms ^? ix v . _1 <|> watches uf ^? folded . folded . filteredBy (_1 . only v) . _2 <|> dataDeclarations uf ^? ix v . _2 . to DD.annotation <|> effectDeclarations uf ^? ix v . _2 . to (DD.annotation . DD.toDataDecl) @@ -152,7 +153,7 @@ typecheckingTerm uf = termBindings :: UnisonFile v a -> [(v, a, Term v a)] termBindings uf = - Map.foldrWithKey (\k (a, t) b -> (k, a, t) : b) [] (terms uf) + Map.foldrWithKey (\k (a, t) b -> (k, a, t) : b) [] uf.terms -- backwards compatibility with the old data type dataDeclarations' :: TypecheckedUnisonFile v a -> Map v (Reference, DataDeclaration v a) @@ -337,12 +338,20 @@ termSignatureExternalLabeledDependencies -- Returns the dependencies of the `UnisonFile` input. Needed so we can -- load information about these dependencies before starting typechecking. -dependencies :: (Monoid a, Var v) => UnisonFile v a -> Set Reference -dependencies (UnisonFile ds es ts ws) = - foldMap (DD.typeDependencies . snd) ds - <> foldMap (DD.typeDependencies . DD.toDataDecl . snd) es - <> foldMap (Term.dependencies . snd) ts - <> foldMap (foldMap (Term.dependencies . view _3)) ws +dependencies :: (Monoid a, Var v) => UnisonFile v a -> DefnsF Set TermReference TypeReference +dependencies file = + fold + [ Defns + { terms = Set.empty, + types = + Set.unions + [ foldMap (DD.typeDependencies . snd) file.dataDeclarationsId, + foldMap (DD.typeDependencies . DD.toDataDecl . snd) file.effectDeclarationsId + ] + }, + foldMap (Term.dependencies . snd) file.terms, + foldMap (foldMap (Term.dependencies . view _3)) file.watches + ] discardTypes :: (Ord v) => TypecheckedUnisonFile v a -> UnisonFile v a discardTypes (TypecheckedUnisonFileId datas effects terms watches _) = @@ -397,7 +406,7 @@ constructorsForDecls types uf = -- | All bindings in the term namespace: terms, test watches (since those are the only watches that are actually stored -- in the codebase), data constructors, and effect constructors. -termNamespaceBindings :: Ord v => TypecheckedUnisonFile v a -> Set v +termNamespaceBindings :: (Ord v) => TypecheckedUnisonFile v a -> Set v termNamespaceBindings uf = terms <> tests <> datacons <> effcons where @@ -413,7 +422,7 @@ termNamespaceBindings uf = uf.effectDeclarationsId' -- | All bindings in the term namespace: data declarations and effect declarations. -typeNamespaceBindings :: Ord v => TypecheckedUnisonFile v a -> Set v +typeNamespaceBindings :: (Ord v) => TypecheckedUnisonFile v a -> Set v typeNamespaceBindings uf = datas <> effs where diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs index dcb684b168..05b68eedca 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs @@ -40,6 +40,7 @@ import Unison.Typechecker.TypeLookup qualified as TypeLookup import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF +import Unison.Util.Defns (Defns (..)) import Unison.Var qualified as Var handleRun :: Bool -> HQ.HashQualified Name -> [String] -> Cli () @@ -124,7 +125,9 @@ getTerm' mainName = Cli.Env {codebase, runtime} <- ask case Typechecker.fitsScheme ty (Runtime.mainType runtime) of True -> do - typeLookup <- Cli.runTransaction (Codebase.typeLookupForDependencies codebase (Type.dependencies ty)) + typeLookup <- + Cli.runTransaction $ + Codebase.typeLookupForDependencies codebase Defns {terms = Set.empty, types = Type.dependencies ty} f $! synthesizeForce typeLookup ty False -> pure (TermHasBadType ty) in Cli.getLatestTypecheckedFile >>= \case diff --git a/unison-cli/src/Unison/Codebase/Editor/SlurpComponent.hs b/unison-cli/src/Unison/Codebase/Editor/SlurpComponent.hs index 82cc4a862a..3e51fb9aa2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/SlurpComponent.hs +++ b/unison-cli/src/Unison/Codebase/Editor/SlurpComponent.hs @@ -25,21 +25,22 @@ import Data.Set qualified as Set import Data.Tuple (swap) import Unison.DataDeclaration qualified as DD import Unison.Prelude hiding (empty) -import Unison.Reference (Reference) +import Unison.Reference (TypeReference) import Unison.Symbol (Symbol) import Unison.Term qualified as Term import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.UnisonFile qualified as UF +import Unison.Util.Defns (Defns (..)) data SlurpComponent = SlurpComponent { types :: Set Symbol, terms :: Set Symbol, ctors :: Set Symbol } - deriving (Eq, Ord, Show) + deriving (Eq, Generic, Ord, Show) isEmpty :: SlurpComponent -> Bool -isEmpty sc = Set.null (types sc) && Set.null (terms sc) && Set.null (ctors sc) +isEmpty sc = Set.null sc.types && Set.null sc.terms && Set.null sc.ctors empty :: SlurpComponent empty = SlurpComponent {types = Set.empty, terms = Set.empty, ctors = Set.empty} @@ -47,23 +48,23 @@ empty = SlurpComponent {types = Set.empty, terms = Set.empty, ctors = Set.empty} difference :: SlurpComponent -> SlurpComponent -> SlurpComponent difference c1 c2 = SlurpComponent {types = types', terms = terms', ctors = ctors'} where - types' = types c1 `Set.difference` types c2 - terms' = terms c1 `Set.difference` terms c2 - ctors' = ctors c1 `Set.difference` ctors c2 + types' = c1.types `Set.difference` c2.types + terms' = c1.terms `Set.difference` c2.terms + ctors' = c1.ctors `Set.difference` c2.ctors intersection :: SlurpComponent -> SlurpComponent -> SlurpComponent intersection c1 c2 = SlurpComponent {types = types', terms = terms', ctors = ctors'} where - types' = types c1 `Set.intersection` types c2 - terms' = terms c1 `Set.intersection` terms c2 - ctors' = ctors c1 `Set.intersection` ctors c2 + types' = c1.types `Set.intersection` c2.types + terms' = c1.terms `Set.intersection` c2.terms + ctors' = c1.ctors `Set.intersection` c2.ctors instance Semigroup SlurpComponent where c1 <> c2 = SlurpComponent - { types = types c1 <> types c2, - terms = terms c1 <> terms c2, - ctors = ctors c1 <> ctors c2 + { types = c1.types <> c2.types, + terms = c1.terms <> c2.terms, + ctors = c1.ctors <> c2.ctors } instance Monoid SlurpComponent where @@ -79,31 +80,30 @@ closeWithDependencies :: SlurpComponent closeWithDependencies uf inputs = seenDefns {ctors = constructorDeps} where - seenDefns = foldl' termDeps (SlurpComponent {terms = mempty, types = seenTypes, ctors = mempty}) (terms inputs) - seenTypes = foldl' typeDeps mempty (types inputs) + seenDefns = foldl' termDeps (SlurpComponent {terms = mempty, types = seenTypes, ctors = mempty}) inputs.terms + seenTypes = foldl' typeDeps mempty inputs.types constructorDeps :: Set Symbol constructorDeps = UF.constructorsForDecls seenTypes uf termDeps :: SlurpComponent -> Symbol -> SlurpComponent - termDeps seen v | Set.member v (terms seen) = seen - termDeps seen v = fromMaybe seen $ do + termDeps seen v | Set.member v seen.terms = seen + termDeps seen v = fromMaybe seen do term <- findTerm v let -- get the `v`s for the transitive dependency types -- (the ones for terms are just the `freeVars below`) -- although this isn't how you'd do it for a term that's already in codebase tdeps :: [Symbol] - tdeps = resolveTypes $ Term.dependencies term + tdeps = resolveTypes (Term.dependencies term).types seenTypes :: Set Symbol - seenTypes = foldl' typeDeps (types seen) tdeps - seenTerms = Set.insert v (terms seen) + seenTypes = foldl' typeDeps seen.types tdeps + seenTerms = Set.insert v seen.terms pure $ foldl' termDeps ( seen - { types = seenTypes, - terms = seenTerms - } + & #types .~ seenTypes + & #terms .~ seenTerms ) (Term.freeVars term) @@ -115,7 +115,7 @@ closeWithDependencies uf inputs = seenDefns {ctors = constructorDeps} <|> fmap (DD.toDataDecl . snd) (Map.lookup v (UF.effectDeclarations' uf)) pure $ foldl' typeDeps (Set.insert v seen) (resolveTypes $ DD.typeDependencies dd) - resolveTypes :: Set Reference -> [Symbol] + resolveTypes :: Set TypeReference -> [Symbol] resolveTypes rs = [v | r <- Set.toList rs, Just v <- [Map.lookup r typeNames]] findTerm :: Symbol -> Maybe (Term.Term Symbol a) @@ -123,17 +123,17 @@ closeWithDependencies uf inputs = seenDefns {ctors = constructorDeps} allTerms = UF.allTerms uf - typeNames :: Map Reference Symbol + typeNames :: Map TypeReference Symbol typeNames = invert (fst <$> UF.dataDeclarations' uf) <> invert (fst <$> UF.effectDeclarations' uf) invert :: forall k v. (Ord k) => (Ord v) => Map k v -> Map v k invert m = Map.fromList (swap <$> Map.toList m) fromTypes :: Set Symbol -> SlurpComponent -fromTypes vs = mempty {types = vs} +fromTypes vs = SlurpComponent {terms = Set.empty, types = vs, ctors = Set.empty} fromTerms :: Set Symbol -> SlurpComponent -fromTerms vs = mempty {terms = vs} +fromTerms vs = SlurpComponent {terms = vs, types = Set.empty, ctors = Set.empty} fromCtors :: Set Symbol -> SlurpComponent -fromCtors vs = mempty {ctors = vs} +fromCtors vs = SlurpComponent {terms = Set.empty, types = Set.empty, ctors = vs} diff --git a/unison-core/src/Unison/DataDeclaration.hs b/unison-core/src/Unison/DataDeclaration.hs index 513759ac07..0421751c8e 100644 --- a/unison-core/src/Unison/DataDeclaration.hs +++ b/unison-core/src/Unison/DataDeclaration.hs @@ -49,7 +49,7 @@ import Unison.LabeledDependency qualified as LD import Unison.Name qualified as Name import Unison.Names.ResolutionResult qualified as Names import Unison.Prelude -import Unison.Reference (Reference) +import Unison.Reference (Reference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.ReferentPrime qualified as Referent' @@ -222,7 +222,7 @@ bindReferences unsafeVarToName keepFree names (DataDeclaration m a bound constru -- (unless the decl is self-referential) -- Note: Does NOT include the referents for fields and field accessors. -- Those must be computed separately because we need access to the typechecker to do so. -typeDependencies :: (Ord v) => DataDeclaration v a -> Set Reference +typeDependencies :: (Ord v) => DataDeclaration v a -> Set TypeReference typeDependencies dd = Set.unions (Type.dependencies <$> constructorTypes dd) diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index 5a3ea2127a..92cb5ccf31 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -8,6 +8,7 @@ import Control.Monad.State (evalState) import Control.Monad.State qualified as State import Control.Monad.Writer.Strict qualified as Writer import Data.Generics.Sum (_Ctor) +import Data.List qualified as List import Data.Map qualified as Map import Data.Sequence qualified as Sequence import Data.Set qualified as Set @@ -17,6 +18,7 @@ import Text.Show import Unison.ABT qualified as ABT import Unison.Blank qualified as B import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) +import Unison.ConstructorReference qualified as ConstructorReference import Unison.ConstructorType qualified as CT import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.HashQualified qualified as HQ @@ -30,12 +32,13 @@ import Unison.NamesWithHistory qualified as Names import Unison.Pattern (Pattern) import Unison.Pattern qualified as Pattern import Unison.Prelude -import Unison.Reference (Reference, TermReference, pattern Builtin) +import Unison.Reference (Reference, TermReference, TypeReference, pattern Builtin) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Type (Type) import Unison.Type qualified as Type +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.List (multimap, validate) import Unison.Var (Var) import Unison.Var qualified as Var @@ -1211,27 +1214,27 @@ unReqOrCtor (Request' r) = Just r unReqOrCtor _ = Nothing -- Dependencies including referenced data and effect decls -dependencies :: (Ord v, Ord vt) => Term2 vt at ap v a -> Set Reference -dependencies t = Set.map (LD.fold id Referent.toReference) (labeledDependencies t) +dependencies :: (Ord v, Ord vt) => Term2 vt at ap v a -> DefnsF Set TermReference TypeReference +dependencies = + List.foldl' f (Defns Set.empty Set.empty) . Set.toList . labeledDependencies + where + f :: + DefnsF Set TermReference TypeReference -> + LabeledDependency -> + DefnsF Set TermReference TypeReference + f deps = \case + LD.TermReferent (Referent.Con ref _) -> deps & over #types (Set.insert (ref ^. ConstructorReference.reference_)) + LD.TermReferent (Referent.Ref ref) -> deps & over #terms (Set.insert ref) + LD.TypeReference ref -> deps & over #types (Set.insert ref) termDependencies :: (Ord v, Ord vt) => Term2 vt at ap v a -> Set TermReference termDependencies = - Set.fromList - . mapMaybe - ( LD.fold - (\_typeRef -> Nothing) - ( Referent.fold - (\termRef -> Just termRef) - (\_typeConRef _i _ct -> Nothing) - ) - ) - . toList - . labeledDependencies + (.terms) . dependencies -- gets types from annotations and constructors typeDependencies :: (Ord v, Ord vt) => Term2 vt at ap v a -> Set Reference typeDependencies = - Set.fromList . mapMaybe (LD.fold Just (const Nothing)) . toList . labeledDependencies + (.types) . dependencies -- Gets the types to which this term contains references via patterns and -- data constructors. diff --git a/unison-merge/src/Unison/Merge/Mergeblob4.hs b/unison-merge/src/Unison/Merge/Mergeblob4.hs index b7229c766f..3a72e4c854 100644 --- a/unison-merge/src/Unison/Merge/Mergeblob4.hs +++ b/unison-merge/src/Unison/Merge/Mergeblob4.hs @@ -10,18 +10,18 @@ import Unison.Names (Names (..)) import Unison.Parser.Ann (Ann) import Unison.Parsers qualified as Parsers import Unison.Prelude -import Unison.Reference (Reference) +import Unison.Reference (TermReference, TypeReference) import Unison.Symbol (Symbol) import Unison.Syntax.Parser (ParsingEnv (..)) import Unison.Syntax.Parser qualified as Parser import Unison.UnisonFile (UnisonFile) import Unison.UnisonFile qualified as UnisonFile -import Unison.Util.Defns (Defns (..)) +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation qualified as Relation data Mergeblob4 = Mergeblob4 - { dependencies :: Set Reference, + { dependencies :: DefnsF Set TermReference TypeReference, file :: UnisonFile Symbol Ann } From 725ee3b6d5919c0381b9844b0af68dab5ba589e1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Thu, 15 Aug 2024 14:59:44 -0400 Subject: [PATCH 581/631] Modify infix printer --- .../src/Unison/Syntax/Precedence.hs | 27 +++++ .../src/Unison/Syntax/TermParser.hs | 22 +--- .../src/Unison/Syntax/TermPrinter.hs | 101 +++++++++++------- unison-core/src/Unison/Term.hs | 22 +++- 4 files changed, 113 insertions(+), 59 deletions(-) create mode 100644 parser-typechecker/src/Unison/Syntax/Precedence.hs diff --git a/parser-typechecker/src/Unison/Syntax/Precedence.hs b/parser-typechecker/src/Unison/Syntax/Precedence.hs new file mode 100644 index 0000000000..11c2e20cc5 --- /dev/null +++ b/parser-typechecker/src/Unison/Syntax/Precedence.hs @@ -0,0 +1,27 @@ +module Unison.Syntax.Precedence where + +import Data.Map qualified as Map +import Unison.Prelude + +-- Precedence rules for infix operators. +-- Lower number means higher precedence (tighter binding). +-- Operators not in this list have no precedence and will simply be parsed +-- left-to-right. +precedenceRules :: Map Text Int +precedenceRules = + Map.fromList $ zip levels [0 ..] >>= \(ops, prec) -> map (,prec) ops + +levels :: [[Text]] +levels = + [ ["*", "/", "%"], + ["+", "-"], + ["<", ">", ">=", "<="], + ["==", "!==", "!=", "==="], + ["&&", "&"], + ["^", "^^"], + ["||", "|"] + ] + +-- | Returns the precedence of an infix operator, if it has one. +precedence :: Text -> Maybe Int +precedence op = Map.lookup op precedenceRules diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 48f1a3fd92..acefbdadd6 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -20,7 +20,6 @@ import Data.List qualified as List import Data.List.Extra qualified as List.Extra import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as NonEmpty -import Data.Map qualified as Map import Data.Maybe qualified as Maybe import Data.Sequence qualified as Sequence import Data.Set qualified as Set @@ -55,6 +54,7 @@ import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser hiding (seq) import Unison.Syntax.Parser qualified as Parser (seq, uniqueName) import Unison.Syntax.Parser.Doc.Data qualified as Doc +import Unison.Syntax.Precedence (precedence) import Unison.Syntax.TypeParser qualified as TypeParser import Unison.Term (IsTop, Term) import Unison.Term qualified as Term @@ -77,25 +77,6 @@ identifiers that may contain operator characters (like empty? or fold-left). Sections / partial application of infix operators is not implemented. -} --- Precedence rules for infix operators. --- Lower number means higher precedence (tighter binding). --- Operators not in this list have no precedence and will simply be parsed --- left-to-right. -precedenceRules :: Map Text Int -precedenceRules = - Map.fromList $ - zip - [ ["*", "/", "%"], - ["+", "-"], - ["<", ">", ">=", "<="], - ["==", "!==", "!=", "==="], - ["&&", "&"], - ["^", "^^"], - ["||", "|"] - ] - [0 ..] - >>= \(ops, prec) -> map (,prec) ops - type TermP v m = P v m (Term v Ann) term :: (Monad m, Var v) => TermP v m @@ -1123,7 +1104,6 @@ infixAppOrBooleanOp = do | shouldRotate (precedence "||") (precedence op) -> InfixOr lop ll (fixUp (ctor lr rhs)) _ -> ctor lhs rhs - precedence op = Map.lookup op precedenceRules unqualified t = Maybe.fromJust $ NameSegment.toEscapedText . Name.lastSegment <$> (HQ.toName $ L.payload t) applyInfixOps :: InfixParse v -> Term v Ann applyInfixOps t = case t of diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index 5c41701bf8..e3a206fa7f 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -55,6 +55,7 @@ import Unison.Syntax.Lexer.Unison (showEscapeChar) import Unison.Syntax.Name qualified as Name (isSymboly, parseText, parseTextEither, toText, unsafeParseText) import Unison.Syntax.NamePrinter (styleHashQualified'') import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText) +import Unison.Syntax.Precedence qualified as Precedence import Unison.Syntax.TypePrinter qualified as TypePrinter import Unison.Term import Unison.Type (Type, pattern ForallsNamed') @@ -416,6 +417,13 @@ pretty0 Ref' r -> isSymbolic $ PrettyPrintEnv.termName n (Referent.Ref r) Var' v -> isSymbolic $ HQ.unsafeFromVar v _ -> False + termPrecedence :: Term3 v PrintAnnotation -> Maybe Int + termPrecedence = \case + Ref' r -> + HQ.toName (PrettyPrintEnv.termName n (Referent.Ref r)) + >>= Precedence.precedence . NameSegment.toEscapedText . Name.lastSegment + Var' v -> HQ.toName (HQ.unsafeFromVar v) >>= Precedence.precedence . NameSegment.toEscapedText . Name.lastSegment + _ -> Nothing case (term, binaryOpsPred) of (DD.Doc, _) | doc == MaybeDoc -> @@ -460,10 +468,31 @@ pretty0 PP.hang kw <$> fmap PP.lines (traverse go rs) (Bytes' bs, _) -> pure $ PP.group $ fmt S.BytesLiteral "0xs" <> PP.shown (Bytes.fromWord8s (map fromIntegral bs)) - BinaryAppsPred' apps lastArg -> do - prettyLast <- pretty0 (ac 3 Normal im doc) lastArg - prettyApps <- binaryApps apps prettyLast - pure $ paren (p >= 3) prettyApps + BinaryAppPred' f a b -> do + let prec = fmap ((-) 9) $ termPrecedence f + prettyF <- pretty0 (AmbientContext 10 Normal Infix im doc False) f + prettyA <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) a + prettyB <- pretty0 (ac (fromMaybe (length Precedence.levels + 3) prec) Normal im doc) b + pure . paren (p > fromMaybe 3 prec) $ + PP.group (prettyA <> PP.softbreak <> prettyF) `PP.hang` prettyB + (And' a b, _) -> do + let prec = fmap ((-) 9) $ Precedence.precedence "&&" + prettyF = fmt S.ControlKeyword "&&" + prettyA <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) a + prettyB <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) b + pure . paren (maybe False (p >) prec) $ + PP.group (prettyA <> PP.softbreak <> prettyF) `PP.hang` prettyB + (Or' a b, _) -> do + let prec = fmap ((-) 9) $ Precedence.precedence "||" + prettyF = fmt S.ControlKeyword "||" + prettyA <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) a + prettyB <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) b + pure . paren (maybe False (p >) prec) $ + PP.group (prettyA <> PP.softbreak <> prettyF) `PP.hang` prettyB + -- BinaryAppsPred' apps lastArg -> do + -- prettyLast <- pretty0 (ac 3 Normal im doc) lastArg + -- prettyApps <- binaryApps apps prettyLast + -- pure $ paren (p >= 3) prettyApps -- Note that && and || are at the same precedence, which can cause -- confusion, so for clarity we do not want to elide the parentheses in a -- case like `(x || y) && z`. @@ -499,14 +528,14 @@ pretty0 let softTab = PP.softbreak <> ("" `PP.orElse` " ") pure . paren (p >= 3) $ PP.group (PP.group (PP.group (PP.sep softTab (fun : args') <> softTab)) <> lastArg') - (Ands' xs lastArg, _) -> - paren (p >= 10) <$> do - lastArg' <- pretty0 (ac 10 Normal im doc) lastArg - booleanOps (fmt S.ControlKeyword "&&") xs lastArg' - (Ors' xs lastArg, _) -> - paren (p >= 10) <$> do - lastArg' <- pretty0 (ac 10 Normal im doc) lastArg - booleanOps (fmt S.ControlKeyword "||") xs lastArg' + -- (Ands' xs lastArg, _) -> + -- paren (p >= 10) <$> do + -- lastArg' <- pretty0 (ac 10 Normal im doc) lastArg + -- booleanOps (fmt S.ControlKeyword "&&") xs lastArg' + -- (Ors' xs lastArg, _) -> + -- paren (p >= 10) <$> do + -- lastArg' <- pretty0 (ac 10 Normal im doc) lastArg + -- booleanOps (fmt S.ControlKeyword "||") xs lastArg' _other -> case (term, nonForcePred) of OverappliedBinaryAppPred' f a b r | binaryOpsPred f -> @@ -600,30 +629,30 @@ pretty0 pretty0 (AmbientContext 10 Normal Infix im doc False) f ] - -- Render sequence of infix &&s or ||s, like [x2, x1], - -- meaning (x1 && x2) && (x3 rendered by the caller), producing - -- "x1 && x2 &&". The result is built from the right. - booleanOps :: - Pretty SyntaxText -> - [Term3 v PrintAnnotation] -> - Pretty SyntaxText -> - m (Pretty SyntaxText) - booleanOps op xs last = do - ps <- join <$> traverse r (reverse xs) - let unbroken = PP.spaced (ps <> [last]) - broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last] - pure (unbroken `PP.orElse` broken) - where - psCols ps = case take 2 ps of - [x, y] -> (x, y) : psCols (drop 2 ps) - [x] -> [(x, "")] - [] -> [] - _ -> undefined - r a = - sequence - [ pretty0 (ac (if isBlock a then 12 else 10) Normal im doc) a, - pure op - ] +-- -- Render sequence of infix &&s or ||s, like [x2, x1], +-- -- meaning (x1 && x2) && (x3 rendered by the caller), producing +-- -- "x1 && x2 &&". The result is built from the right. +-- booleanOps :: +-- Pretty SyntaxText -> +-- [Term3 v PrintAnnotation] -> +-- Pretty SyntaxText -> +-- m (Pretty SyntaxText) +-- booleanOps op xs last = do +-- ps <- join <$> traverse r (reverse xs) +-- let unbroken = PP.spaced (ps <> [last]) +-- broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last] +-- pure (unbroken `PP.orElse` broken) +-- where +-- psCols ps = case take 2 ps of +-- [x, y] -> (x, y) : psCols (drop 2 ps) +-- [x] -> [(x, "")] +-- [] -> [] +-- _ -> undefined +-- r a = +-- sequence +-- [ pretty0 (ac (if isBlock a then 12 else 10) Normal im doc) a, +-- pure op +-- ] prettyPattern :: forall v loc. diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index 5a3ea2127a..d4f082cbfb 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -599,6 +599,13 @@ pattern BinaryAppsPred' :: (Term2 vt at ap v a, Term2 vt at ap v a -> Bool) pattern BinaryAppsPred' apps lastArg <- (unBinaryAppsPred -> Just (apps, lastArg)) +pattern BinaryAppPred' :: + Term2 vt at ap v a -> + Term2 vt at ap v a -> + Term2 vt at ap v a -> + (Term2 vt at ap v a, Term2 vt at ap v a -> Bool) +pattern BinaryAppPred' f arg1 arg2 <- (unBinaryAppPred -> Just (f, arg1, arg2)) + pattern OverappliedBinaryAppPred' :: Term2 vt at ap v a -> Term2 vt at ap v a -> @@ -1165,12 +1172,23 @@ unBinaryAppsPred :: ], Term2 vt at ap v a ) -unBinaryAppsPred (t, pred) = case unBinaryApp t of - Just (f, x, y) | pred f -> case unBinaryAppsPred (x, pred) of +unBinaryAppsPred (t, pred) = case unBinaryAppPred (t, pred) of + Just (f, x, y) -> case unBinaryAppsPred (x, pred) of Just (as, xLast) -> Just ((xLast, f) : as, y) Nothing -> Just ([(x, f)], y) _ -> Nothing +unBinaryAppPred :: + (Term2 vt at ap v a, Term2 vt at ap v a -> Bool) -> + Maybe + ( Term2 vt at ap v a, + Term2 vt at ap v a, + Term2 vt at ap v a + ) +unBinaryAppPred (t, pred) = case unBinaryApp t of + Just (f, x, y) | pred f -> Just (f, x, y) + _ -> Nothing + unLams' :: Term2 vt at ap v a -> Maybe ([v], Term2 vt at ap v a) unLams' t = unLamsPred' (t, const True) From 50429143d1e866b5fbbac7471720fa94dec6298b Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 15 Aug 2024 18:41:16 -0600 Subject: [PATCH 582/631] Add a failing transcript for #2822 --- unison-src/transcripts/fix2822.md | 53 ++++++++++++++++++++++++ unison-src/transcripts/fix2822.output.md | 49 ++++++++++++++++++++++ 2 files changed, 102 insertions(+) create mode 100644 unison-src/transcripts/fix2822.md create mode 100644 unison-src/transcripts/fix2822.output.md diff --git a/unison-src/transcripts/fix2822.md b/unison-src/transcripts/fix2822.md new file mode 100644 index 0000000000..e2d414b629 --- /dev/null +++ b/unison-src/transcripts/fix2822.md @@ -0,0 +1,53 @@ +# Inability to reference a term or type with a name that has segments starting with an underscore + +```ucm:hide +scratch/main> builtins.mergeio +``` + +There should be no issue having terms with an underscore-led component + +```unison +_a.blah = 2 + +b = _a.blah + 1 +``` + +Or even that _are_ a single “blank” component + +```unison +_b = 2 + +x = _b + 1 +``` +Types can also have underscore-led components. + +```unison +unique type _a.Blah = A + +c : _a.Blah +c = A +``` + +And we should also be able to access underscore-led fields. + +```unison +type Hello = {_value : Nat} + +doStuff = _value.modify +``` + +But pattern matching shouldn’t bind to underscore-led names. + +```unison:error +dontMap f = cases + None -> false + Some _used -> f _used +``` + +But we can use them as unbound patterns. + +```unison +dontMap f = cases + None -> false + Some _unused -> f 2 +``` diff --git a/unison-src/transcripts/fix2822.output.md b/unison-src/transcripts/fix2822.output.md new file mode 100644 index 0000000000..adb2889095 --- /dev/null +++ b/unison-src/transcripts/fix2822.output.md @@ -0,0 +1,49 @@ +# Inability to reference a term or type with a name that has segments starting with an underscore + +There should be no issue having terms with an underscore-led component + +``` unison +_a.blah = 2 + +b = _a.blah + 1 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I couldn't figure out what .blah refers to here: + + 3 | b = _a.blah + 1 + + I also don't know what type it should be. + + Some common causes of this error include: + * Your current namespace is too deep to contain the + definition in its subtree + * The definition is part of a library which hasn't been + added to this project + * You have a typo in the name + +``` + + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + + + I couldn't figure out what .blah refers to here: + + 3 | b = _a.blah + 1 + + I also don't know what type it should be. + + Some common causes of this error include: + * Your current namespace is too deep to contain the + definition in its subtree + * The definition is part of a library which hasn't been + added to this project + * You have a typo in the name + From ebda5ae6e3970337f95101aad0c8d55b52d931d3 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 15 Aug 2024 19:02:33 -0600 Subject: [PATCH 583/631] =?UTF-8?q?Change=20handling=20of=20=E2=80=9Cblank?= =?UTF-8?q?=E2=80=9D=20identifiers?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Previously, they were tokenized separately from other identifiers, but then most handling checked both tokens anyway. This now always parses “blanks” as normal identifiers and checks their blankness at the few places we care about it. There were two places that treated `Blank` differently than `WordyId`, and those are preserved. There were also two places where `Blank ""` (`_`) was treated differently than `Blank n` (`_withSomeSuffix`), and those have been eliminated. Fixes #2822. --- unison-core/src/Unison/Name.hs | 6 + unison-src/transcripts/fix2822.output.md | 118 ++++++++++++++++-- .../src/Unison/Syntax/Lexer/Unison.hs | 52 ++++---- unison-syntax/src/Unison/Syntax/Parser.hs | 24 ++-- 4 files changed, 151 insertions(+), 49 deletions(-) diff --git a/unison-core/src/Unison/Name.hs b/unison-core/src/Unison/Name.hs index 371a567e66..0bbe9ba4a8 100644 --- a/unison-core/src/Unison/Name.hs +++ b/unison-core/src/Unison/Name.hs @@ -32,6 +32,7 @@ module Unison.Name parent, stripNamePrefix, unqualified, + isUnqualified, -- * To organize later commonPrefix, @@ -504,6 +505,11 @@ unqualified :: Name -> Name unqualified (Name _ (s :| _)) = Name Relative (s :| []) +isUnqualified :: Name -> Bool +isUnqualified = \case + Name Relative (_ :| []) -> True + Name _ (_ :| _) -> False + -- Tries to shorten `fqn` to the smallest suffix that still unambiguously refers to the same name. Uses an efficient -- logarithmic lookup in the provided relation. -- diff --git a/unison-src/transcripts/fix2822.output.md b/unison-src/transcripts/fix2822.output.md index adb2889095..08f321eaad 100644 --- a/unison-src/transcripts/fix2822.output.md +++ b/unison-src/transcripts/fix2822.output.md @@ -12,31 +12,101 @@ b = _a.blah + 1 Loading changes detected in scratch.u. - I couldn't figure out what .blah refers to here: + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: - 3 | b = _a.blah + 1 + ⍟ These new definitions are ok to `add`: + + _a.blah : Nat + b : Nat + +``` +Or even that *are* a single “blank” component + +``` unison +_b = 2 + +x = _b + 1 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: - I also don't know what type it should be. + ⍟ These new definitions are ok to `add`: + + _b : Nat + x : Nat + +``` +Types can also have underscore-led components. + +``` unison +unique type _a.Blah = A + +c : _a.Blah +c = A +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: - Some common causes of this error include: - * Your current namespace is too deep to contain the - definition in its subtree - * The definition is part of a library which hasn't been - added to this project - * You have a typo in the name + ⍟ These new definitions are ok to `add`: + + type _a.Blah + c : Blah ``` +And we should also be able to access underscore-led fields. + +``` unison +type Hello = {_value : Nat} + +doStuff = _value.modify +``` + +``` ucm + Loading changes detected in scratch.u. + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type Hello + Hello._value : Hello -> Nat + Hello._value.modify : (Nat ->{g} Nat) -> Hello ->{g} Hello + Hello._value.set : Nat -> Hello -> Hello + doStuff : (Nat ->{g} Nat) -> Hello ->{g} Hello -🛑 +``` +But pattern matching shouldn’t bind to underscore-led names. -The transcript failed due to an error in the stanza above. The error is: +``` unison +dontMap f = cases + None -> false + Some _used -> f _used +``` +``` ucm - I couldn't figure out what .blah refers to here: + Loading changes detected in scratch.u. + + I couldn't figure out what _used refers to here: - 3 | b = _a.blah + 1 + 3 | Some _used -> f _used I also don't know what type it should be. @@ -47,3 +117,25 @@ The transcript failed due to an error in the stanza above. The error is: added to this project * You have a typo in the name +``` +But we can use them as unbound patterns. + +``` unison +dontMap f = cases + None -> false + Some _unused -> f 2 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + dontMap : (Nat ->{g} Boolean) -> Optional a ->{g} Boolean + +``` diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs index c641786505..9063852f73 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -25,6 +25,7 @@ module Unison.Syntax.Lexer.Unison ) where +import Data.Functor.Classes (Show1 (..)) import Control.Lens qualified as Lens import Control.Monad.State qualified as S import Data.Char (isAlphaNum, isDigit, isSpace, ord, toLower) @@ -46,9 +47,7 @@ import U.Codebase.Reference (ReferenceType (..)) import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment (docSegment) -import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH @@ -56,7 +55,7 @@ import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) import Unison.Syntax.Lexer import Unison.Syntax.Lexer.Token (posP, tokenP) import Unison.Syntax.Name qualified as Name (isSymboly, nameP, toText, unsafeParseText) -import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..), wordyP) +import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..)) import Unison.Syntax.Parser.Doc qualified as Doc import Unison.Syntax.Parser.Doc.Data qualified as Doc import Unison.Syntax.ReservedWords (delimiters, typeModifiers, typeOrAbility) @@ -105,18 +104,28 @@ data Err -- further knowledge of spacing or indentation levels -- any knowledge of comments data Lexeme - = Open String -- start of a block - | Semi IsVirtual -- separator between elements of a block - | Close -- end of a block - | Reserved String -- reserved tokens such as `{`, `(`, `type`, `of`, etc - | Textual String -- text literals, `"foo bar"` - | Character Char -- character literals, `?X` - | WordyId (HQ'.HashQualified Name) -- a (non-infix) identifier. invariant: last segment is wordy - | SymbolyId (HQ'.HashQualified Name) -- an infix identifier. invariant: last segment is symboly - | Blank String -- a typed hole or placeholder - | Numeric String -- numeric literals, left unparsed - | Bytes Bytes.Bytes -- bytes literals - | Hash ShortHash -- hash literals + = -- | start of a block + Open String + | -- | separator between elements of a block + Semi IsVirtual + | -- | end of a block + Close + | -- | reserved tokens such as `{`, `(`, `type`, `of`, etc + Reserved String + | -- | text literals, `"foo bar"` + Textual String + | -- | character literals, `?X` + Character Char + | -- | a (non-infix) identifier. invariant: last segment is wordy + WordyId (HQ'.HashQualified Name) + | -- | an infix identifier. invariant: last segment is symboly + SymbolyId (HQ'.HashQualified Name) + | -- | numeric literals, left unparsed + Numeric String + | -- | bytes literals + Bytes Bytes.Bytes + | -- | hash literals + Hash ShortHash | Err Err | Doc (Doc.UntitledSection (Doc.Tree (ReferenceType, HQ'.HashQualified Name) [Token Lexeme])) deriving stock (Eq, Show, Ord) @@ -330,7 +339,6 @@ displayLexeme = \case Character c -> "?" <> [c] WordyId hq -> Text.unpack (HQ'.toTextWith Name.toText hq) SymbolyId hq -> Text.unpack (HQ'.toTextWith Name.toText hq) - Blank b -> b Numeric n -> n Bytes _b -> "bytes literal" Hash h -> Text.unpack (SH.toText h) @@ -436,7 +444,6 @@ lexemes eof = <|> token numeric <|> token character <|> reserved - <|> token blank <|> token identifierLexemeP <|> (asum . map token) [semi, textual, hash] @@ -469,12 +476,6 @@ lexemes eof = t <- tok identifierLexemeP pure $ (fmap Reserved <$> typ) <> t - blank = - separated wordySep do - _ <- char '_' - seg <- P.optional wordyIdSegP - pure (Blank (maybe "" (Text.unpack . NameSegment.toUnescapedText) seg)) - semi = char ';' $> Semi False textual = Textual <$> quoted quoted = quotedRaw <|> quotedSingleLine @@ -757,10 +758,6 @@ identifierLexeme name = then SymbolyId name else WordyId name -wordyIdSegP :: P.ParsecT (Token Err) String m NameSegment -wordyIdSegP = - PI.withParsecT (fmap (ReservedWordyId . Text.unpack)) NameSegment.wordyP - shortHashP :: P.ParsecT (Token Err) String m ShortHash shortHashP = PI.withParsecT (fmap (InvalidShortHash . Text.unpack)) ShortHash.shortHashP @@ -990,7 +987,6 @@ instance P.VisualStream [Token Lexeme] where Nothing -> '?' : [c] pretty (WordyId n) = Text.unpack (HQ'.toText n) pretty (SymbolyId n) = Text.unpack (HQ'.toText n) - pretty (Blank s) = "_" ++ s pretty (Numeric n) = n pretty (Hash sh) = show sh pretty (Err e) = show e diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 1ac87e8eb2..e25cd05bfd 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -81,6 +81,8 @@ import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' import Unison.Hashable qualified as Hashable import Unison.Name as Name +import Unison.NameSegment (NameSegment) +import Unison.NameSegment.Internal qualified as INameSegment import Unison.Names (Names) import Unison.Names.ResolutionResult qualified as Names import Unison.Parser.Ann (Ann (..), Annotated (..)) @@ -90,7 +92,7 @@ import Unison.Prelude import Unison.Reference (Reference) import Unison.Referent (Referent) import Unison.Syntax.Lexer.Unison qualified as L -import Unison.Syntax.Name qualified as Name (toVar, unsafeParseText) +import Unison.Syntax.Name qualified as Name (toVar) import Unison.Syntax.Parser.Doc qualified as Doc import Unison.Syntax.Parser.Doc.Data qualified as Doc import Unison.Term (MatchCase (..)) @@ -279,9 +281,19 @@ closeBlock = void <$> matchToken L.Close optionalCloseBlock :: (Ord v) => P v m (L.Token ()) optionalCloseBlock = closeBlock <|> (\() -> L.Token () mempty mempty) <$> P.eof +-- | A `Name` is blank when it is unqualified and begins with a `_` (also implying that it is wordy) +isBlank :: Name -> Bool +isBlank n = Name.isUnqualified n && Text.isPrefixOf "_" (INameSegment.toUnescapedText $ Name.lastSegment n) + +-- | A HQ Name is blank when its Name is blank and it has no hash. +isBlank' :: HQ'.HashQualified Name -> Bool +isBlank' = \case + HQ'.NameOnly n -> isBlank n + HQ'.HashQualified _ _ -> False + wordyPatternName :: (Var v) => P v m (L.Token v) wordyPatternName = queryToken \case - L.WordyId (HQ'.NameOnly n) -> Just $ Name.toVar n + L.WordyId (HQ'.NameOnly n) -> if isBlank n then Nothing else Just $ Name.toVar n _ -> Nothing -- | Parse a prefix identifier e.g. Foo or (+), discarding any hash @@ -296,7 +308,6 @@ prefixTermName = wordyTermName <|> parenthesize symbolyTermName where wordyTermName = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just $ Name.toVar n - L.Blank s -> Just $ Var.nameds ("_" <> s) _ -> Nothing symbolyTermName = queryToken \case L.SymbolyId (HQ'.NameOnly n) -> Just $ Name.toVar n @@ -306,14 +317,12 @@ prefixTermName = wordyTermName <|> parenthesize symbolyTermName wordyDefinitionName :: (Var v) => P v m (L.Token v) wordyDefinitionName = queryToken $ \case L.WordyId n -> Just $ Name.toVar (HQ'.toName n) - L.Blank s -> Just $ Var.nameds ("_" <> s) _ -> Nothing -- | Parse a wordyId as a Name, rejecting any hash importWordyId :: (Ord v) => P v m (L.Token Name) importWordyId = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just n - L.Blank s | not (null s) -> Just $ Name.unsafeParseText (Text.pack ("_" <> s)) _ -> Nothing -- | The `+` in: use Foo.bar + as a Name @@ -348,7 +357,6 @@ hqWordyId_ :: (Ord v) => P v m (L.Token (HQ.HashQualified Name)) hqWordyId_ = queryToken \case L.WordyId n -> Just $ HQ'.toHQ n L.Hash h -> Just $ HQ.HashOnly h - L.Blank s | not (null s) -> Just $ HQ.NameOnly (Name.unsafeParseText (Text.pack ("_" <> s))) _ -> Nothing -- | Parse a hash-qualified symboly ID like >>=#foo or && @@ -365,10 +373,10 @@ reserved w = label w $ queryToken getReserved getReserved _ = Nothing -- | Parse a placeholder or typed hole -blank :: (Ord v) => P v m (L.Token String) +blank :: (Ord v) => P v m (L.Token NameSegment) blank = label "blank" $ queryToken getBlank where - getBlank (L.Blank s) = Just ('_' : s) + getBlank (L.WordyId n) = if isBlank' n then Just (Name.lastSegment $ HQ'.toName n) else Nothing getBlank _ = Nothing numeric :: (Ord v) => P v m (L.Token String) From eff07ae66278c4ab78ac560753bca088d7bbf3a2 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 15 Aug 2024 19:05:20 -0600 Subject: [PATCH 584/631] Improve the `Show (BlockTree a)` instance MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This makes it much easier to read the output when debugging the lexer. And it should be `Read`-compatible.. There’s still room for improvement, though: ```haskell Block (Open "scratch.u") [ [ Leaf (WordyId (NameOnly (Name Relative (NameSegment {toUnescapedText = "dontMap"} :| [])))), Leaf (WordyId (NameOnly (Name Relative (NameSegment {toUnescapedText = "f"} :| [])))), Block (Open "=") [ [ Block (Open "cases") [ [ Leaf (WordyId (NameOnly (Name Relative (NameSegment {toUnescapedText = "None"} :| [])))), Block (Open "->") [ [ Leaf (Reserved "false"), ], ] (Just Close), Leaf (Semi True), ], [ Leaf (WordyId (NameOnly (Name Relative (NameSegment {toUnescapedText = "Some"} :| [])))), Leaf (WordyId (NameOnly (Name Relative (NameSegment {toUnescapedText = "_unused"} :| [])))), Block (Open "->") [ [ Leaf (WordyId (NameOnly (Name Relative (NameSegment {toUnescapedText = "f"} :| [])))), Leaf (Numeric "2"), ], ] (Just Close), ], ] (Just Close), ], ] (Just Close), ], ] (Just Close) ``` --- .../src/Unison/Syntax/Lexer/Unison.hs | 41 ++++++++++++++----- unison-syntax/src/Unison/Syntax/Parser.hs | 4 +- 2 files changed, 32 insertions(+), 13 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs index 9063852f73..042e5bd3b9 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -25,11 +25,11 @@ module Unison.Syntax.Lexer.Unison ) where -import Data.Functor.Classes (Show1 (..)) import Control.Lens qualified as Lens import Control.Monad.State qualified as S import Data.Char (isAlphaNum, isDigit, isSpace, ord, toLower) import Data.Foldable qualified as Foldable +import Data.Functor.Classes (Show1 (..), showsPrec1) import Data.List qualified as List import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as Nel @@ -834,17 +834,36 @@ headToken (Block a _ _) = a headToken (Leaf a) = a instance (Show a) => Show (BlockTree a) where - show (Leaf a) = show a - show (Block open mid close) = - show open - ++ "\n" - ++ indent " " (intercalateMap "\n" (intercalateMap " " show) mid) - ++ "\n" - ++ maybe "" show close + showsPrec = showsPrec1 + +-- | This instance should be compatible with `Read`, but inserts newlines and indentation to make it more +-- /human/-readable. +instance Show1 BlockTree where + liftShowsPrec spa sla = shows "" where - indent by s = by ++ (s >>= go by) - go by '\n' = '\n' : by - go _ c = [c] + shows by prec = + showParen (prec > appPrec) . \case + Leaf a -> showString "Leaf " . showsNext spa "" a + Block open mid close -> + showString "Block " + . showsNext spa "" open + . showString "\n" + . showIndentedList (showIndentedList (\b -> showsIndented (shows b 0) b)) (" " <> by) mid + . showString "\n" + . showsNext (liftShowsPrec spa sla) (" " <> by) close + appPrec = 10 + showsNext :: (Int -> x -> ShowS) -> String -> x -> ShowS + showsNext fn = showsIndented (fn $ appPrec + 1) + showsIndented :: (x -> ShowS) -> String -> x -> ShowS + showsIndented fn by x = showString by . fn x + showIndentedList :: (String -> x -> ShowS) -> String -> [x] -> ShowS + showIndentedList fn by xs = + showString by + . showString "[" + . foldr (\x acc -> showString "\n" . fn (" " <> by) x . showString "," . acc) id xs + . showString "\n" + . showString by + . showString "]" reorderTree :: ([[BlockTree a]] -> [[BlockTree a]]) -> BlockTree a -> BlockTree a reorderTree f (Block open mid close) = Block open (f (fmap (reorderTree f) <$> mid)) close diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index e25cd05bfd..0cecdc60f1 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -288,8 +288,8 @@ isBlank n = Name.isUnqualified n && Text.isPrefixOf "_" (INameSegment.toUnescape -- | A HQ Name is blank when its Name is blank and it has no hash. isBlank' :: HQ'.HashQualified Name -> Bool isBlank' = \case - HQ'.NameOnly n -> isBlank n - HQ'.HashQualified _ _ -> False + HQ'.NameOnly n -> isBlank n + HQ'.HashQualified _ _ -> False wordyPatternName :: (Var v) => P v m (L.Token v) wordyPatternName = queryToken \case From d43288a1e228bc6a6d476e6297073be50bcabd2b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Fri, 16 Aug 2024 13:10:45 -0400 Subject: [PATCH 585/631] Adapt old infix printer to new rules --- .../src/Unison/Syntax/TermPrinter.hs | 136 ++++++++++++------ 1 file changed, 96 insertions(+), 40 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index e3a206fa7f..83ff71519d 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -417,6 +417,9 @@ pretty0 Ref' r -> isSymbolic $ PrettyPrintEnv.termName n (Referent.Ref r) Var' v -> isSymbolic $ HQ.unsafeFromVar v _ -> False + -- Gets the raw precedence of a term, if it has one. + -- A lower number here means tighter binding. + -- These precedences range from 0 to 6. termPrecedence :: Term3 v PrintAnnotation -> Maybe Int termPrecedence = \case Ref' r -> @@ -424,6 +427,73 @@ pretty0 >>= Precedence.precedence . NameSegment.toEscapedText . Name.lastSegment Var' v -> HQ.toName (HQ.unsafeFromVar v) >>= Precedence.precedence . NameSegment.toEscapedText . Name.lastSegment _ -> Nothing + -- Gets the pretty-printer precedence of a term, if it has one. + -- A higher number here means tighter binding. + -- Precedences 3 through 9 are used for infix operators. + -- We get this number by subtracting the raw precedence from 9. + infixPrecedence = fmap ((length Precedence.levels + 2) -) . termPrecedence + unBinaryAppsPred' :: + ( Term3 v PrintAnnotation, + Term3 v PrintAnnotation -> Bool + ) -> + Maybe + ( [ ( Term3 v PrintAnnotation, + Term3 v PrintAnnotation + ) + ], + Term3 v PrintAnnotation + ) + unBinaryAppsPred' (t, isInfix) = + go t isInfix + where + go t pred = + case unBinaryAppPred (t, pred) of + Just (f, x, y) -> + let precf = termPrecedence f + -- We only chain together infix operators if they have + -- higher precedence (lower raw precedence) than the + -- current operator. If there is no precedence, we only + -- chain if it's literally the same operator. + inChain compare g = isInfix g && (fromMaybe (g == f) $ compare <$> termPrecedence g <*> precf) + l = unBinaryAppsPred' (x, inChain (<=)) + r = unBinaryAppsPred' (y, inChain (<)) + in case (l, r) of + (Just (as, xLast), Just (bs, yLast)) -> Just (bs ++ ((xLast, f) : as), yLast) + (Just (as, xLast), Nothing) -> Just ((xLast, f) : as, y) + (Nothing, Just (bs, yLast)) -> Just (bs ++ [(x, f)], yLast) + (Nothing, Nothing) -> Just ([(x, f)], y) + Nothing -> Nothing + + -- Render a binary infix operator sequence, like [(a2, f2), (a1, f1)], + -- meaning (a1 `f1` a2) `f2` (a3 rendered by the caller), producing + -- "a1 `f1` a2 `f2`". Except the operators are all symbolic, so we won't + -- produce any backticks. We build the result out from the right, + -- starting at `f2`. + binaryApps :: + [(Term3 v PrintAnnotation, Term3 v PrintAnnotation)] -> + Pretty SyntaxText -> + m (Pretty SyntaxText) + binaryApps xs last = + do + let xs' = reverse xs + psh <- join <$> traverse (uncurry (r 3)) (take 1 xs') + pst <- join <$> traverse (uncurry (r 10)) (drop 1 xs') + let ps = psh <> pst + let unbroken = PP.spaced (ps <> [last]) + broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last] + pure (unbroken `PP.orElse` broken) + where + psCols ps = case take 2 ps of + [x, y] -> (x, y) : psCols (drop 2 ps) + [x] -> [(x, "")] + [] -> [] + _ -> undefined + r p a f = + sequenceA + [ pretty0 (ac (if isBlock a then 12 else (fromMaybe p (infixPrecedence f))) Normal im doc) a, + pretty0 (AmbientContext 10 Normal Infix im doc False) f + ] + case (term, binaryOpsPred) of (DD.Doc, _) | doc == MaybeDoc -> @@ -468,27 +538,37 @@ pretty0 PP.hang kw <$> fmap PP.lines (traverse go rs) (Bytes' bs, _) -> pure $ PP.group $ fmt S.BytesLiteral "0xs" <> PP.shown (Bytes.fromWord8s (map fromIntegral bs)) - BinaryAppPred' f a b -> do - let prec = fmap ((-) 9) $ termPrecedence f - prettyF <- pretty0 (AmbientContext 10 Normal Infix im doc False) f - prettyA <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) a - prettyB <- pretty0 (ac (fromMaybe (length Precedence.levels + 3) prec) Normal im doc) b - pure . paren (p > fromMaybe 3 prec) $ - PP.group (prettyA <> PP.softbreak <> prettyF) `PP.hang` prettyB + app@(BinaryAppPred' f _ _) -> do + let prec = infixPrecedence f + case unBinaryAppsPred' app of + Just (apps, lastArg) -> do + prettyLast <- pretty0 (ac (fromMaybe (length Precedence.levels + 3) prec) Normal im doc) lastArg + prettyApps <- binaryApps apps prettyLast + pure $ paren (p > fromMaybe 3 prec) prettyApps + Nothing -> error "crash" + -- let prec = fmap ((-) 9) $ termPrecedence f + -- prettyF <- pretty0 (AmbientContext 10 Normal Infix im doc False) f + -- prettyA <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) a + -- prettyB <- pretty0 (ac (fromMaybe (length Precedence.levels + 3) prec) Normal im doc) b + -- pure . parenNoGroup (p > fromMaybe 3 prec) $ + -- (prettyA <> " " <> prettyF <> " " <> prettyB) + -- `PP.orElse` (prettyA `PP.hangUngrouped` prettyF <> " " <> prettyB) (And' a b, _) -> do let prec = fmap ((-) 9) $ Precedence.precedence "&&" prettyF = fmt S.ControlKeyword "&&" prettyA <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) a prettyB <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) b - pure . paren (maybe False (p >) prec) $ - PP.group (prettyA <> PP.softbreak <> prettyF) `PP.hang` prettyB + pure . parenNoGroup (p > fromMaybe 3 prec) $ + (prettyA <> " " <> prettyF <> " " <> prettyB) + `PP.orElse` (prettyA `PP.hangUngrouped` prettyF <> " " <> prettyB) (Or' a b, _) -> do let prec = fmap ((-) 9) $ Precedence.precedence "||" prettyF = fmt S.ControlKeyword "||" prettyA <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) a prettyB <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) b - pure . paren (maybe False (p >) prec) $ - PP.group (prettyA <> PP.softbreak <> prettyF) `PP.hang` prettyB + pure . parenNoGroup (p > fromMaybe 3 prec) $ + (prettyA <> " " <> prettyF <> " " <> prettyB) + `PP.orElse` (prettyA `PP.hangUngrouped` prettyF <> " " <> prettyB) -- BinaryAppsPred' apps lastArg -> do -- prettyLast <- pretty0 (ac 3 Normal im doc) lastArg -- prettyApps <- binaryApps apps prettyLast @@ -602,33 +682,6 @@ pretty0 nonUnitArgPred :: (Var v) => v -> Bool nonUnitArgPred v = Var.name v /= "()" - -- Render a binary infix operator sequence, like [(a2, f2), (a1, f1)], - -- meaning (a1 `f1` a2) `f2` (a3 rendered by the caller), producing - -- "a1 `f1` a2 `f2`". Except the operators are all symbolic, so we won't - -- produce any backticks. We build the result out from the right, - -- starting at `f2`. - binaryApps :: - [(Term3 v PrintAnnotation, Term3 v PrintAnnotation)] -> - Pretty SyntaxText -> - m (Pretty SyntaxText) - binaryApps xs last = - do - ps <- join <$> traverse (uncurry r) (reverse xs) - let unbroken = PP.spaced (ps <> [last]) - broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last] - pure (unbroken `PP.orElse` broken) - where - psCols ps = case take 2 ps of - [x, y] -> (x, y) : psCols (drop 2 ps) - [x] -> [(x, "")] - [] -> [] - _ -> undefined - r a f = - sequenceA - [ pretty0 (ac (if isBlock a then 12 else 3) Normal im doc) a, - pretty0 (AmbientContext 10 Normal Infix im doc False) f - ] - -- -- Render sequence of infix &&s or ||s, like [x2, x1], -- -- meaning (x1 && x2) && (x3 rendered by the caller), producing -- -- "x1 && x2 &&". The result is built from the right. @@ -1091,8 +1144,11 @@ prettyDoc n im term = spaceUnlessBroken = PP.orElse " " "" paren :: Bool -> Pretty SyntaxText -> Pretty SyntaxText -paren True s = PP.group $ fmt S.Parenthesis "(" <> s <> fmt S.Parenthesis ")" -paren False s = PP.group s +paren b s = PP.group $ parenNoGroup b s + +parenNoGroup :: Bool -> Pretty SyntaxText -> Pretty SyntaxText +parenNoGroup True s = fmt S.Parenthesis "(" <> s <> fmt S.Parenthesis ")" +parenNoGroup False s = s parenIfInfix :: HQ.HashQualified Name -> From 7b3b65f55ecd4d59263c35c96103287cf3493f6e Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 16 Aug 2024 15:06:34 -0400 Subject: [PATCH 586/631] implement namespace directive --- .../src/Unison/Syntax/FileParser.hs | 141 +++++++++++-- .../src/Unison/UnisonFile/Names.hs | 4 +- unison-src/transcripts/namespace-directive.md | 75 +++++++ .../transcripts/namespace-directive.output.md | 196 ++++++++++++++++++ .../src/Unison/Syntax/Lexer/Unison.hs | 12 +- unison-syntax/src/Unison/Syntax/Parser.hs | 2 +- unison-syntax/src/Unison/Syntax/Var.hs | 6 + 7 files changed, 410 insertions(+), 26 deletions(-) create mode 100644 unison-src/transcripts/namespace-directive.md create mode 100644 unison-src/transcripts/namespace-directive.output.md diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 6185747380..94402b1c23 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -6,7 +6,6 @@ where import Control.Lens import Control.Monad.Reader (asks, local) import Data.List qualified as List -import Data.List.NonEmpty (pattern (:|)) import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text @@ -14,6 +13,7 @@ import Text.Megaparsec qualified as P import Unison.ABT qualified as ABT import Unison.DataDeclaration (DataDeclaration, EffectDeclaration) import Unison.DataDeclaration qualified as DD +import Unison.DataDeclaration qualified as DataDeclaration import Unison.DataDeclaration.Records (generateRecordAccessors) import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment @@ -26,12 +26,14 @@ import Unison.Prelude import Unison.Reference (TypeReferenceId) import Unison.Syntax.DeclParser (declarations) import Unison.Syntax.Lexer qualified as L -import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar) +import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) import Unison.Syntax.Parser import Unison.Syntax.TermParser qualified as TermParser -import Unison.Syntax.Var qualified as Var (namespaced) -import Unison.Term (Term) +import Unison.Syntax.Var qualified as Var (namespaced, namespaced2) +import Unison.Term (Term, Term2) import Unison.Term qualified as Term +import Unison.Type (Type) +import Unison.Type qualified as Type import Unison.UnisonFile (UnisonFile (..)) import Unison.UnisonFile.Env qualified as UF import Unison.UnisonFile.Names qualified as UFN @@ -48,21 +50,65 @@ resolutionFailures es = P.customFailure (ResolutionFailures es) file :: forall m v. (Monad m, Var v) => P v m (UnisonFile v Ann) file = do _ <- openBlock + + -- Parse an optional directive like "namespace foo.bar" + maybeNamespace :: Maybe v <- + optional (reserved "namespace") >>= \case + Nothing -> pure Nothing + Just _ -> Just . Name.toVar . L.payload <$> (importWordyId <|> importSymbolyId) + -- The file may optionally contain top-level imports, -- which are parsed and applied to the type decls and term stanzas (namesStart, imports) <- TermParser.imports <* optional semi (dataDecls, effectDecls, parsedAccessors) <- declarations - env <- case UFN.environmentFor namesStart dataDecls effectDecls of - Right (Right env) -> pure env - Right (Left es) -> P.customFailure $ TypeDeclarationErrors es - Left es -> resolutionFailures (toList es) - let accessors :: [[(v, Ann, Term v Ann)]] + + let unNamespacedTypeNames :: Set v + unNamespacedTypeNames = + Set.union (Map.keysSet dataDecls) (Map.keysSet effectDecls) + + env <- + let applyNamespaceToDecls :: forall decl. Iso' decl (DataDeclaration v Ann) -> Map v decl -> Map v decl + applyNamespaceToDecls dataDeclL = + case maybeNamespace of + Nothing -> id + Just namespace -> Map.fromList . map f . Map.toList + where + f :: (v, decl) -> (v, decl) + f (declName, decl) = + ( Var.namespaced2 namespace declName, + review dataDeclL (applyNamespaceToDataDecl namespace unNamespacedTypeNames (view dataDeclL decl)) + ) + dataDecls1 = applyNamespaceToDecls id dataDecls + effectDecls1 = applyNamespaceToDecls DataDeclaration.asDataDecl_ effectDecls + in case UFN.environmentFor namesStart dataDecls1 effectDecls1 of + Right (Right env) -> pure env + Right (Left es) -> P.customFailure $ TypeDeclarationErrors es + Left es -> resolutionFailures (toList es) + let unNamespacedAccessors :: [(v, Ann, Term v Ann)] + unNamespacedAccessors = do + (typ, fields) <- parsedAccessors + -- The parsed accessor has an un-namespaced type, so apply the namespace directive (if necessary) before + -- looking up in the environment computed by `environmentFor`. + let typ1 = maybe id Var.namespaced2 maybeNamespace (L.payload typ) + Just (r, _) <- [Map.lookup typ1 (UF.datas env)] + -- Generate the record accessors with *un-namespaced* names (passing `typ` rather than `typ1`) below, because we + -- need to know these names in order to perform rewriting. As an example, + -- + -- namespace foo + -- type Bar = { baz : Nat } + -- term = ... Bar.baz ... + -- + -- we want to rename `Bar.baz` to `foo.Bar.baz`, and it seems easier to first generate un-namespaced accessors + -- like `Bar.baz`, rather than rip off the namespace from accessors like `foo.Bar.baz` (though not by much). + generateRecordAccessors Var.namespaced Ann.GeneratedFrom (toPair <$> fields) (L.payload typ) r + where + toPair (tok, typ) = (L.payload tok, ann tok <> ann typ) + let accessors :: [(v, Ann, Term v Ann)] accessors = - [ generateRecordAccessors Var.namespaced Ann.GeneratedFrom (toPair <$> fields) (L.payload typ) r - | (typ, fields) <- parsedAccessors, - Just (r, _) <- [Map.lookup (L.payload typ) (UF.datas env)] - ] - toPair (tok, typ) = (L.payload tok, ann tok <> ann typ) + unNamespacedAccessors + & case maybeNamespace of + Nothing -> id + Just namespace -> over (mapped . _1) (Var.namespaced2 namespace) let importNames = [(Name.unsafeParseVar v, Name.unsafeParseVar v2) | (v, v2) <- imports] let locals = Names.importing importNames (UF.names env) -- At this stage of the file parser, we've parsed all the type and ability @@ -74,8 +120,26 @@ file = do -- make use of _terms_ from the local file. local (\e -> e {names = Names.push locals namesStart}) do names <- asks names - stanzas0 <- sepBy semi stanza - let stanzas = fmap (TermParser.substImports names imports) <$> stanzas0 + stanzas <- do + unNamespacedStanzas0 <- sepBy semi stanza + let unNamespacedStanzas = fmap (TermParser.substImports names imports) <$> unNamespacedStanzas0 + pure $ + unNamespacedStanzas + & case maybeNamespace of + Nothing -> id + Just namespace -> + let unNamespacedTermNamespaceNames :: Set v + unNamespacedTermNamespaceNames = + Set.unions + [ -- The vars parsed from the stanzas themselves (before applying namespace directive) + Set.fromList (unNamespacedStanzas >>= getVars), + -- The un-namespaced constructor names (from the *originally-parsed* data and effect decls) + foldMap (Set.fromList . DataDeclaration.constructorVars) dataDecls, + foldMap (Set.fromList . DataDeclaration.constructorVars . DataDeclaration.toDataDecl) effectDecls, + -- The un-namespaced accessors + Set.fromList (map (view _1) unNamespacedAccessors) + ] + in map (applyNamespaceToStanza namespace unNamespacedTermNamespaceNames) _ <- closeBlock let (termsr, watchesr) = foldl' go ([], []) stanzas go (terms, watches) s = case s of @@ -89,7 +153,7 @@ file = do -- All locally declared term variables, running example: -- [foo.alice, bar.alice, zonk.bob] fqLocalTerms :: [v] - fqLocalTerms = (stanzas0 >>= getVars) <> (view _1 <$> join accessors) + fqLocalTerms = (stanzas >>= getVars) <> (view _1 <$> accessors) -- suffixified local term bindings shadow any same-named thing from the outer codebase scope -- example: `foo.bar` in local file scope will shadow `foo.bar` and `bar` in codebase scope let (curNames, resolveLocals) = @@ -120,9 +184,48 @@ file = do validateUnisonFile (UF.datasId env) (UF.effectsId env) - (terms <> join accessors) + (terms <> accessors) (List.multimap watches) +applyNamespaceToDataDecl :: forall a v. (Var v) => v -> Set v -> DataDeclaration v a -> DataDeclaration v a +applyNamespaceToDataDecl namespace locallyBoundTypes = + over (DataDeclaration.constructors_ . mapped) \(ann, conName, conTy) -> + (ann, Var.namespaced2 namespace conName, ABT.substsInheritAnnotation replacements conTy) + where + -- Replace var "Foo" with var "namespace.Foo" + replacements :: [(v, Type v ())] + replacements = + locallyBoundTypes + & Set.toList + & map (\v -> (v, Type.var () (Var.namespaced2 namespace v))) + +applyNamespaceToStanza :: + forall a v. + (Var v) => + v -> + Set v -> + Stanza v (Term v a) -> + Stanza v (Term v a) +applyNamespaceToStanza namespace locallyBoundTerms = \case + Binding x -> Binding (goBinding x) + Bindings xs -> Bindings (map goBinding xs) + WatchBinding wk ann x -> WatchBinding wk ann (goBinding x) + WatchExpression wk guid ann term -> WatchExpression wk guid ann (goTerm term) + where + goBinding :: ((Ann, v), Term v a) -> ((Ann, v), Term v a) + goBinding ((ann, name), term) = + ((ann, Var.namespaced2 namespace name), goTerm term) + + goTerm :: Term v a -> Term v a + goTerm = + ABT.substsInheritAnnotation replacements + + replacements :: [(v, Term2 v a a v ())] + replacements = + locallyBoundTerms + & Set.toList + & map (\v -> (v, Term.var () (Var.namespaced2 namespace v))) + -- | Final validations and sanity checks to perform before finishing parsing. validateUnisonFile :: (Ord v) => @@ -237,7 +340,7 @@ stanza = watchExpression <|> unexpectedAction <|> binding binding@((_, v), _) <- TermParser.binding pure $ case doc of Nothing -> Binding binding - Just (spanAnn, doc) -> Bindings [((spanAnn, Var.namespaced (v :| [Var.named "doc"])), doc), binding] + Just (spanAnn, doc) -> Bindings [((spanAnn, Var.namespaced2 v (Var.named "doc")), doc), binding] watched :: (Monad m, Var v) => P v m (UF.WatchKind, Text, Ann) watched = P.try do diff --git a/parser-typechecker/src/Unison/UnisonFile/Names.hs b/parser-typechecker/src/Unison/UnisonFile/Names.hs index 00fdd5f115..5c30654760 100644 --- a/parser-typechecker/src/Unison/UnisonFile/Names.hs +++ b/parser-typechecker/src/Unison/UnisonFile/Names.hs @@ -131,11 +131,13 @@ environmentFor :: Names.ResolutionResult v a (Either [Error v a] (Env v a)) environmentFor names dataDecls0 effectDecls0 = do let locallyBoundTypes = variableCanonicalizer (Map.keys dataDecls0 <> Map.keys effectDecls0) - -- data decls and hash decls may reference each other, and thus must be hashed together + + -- data decls and effect decls may reference each other, and thus must be hashed together dataDecls :: Map v (DataDeclaration v a) <- traverse (DD.Names.bindNames Name.unsafeParseVar locallyBoundTypes names) dataDecls0 effectDecls :: Map v (EffectDeclaration v a) <- traverse (DD.withEffectDeclM (DD.Names.bindNames Name.unsafeParseVar locallyBoundTypes names)) effectDecls0 + let allDecls0 :: Map v (DataDeclaration v a) allDecls0 = Map.union dataDecls (toDataDecl <$> effectDecls) hashDecls' :: [(v, Reference.Id, DataDeclaration v a)] <- Hashing.hashDataDecls allDecls0 diff --git a/unison-src/transcripts/namespace-directive.md b/unison-src/transcripts/namespace-directive.md new file mode 100644 index 0000000000..1d0ffddb25 --- /dev/null +++ b/unison-src/transcripts/namespace-directive.md @@ -0,0 +1,75 @@ +A `namespace foo` directive is optional, and may only appear at the top of a file. + +It affects the contents of the file as follows: + +1. All bindings like `x.y.z` are prefixed with the namespace; note that when this file is saved, the feedback mentions +the full bindings' names. + +```ucm +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +namespace foo + +baz : Nat +baz = 17 +``` + +2. Free variables whose names exactly match bindings in the file are rewritten to refer to the prefixed binder instead. +That is, a term like `factorial = ... factorial ...` is rewritten to `foo.factorial = ... foo.factorial ...`. + +```unison +namespace foo + +factorial : Int -> Int +factorial = cases + +0 -> +1 + n -> n * factorial (n - +1) + +longer.evil.factorial : Int -> Int +longer.evil.factorial n = n +``` + +```ucm +scratch/main> add +scratch/main> view factorial +``` + +Note that in the above example, we do not want the existence of a `namespace foo` directive to determine whether the +reference to the name `factorial` within the body of `factorial` is a recursive reference (good, behavior without +namespace directive, exact-name-match-wins semantics) or an ambiguous reference (bad, as would be the case if the +bindings were expanded to `foo.factorial` and `foo.longer.evil.factorial`, but the variables left alone). + +Here are a few more examples demonstrating that type names, constructor names, and generated record accessor names are +all properly handled. + +```unison +type longer.foo.Foo = Bar +type longer.foo.Baz = { qux : Nat } +``` + +```ucm +scratch/main> add +``` + +```unison +namespace foo + +type Foo = Bar +type Baz = { qux : Nat } + +type RefersToFoo = RefersToFoo Foo + +refersToBar = cases + Bar -> 17 + +refersToQux baz = + Baz.qux baz + Baz.qux baz +``` + +```ucm +scratch/main> add +scratch/main> view RefersToFoo refersToBar refersToQux +scratch/main> todo +``` diff --git a/unison-src/transcripts/namespace-directive.output.md b/unison-src/transcripts/namespace-directive.output.md new file mode 100644 index 0000000000..90e568248a --- /dev/null +++ b/unison-src/transcripts/namespace-directive.output.md @@ -0,0 +1,196 @@ +A `namespace foo` directive is optional, and may only appear at the top of a file. + +It affects the contents of the file as follows: + +1. All bindings like `x.y.z` are prefixed with the namespace; note that when this file is saved, the feedback mentions + the full bindings' names. + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. + +``` +``` unison +namespace foo + +baz : Nat +baz = 17 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + foo.baz : Nat + +``` +2. Free variables whose names exactly match bindings in the file are rewritten to refer to the prefixed binder instead. + That is, a term like `factorial = ... factorial ...` is rewritten to `foo.factorial = ... foo.factorial ...`. + +``` unison +namespace foo + +factorial : Int -> Int +factorial = cases + +0 -> +1 + n -> n * factorial (n - +1) + +longer.evil.factorial : Int -> Int +longer.evil.factorial n = n +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + foo.factorial : Int -> Int + foo.longer.evil.factorial : Int -> Int + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo.factorial : Int -> Int + foo.longer.evil.factorial : Int -> Int + +scratch/main> view factorial + + foo.factorial : Int -> Int + foo.factorial = cases + +0 -> +1 + n -> n Int.* foo.factorial (n Int.- +1) + + foo.longer.evil.factorial : Int -> Int + foo.longer.evil.factorial n = n + +``` +Note that in the above example, we do not want the existence of a `namespace foo` directive to determine whether the +reference to the name `factorial` within the body of `factorial` is a recursive reference (good, behavior without +namespace directive, exact-name-match-wins semantics) or an ambiguous reference (bad, as would be the case if the +bindings were expanded to `foo.factorial` and `foo.longer.evil.factorial`, but the variables left alone). + +Here are a few more examples demonstrating that type names, constructor names, and generated record accessor names are +all properly handled. + +``` unison +type longer.foo.Foo = Bar +type longer.foo.Baz = { qux : Nat } +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type longer.foo.Baz + type longer.foo.Foo + longer.foo.Baz.qux : Baz -> Nat + longer.foo.Baz.qux.modify : (Nat ->{g} Nat) + -> Baz + ->{g} Baz + longer.foo.Baz.qux.set : Nat -> Baz -> Baz + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type longer.foo.Baz + type longer.foo.Foo + longer.foo.Baz.qux : Baz -> Nat + longer.foo.Baz.qux.modify : (Nat ->{g} Nat) -> Baz ->{g} Baz + longer.foo.Baz.qux.set : Nat -> Baz -> Baz + +``` +``` unison +namespace foo + +type Foo = Bar +type Baz = { qux : Nat } + +type RefersToFoo = RefersToFoo Foo + +refersToBar = cases + Bar -> 17 + +refersToQux baz = + Baz.qux baz + Baz.qux baz +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type foo.Baz + type foo.Foo + type foo.RefersToFoo + foo.Baz.qux : foo.Baz -> Nat + foo.Baz.qux.modify : (Nat ->{g} Nat) + -> foo.Baz + ->{g} foo.Baz + foo.Baz.qux.set : Nat -> foo.Baz -> foo.Baz + foo.refersToBar : foo.Foo -> Nat + foo.refersToQux : foo.Baz -> Nat + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type foo.Baz + type foo.Foo + type foo.RefersToFoo + foo.Baz.qux : foo.Baz -> Nat + foo.Baz.qux.modify : (Nat ->{g} Nat) + -> foo.Baz + ->{g} foo.Baz + foo.Baz.qux.set : Nat -> foo.Baz -> foo.Baz + foo.refersToBar : foo.Foo -> Nat + foo.refersToQux : foo.Baz -> Nat + +scratch/main> view RefersToFoo refersToBar refersToQux + + type foo.RefersToFoo = RefersToFoo foo.Foo + + foo.refersToBar : foo.Foo -> Nat + foo.refersToBar = cases foo.Foo.Bar -> 17 + + foo.refersToQux : foo.Baz -> Nat + foo.refersToQux baz = + use Nat + + use foo.Baz qux + qux baz + qux baz + +scratch/main> todo + + You have no pending todo items. Good work! ✅ + +``` diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs index c641786505..781471b7a3 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -573,6 +573,7 @@ lexemes eof = <|> symbolyKw "&&" <|> wordyKw "true" <|> wordyKw "false" + <|> wordyKw "namespace" <|> wordyKw "use" <|> wordyKw "forall" <|> wordyKw "∀" @@ -878,16 +879,17 @@ stanzas = ) ([] :| []) --- Moves type and ability declarations to the front of the token stream --- and move `use` statements to the front of each block +-- Moves type and ability declarations to the front of the token stream (but not before the leading optional namespace +-- directive) and move `use` statements to the front of each block reorder :: [[BlockTree (Token Lexeme)]] -> [[BlockTree (Token Lexeme)]] reorder = foldr fixup [] . sortWith f where f [] = 3 :: Int f (t0 : _) = case payload $ headToken t0 of - Open mod | Set.member (Text.pack mod) typeModifiers -> 1 - Open typOrA | Set.member (Text.pack typOrA) typeOrAbility -> 1 - Reserved "use" -> 0 + Open mod | Set.member (Text.pack mod) typeModifiers -> 2 + Open typOrA | Set.member (Text.pack typOrA) typeOrAbility -> 2 + Reserved "namespace" -> 1 + Reserved "use" -> 1 _ -> 3 :: Int -- after reordering can end up with trailing semicolon at the end of -- a block, which we remove with this pass diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 1ac87e8eb2..deb1e89f4f 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -304,7 +304,7 @@ prefixTermName = wordyTermName <|> parenthesize symbolyTermName -- | Parse a wordy identifier e.g. Foo, discarding any hash wordyDefinitionName :: (Var v) => P v m (L.Token v) -wordyDefinitionName = queryToken $ \case +wordyDefinitionName = queryToken \case L.WordyId n -> Just $ Name.toVar (HQ'.toName n) L.Blank s -> Just $ Var.nameds ("_" <> s) _ -> Nothing diff --git a/unison-syntax/src/Unison/Syntax/Var.hs b/unison-syntax/src/Unison/Syntax/Var.hs index 9fbc934d29..9f92e2c758 100644 --- a/unison-syntax/src/Unison/Syntax/Var.hs +++ b/unison-syntax/src/Unison/Syntax/Var.hs @@ -1,5 +1,6 @@ module Unison.Syntax.Var ( namespaced, + namespaced2, ) where @@ -13,3 +14,8 @@ import Unison.Var (Var) namespaced :: (Var v) => List.NonEmpty v -> v namespaced (v :| vs) = Name.toVar (foldl' Name.joinDot (Name.unsafeParseVar v) (map Name.unsafeParseVar vs)) + +-- | Like 'namespaced', but for the common case that you have two vars to join. +namespaced2 :: (Var v) => v -> v -> v +namespaced2 v1 v2 = + namespaced (v1 :| [v2]) From 699a16acdda563695484bd896bf900c569e6b8a7 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 16 Aug 2024 15:07:32 -0400 Subject: [PATCH 587/631] move a binding --- parser-typechecker/src/Unison/Syntax/FileParser.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 94402b1c23..f2e0da2592 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -62,10 +62,6 @@ file = do (namesStart, imports) <- TermParser.imports <* optional semi (dataDecls, effectDecls, parsedAccessors) <- declarations - let unNamespacedTypeNames :: Set v - unNamespacedTypeNames = - Set.union (Map.keysSet dataDecls) (Map.keysSet effectDecls) - env <- let applyNamespaceToDecls :: forall decl. Iso' decl (DataDeclaration v Ann) -> Map v decl -> Map v decl applyNamespaceToDecls dataDeclL = @@ -78,6 +74,11 @@ file = do ( Var.namespaced2 namespace declName, review dataDeclL (applyNamespaceToDataDecl namespace unNamespacedTypeNames (view dataDeclL decl)) ) + + unNamespacedTypeNames :: Set v + unNamespacedTypeNames = + Set.union (Map.keysSet dataDecls) (Map.keysSet effectDecls) + dataDecls1 = applyNamespaceToDecls id dataDecls effectDecls1 = applyNamespaceToDecls DataDeclaration.asDataDecl_ effectDecls in case UFN.environmentFor namesStart dataDecls1 effectDecls1 of From 2f82c7eb850015350c4e9596314d35161eda85cc Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 16 Aug 2024 15:19:36 -0400 Subject: [PATCH 588/631] fix file ordering --- unison-syntax/src/Unison/Syntax/Lexer/Unison.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs index 781471b7a3..18a5f7d0f4 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -884,13 +884,14 @@ stanzas = reorder :: [[BlockTree (Token Lexeme)]] -> [[BlockTree (Token Lexeme)]] reorder = foldr fixup [] . sortWith f where - f [] = 3 :: Int + f [] = 4 :: Int f (t0 : _) = case payload $ headToken t0 of - Open mod | Set.member (Text.pack mod) typeModifiers -> 2 - Open typOrA | Set.member (Text.pack typOrA) typeOrAbility -> 2 + Open mod | Set.member (Text.pack mod) typeModifiers -> 3 + Open typOrA | Set.member (Text.pack typOrA) typeOrAbility -> 3 + -- put `namespace` before `use` because the file parser only accepts a namespace directive at the top of the file Reserved "namespace" -> 1 - Reserved "use" -> 1 - _ -> 3 :: Int + Reserved "use" -> 2 + _ -> 4 :: Int -- after reordering can end up with trailing semicolon at the end of -- a block, which we remove with this pass fixup stanza [] = case Lens.unsnoc stanza of From df2c76aa426d39c6dc8fd0958cebcfb06909d0c3 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 16 Aug 2024 15:25:59 -0400 Subject: [PATCH 589/631] rerun generic-parse-errors transcript --- .../generic-parse-errors.output.md | 26 ++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/unison-src/transcripts/generic-parse-errors.output.md b/unison-src/transcripts/generic-parse-errors.output.md index 081548ea11..d1a4cdd6ef 100644 --- a/unison-src/transcripts/generic-parse-errors.output.md +++ b/unison-src/transcripts/generic-parse-errors.output.md @@ -30,12 +30,32 @@ namespace.blah = 1 Loading changes detected in scratch.u. - The identifier `namespace` used here is a reserved keyword: + I got confused here: 1 | namespace.blah = 1 - You can avoid this problem either by renaming the identifier - or wrapping it in backticks (like `namespace` ). + + I was surprised to find a = here. + I was expecting one of these instead: + + * ability + * bang + * binding + * do + * false + * force + * handle + * if + * lambda + * let + * newline or semicolon + * quote + * termLink + * true + * tuple + * type + * typeLink + * use ``` ``` unison From 1470085d3fcc526ce94311d62faa0aa237a3cdda Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Fri, 16 Aug 2024 23:44:19 -0400 Subject: [PATCH 590/631] Get rid of confusing precedence levels --- parser-typechecker/src/Unison/PrintError.hs | 3 +- .../src/Unison/Syntax/Precedence.hs | 69 ++++- .../src/Unison/Syntax/TermParser.hs | 10 +- .../src/Unison/Syntax/TermPrinter.hs | 279 +++++++++--------- 4 files changed, 204 insertions(+), 157 deletions(-) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 691d7cd3ef..7bc7656df9 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -59,6 +59,7 @@ import Unison.Syntax.Name qualified as Name (toText) import Unison.Syntax.NamePrinter (prettyHashQualified0) import Unison.Syntax.Parser (Annotated, ann) import Unison.Syntax.Parser qualified as Parser +import Unison.Syntax.Precedence qualified as Precedence import Unison.Syntax.TermPrinter qualified as TermPrinter import Unison.Term qualified as Term import Unison.Type (Type) @@ -1132,7 +1133,7 @@ renderTerm env e = else fromString s renderPattern :: Env -> Pattern ann -> ColorText -renderPattern env e = Pr.renderUnbroken . Pr.syntaxToColor . fst $ TermPrinter.prettyPattern env TermPrinter.emptyAc 0 ([] :: [Symbol]) e +renderPattern env e = Pr.renderUnbroken . Pr.syntaxToColor . fst $ TermPrinter.prettyPattern env TermPrinter.emptyAc Precedence.Annotation ([] :: [Symbol]) e -- | renders a type with no special styling renderType' :: (IsString s, Var v) => Env -> Type v loc -> s diff --git a/parser-typechecker/src/Unison/Syntax/Precedence.hs b/parser-typechecker/src/Unison/Syntax/Precedence.hs index 11c2e20cc5..e5f7bd757d 100644 --- a/parser-typechecker/src/Unison/Syntax/Precedence.hs +++ b/parser-typechecker/src/Unison/Syntax/Precedence.hs @@ -7,21 +7,64 @@ import Unison.Prelude -- Lower number means higher precedence (tighter binding). -- Operators not in this list have no precedence and will simply be parsed -- left-to-right. -precedenceRules :: Map Text Int -precedenceRules = - Map.fromList $ zip levels [0 ..] >>= \(ops, prec) -> map (,prec) ops +infixRules :: Map Text Precedence +infixRules = + Map.fromList do + (ops, prec) <- zip infixLevels (map (InfixOp . Level) [0 ..]) + map (,prec) ops -levels :: [[Text]] -levels = - [ ["*", "/", "%"], - ["+", "-"], - ["<", ">", ">=", "<="], - ["==", "!==", "!=", "==="], +-- | Indicates this is the RHS of a top-level definition. +isTopLevelPrecedence :: Precedence -> Bool +isTopLevelPrecedence i = i == Basement + +increment :: Precedence -> Precedence +increment = \case + Basement -> Bottom + Bottom -> Annotation + Annotation -> Statement + Statement -> Control + Control -> InfixOp Lowest + InfixOp Lowest -> InfixOp (Level 0) + InfixOp (Level n) -> InfixOp (Level (n + 1)) + InfixOp Highest -> Application + Application -> Prefix + Prefix -> Top + Top -> Top + +data Precedence + = -- | The lowest precedence, used for top-level bindings + Basement + | -- | Used for terms that never need parentheses + Bottom + | -- | Type annotations + Annotation + | -- | A statement in a block + Statement + | -- | Control flow constructs like `if`, `match`, `case` + Control + | -- | Infix operators + InfixOp InfixPrecedence + | -- | Function application + Application + | -- | Prefix operators like `'`, `!` + Prefix + | -- | The highest precedence, used for let bindings and blocks + Top + deriving (Eq, Ord, Show) + +data InfixPrecedence = Lowest | Level Int | Highest + deriving (Eq, Ord, Show) + +infixLevels :: [[Text]] +infixLevels = + [ ["||", "|"], ["&&", "&"], - ["^", "^^"], - ["||", "|"] + ["==", "!==", "!=", "==="], + ["<", ">", ">=", "<="], + ["+", "-"], + ["*", "/", "%"] ] -- | Returns the precedence of an infix operator, if it has one. -precedence :: Text -> Maybe Int -precedence op = Map.lookup op precedenceRules +operatorPrecedence :: Text -> Maybe Precedence +operatorPrecedence op = Map.lookup op infixRules diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index acefbdadd6..c06f102db5 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -54,7 +54,7 @@ import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser hiding (seq) import Unison.Syntax.Parser qualified as Parser (seq, uniqueName) import Unison.Syntax.Parser.Doc.Data qualified as Doc -import Unison.Syntax.Precedence (precedence) +import Unison.Syntax.Precedence (operatorPrecedence) import Unison.Syntax.TypeParser qualified as TypeParser import Unison.Term (IsTop, Term) import Unison.Term qualified as Term @@ -1075,7 +1075,7 @@ infixAppOrBooleanOp = do <|> (InfixOr <$> (label "or" (reserved "||"))) <|> (uncurry InfixOp <$> parseInfix) shouldRotate child parent = case (child, parent) of - (Just p1, Just p2) -> p1 > p2 + (Just p1, Just p2) -> p1 < p2 _ -> False parseInfix = label "infixApp" do op <- hqInfixId <* optional semi @@ -1095,13 +1095,13 @@ infixAppOrBooleanOp = do rotate op ctor lhs rhs = case lhs of InfixOp lop ltm ll lr - | shouldRotate (precedence (unqualified lop)) (precedence op) -> + | shouldRotate (operatorPrecedence (unqualified lop)) (operatorPrecedence op) -> InfixOp lop ltm ll (fixUp (ctor lr rhs)) InfixAnd lop ll lr - | shouldRotate (precedence "&&") (precedence op) -> + | shouldRotate (operatorPrecedence "&&") (operatorPrecedence op) -> InfixAnd lop ll (fixUp (ctor lr rhs)) InfixOr lop ll lr - | shouldRotate (precedence "||") (precedence op) -> + | shouldRotate (operatorPrecedence "||") (operatorPrecedence op) -> InfixOr lop ll (fixUp (ctor lr rhs)) _ -> ctor lhs rhs unqualified t = Maybe.fromJust $ NameSegment.toEscapedText . Name.lastSegment <$> (HQ.toName $ L.payload t) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index 83ff71519d..8a8a9dbbaa 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -55,7 +55,7 @@ import Unison.Syntax.Lexer.Unison (showEscapeChar) import Unison.Syntax.Name qualified as Name (isSymboly, parseText, parseTextEither, toText, unsafeParseText) import Unison.Syntax.NamePrinter (styleHashQualified'') import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText) -import Unison.Syntax.Precedence qualified as Precedence +import Unison.Syntax.Precedence (InfixPrecedence (..), Precedence (..), increment, isTopLevelPrecedence, operatorPrecedence) import Unison.Syntax.TypePrinter qualified as TypePrinter import Unison.Term import Unison.Type (Type, pattern ForallsNamed') @@ -93,7 +93,7 @@ data AmbientContext = AmbientContext { -- The operator precedence of the enclosing context (a number from 0 to 11, -- or -1 to render without outer parentheses unconditionally). -- Function application has precedence 10. - precedence :: !Int, -- -2 indicates top level binding, this is occasionally useful + precedence :: !Precedence, blockContext :: !BlockContext, infixContext :: !InfixContext, imports :: !Imports, @@ -126,50 +126,58 @@ data DocLiteralContext We illustrate precedence rules as follows. - >=10 - 10f 10x + >=Application + (Application)f (Application)x This example shows that a function application f x is enclosed in - parentheses whenever the ambient precedence around it is >= 10, and that - when printing its two components, an ambient precedence of 10 is used in + parentheses whenever the ambient precedence around it is >= Application, and that + when printing its two components, an ambient precedence of Application is used in both places. The pretty-printer uses the following rules for printing terms. - >=12 - let x = (-1)y - 1z + >=Top + let x = (Bottom)y + (Statement)z - >=11 - ! 11x - ' 11x - 11x ? + >=Prefix + ! (Prefix)x + ' (Prefix)x + (Prefix)x ? - >=10 - 10f 10x 10y ... + >=(Application) + (Application)f (Application)x (Application)y ... termLink t typeLink t - >=3 - x -> 2y - 3x + 3y + ... 3z + >=(Infix +) + (Infix +)x + (Infix +)y + ... (Infix +)z - >=2 - if 0a then 0b else 0c - handle 0b with 0h - case 2x of - a | 2g -> 0b + Printing an infix operator in infix position has the following additional + rule: If the operator has a lower precedence than the ambient precedence, + it is enclosed in parentheses. If the operator has no precedence rule, + its precedence is assumed to be higher than any operator to its right, and + lower than any operator to its left. - >=0 - 10a : 0Int + >(Control) + x -> (Control)y + + >=(Control) + if (Annotation)a then (Annotation)b else (Annotation)c + handle (Annoration)b with (Annotation)h + case (Control)x of + a | (Control)g -> (Control)b + + >=(Annotation) + (Application)a : (Annotation)Int And the following for patterns. - >=11 - x@11p + >=Prefix + x@(Prefix)p - >=10 - Con 10p 10q ... + >=Application + Con (Application)p (Application)q ... -- never any external parens added around the following { p } @@ -192,7 +200,7 @@ pretty0 a tm | isTopLevelPrecedence (precedence a) && not (isBindingSoftHangable -- we allow use clause insertion here even when it otherwise wouldn't be -- (as long as the tm isn't soft hangable, if it gets soft hung then -- adding use clauses beforehand will mess things up) - tmp <- pretty0 (a {imports = im, precedence = -1}) tm + tmp <- pretty0 (a {imports = im, precedence = Bottom}) tm pure $ PP.lines (uses <> [tmp]) where (im, uses) = calcImports (imports a) tm @@ -218,19 +226,19 @@ pretty0 TermLink' r -> do n <- getPPE let name = elideFQN im $ PrettyPrintEnv.termName n r - pure . paren (p >= 10) $ + pure . paren (p >= Application) $ fmt S.LinkKeyword "termLink " <> parenIfInfix name ic (styleHashQualified'' (fmt $ S.TermReference r) name) TypeLink' r -> do n <- getPPE let name = elideFQN im $ PrettyPrintEnv.typeName n r - pure . paren (p >= 10) $ + pure . paren (p >= Application) $ fmt S.LinkKeyword "typeLink " <> parenIfInfix name ic (styleHashQualified'' (fmt $ S.TypeReference r) name) Ann' tm t -> do - tm' <- pretty0 (ac 10 Normal im doc) tm + tm' <- pretty0 (ac Application Normal im doc) tm tp' <- TypePrinter.pretty0 im 0 t - pure . paren (p >= 0) $ tm' <> PP.hang (fmt S.TypeAscriptionColon " :") tp' + pure . paren (p >= Annotation) $ tm' <> PP.hang (fmt S.TypeAscriptionColon " :") tp' Int' i -> pure . fmt S.NumericLiteral . l $ (if i >= 0 then ("+" ++ show i) else (show i)) Nat' u -> pure . fmt S.NumericLiteral . l $ show u Float' f -> pure . fmt S.NumericLiteral . l $ show f @@ -248,7 +256,7 @@ pretty0 where -- we only use this syntax if we're not wrapped in something else, -- to avoid possible round trip issues if the text ends at an odd column - useRaw _ | p >= 0 = Nothing + useRaw _ | p >= Annotation = Nothing useRaw s | Text.find (== '\n') s == Just '\n' && Text.all ok s = n 3 useRaw _ = Nothing ok ch = isPrint ch || ch == '\n' || ch == '\r' @@ -279,13 +287,13 @@ pretty0 conRef = Referent.Con ref CT.Effect pure $ styleHashQualified'' (fmt $ S.TermReference conRef) name Handle' h body -> do - pb <- pretty0 (ac 0 Block im doc) body - ph <- pretty0 (ac 0 Block im doc) h + pb <- pretty0 (ac Annotation Block im doc) body + ph <- pretty0 (ac Annotation Block im doc) h let hangHandler = case h of -- handle ... with cases LamsNamedMatch' [] _ -> \a b -> a <> " " <> b _ -> PP.hang - pure . paren (p >= 2) $ + pure . paren (p >= Control) $ if PP.isMultiLine pb || PP.isMultiLine ph then PP.lines @@ -302,36 +310,36 @@ pretty0 ] Delay' x | Match' _ _ <- x -> do - px <- pretty0 (ac 0 Block im doc) x + px <- pretty0 (ac Annotation Block im doc) x let hang = if isSoftHangable x then PP.softHang else PP.hang - pure . paren (p >= 3) $ + pure . paren (p >= Application) $ fmt S.ControlKeyword "do" `hang` px | otherwise -> do let (im0', uses0) = calcImports im x - let allowUses = isLet x || p < 0 + let allowUses = isLet x || (p == Bottom) let im' = if allowUses then im0' else im let uses = if allowUses then uses0 else [] - let soft = isSoftHangable x && null uses && p < 3 + let soft = isSoftHangable x && null uses && p < Annotation let hang = if soft then PP.softHang else PP.hang - px <- pretty0 (ac 0 Block im' doc) x + px <- pretty0 (ac Annotation Block im' doc) x -- this makes sure we get proper indentation if `px` spills onto -- multiple lines, since `do` introduces layout block - let indent = PP.Width (if soft then 2 else 0) + (if soft && p < 3 then 1 else 0) - pure . paren (p >= 3) $ + let indent = PP.Width (if soft then 2 else 0) + (if soft && p < Application then 1 else 0) + pure . paren (p >= Application) $ fmt S.ControlKeyword "do" `hang` PP.lines (uses <> [PP.indentNAfterNewline indent px]) List' xs -> do let listLink p = fmt (S.TypeReference Type.listRef) p let comma = listLink ", " `PP.orElse` ("\n" <> listLink ", ") - pelems <- traverse (fmap (PP.indentNAfterNewline 2) . pretty0 (ac 0 Normal im doc)) xs + pelems <- traverse (fmap (PP.indentNAfterNewline 2) . pretty0 (ac Annotation Normal im doc)) xs let open = listLink "[" `PP.orElse` listLink "[ " let close = listLink "]" `PP.orElse` ("\n" <> listLink "]") pure $ PP.group (open <> PP.sep comma pelems <> close) If' cond t f -> do - pcond <- pretty0 (ac 2 Block im doc) cond - pt <- pretty0 (ac 0 Block im doc) t - pf <- pretty0 (ac 0 Block im doc) f - pure . paren (p >= 2) $ + pcond <- pretty0 (ac Control Block im doc) cond + pt <- pretty0 (ac Annotation Block im doc) t + pf <- pretty0 (ac Annotation Block im doc) f + pure . paren (p >= Control) $ if PP.isMultiLine pcond then PP.lines @@ -361,19 +369,19 @@ pretty0 -- blah -- See `isDestructuringBind` definition. Match' scrutinee cs@[MatchCase pat guard (AbsN' vs body)] - | p <= 2 && isDestructuringBind scrutinee cs -> do + | p <= Control && isDestructuringBind scrutinee cs -> do n <- getPPE let letIntro = case bc of Block -> id Normal -> \x -> fmt S.ControlKeyword "let" `PP.hang` x lhs <- do - let (lhs, _) = prettyPattern n (ac 0 Block im doc) 10 vs pat + let (lhs, _) = prettyPattern n (ac Annotation Block im doc) Application vs pat guard' <- printGuard guard pure $ PP.group lhs `PP.hang` guard' let eq = fmt S.BindingEquals "=" - rhs <- pretty0 (ac (-1) Block im doc) scrutinee + rhs <- pretty0 (ac Bottom Block im doc) scrutinee letIntro <$> do - prettyBody <- pretty0 (ac (-1) Block im doc) body + prettyBody <- pretty0 (ac Bottom Block im doc) body pure $ PP.lines [ (lhs <> eq) `PP.hang` rhs, @@ -383,13 +391,13 @@ pretty0 printGuard Nothing = pure mempty printGuard (Just g') = do let (_, g) = ABT.unabs g' - prettyg <- pretty0 (ac 2 Normal im doc) g + prettyg <- pretty0 (ac Control Normal im doc) g pure $ fmt S.DelimiterChar "| " <> prettyg Match' scrutinee branches -> do - ps <- pretty0 (ac 2 Normal im doc) scrutinee + ps <- pretty0 (ac Control Normal im doc) scrutinee pbs <- printCase im doc (arity1Branches branches) -- don't print with `cases` syntax - pure . paren (p >= 2) $ + pure . paren (p >= Control) $ if PP.isMultiLine ps then PP.lines @@ -397,7 +405,7 @@ pretty0 fmt S.ControlKeyword " with" `PP.hang` pbs ] else (fmt S.ControlKeyword "match " <> ps <> fmt S.ControlKeyword " with") `PP.hang` pbs - Apps' f args -> paren (p >= 10) <$> (PP.hang <$> goNormal 9 f <*> PP.spacedTraverse (goNormal 10) args) + Apps' f args -> paren (p >= Application) <$> (PP.hang <$> goNormal (InfixOp Highest) f <*> PP.spacedTraverse (goNormal Application) args) t -> pure $ l "error: " <> l (show t) where goNormal prec tm = pretty0 (ac prec Normal im doc) tm @@ -417,21 +425,20 @@ pretty0 Ref' r -> isSymbolic $ PrettyPrintEnv.termName n (Referent.Ref r) Var' v -> isSymbolic $ HQ.unsafeFromVar v _ -> False - -- Gets the raw precedence of a term, if it has one. - -- A lower number here means tighter binding. - -- These precedences range from 0 to 6. - termPrecedence :: Term3 v PrintAnnotation -> Maybe Int + -- Gets the precedence of an infix operator, if it has one. + termPrecedence :: Term3 v PrintAnnotation -> Maybe Precedence termPrecedence = \case Ref' r -> HQ.toName (PrettyPrintEnv.termName n (Referent.Ref r)) - >>= Precedence.precedence . NameSegment.toEscapedText . Name.lastSegment - Var' v -> HQ.toName (HQ.unsafeFromVar v) >>= Precedence.precedence . NameSegment.toEscapedText . Name.lastSegment + >>= operatorPrecedence + . NameSegment.toEscapedText + . Name.lastSegment + Var' v -> + HQ.toName (HQ.unsafeFromVar v) + >>= operatorPrecedence + . NameSegment.toEscapedText + . Name.lastSegment _ -> Nothing - -- Gets the pretty-printer precedence of a term, if it has one. - -- A higher number here means tighter binding. - -- Precedences 3 through 9 are used for infix operators. - -- We get this number by subtracting the raw precedence from 9. - infixPrecedence = fmap ((length Precedence.levels + 2) -) . termPrecedence unBinaryAppsPred' :: ( Term3 v PrintAnnotation, Term3 v PrintAnnotation -> Bool @@ -455,8 +462,8 @@ pretty0 -- current operator. If there is no precedence, we only -- chain if it's literally the same operator. inChain compare g = isInfix g && (fromMaybe (g == f) $ compare <$> termPrecedence g <*> precf) - l = unBinaryAppsPred' (x, inChain (<=)) - r = unBinaryAppsPred' (y, inChain (<)) + l = unBinaryAppsPred' (x, inChain (>=)) + r = unBinaryAppsPred' (y, inChain (>)) in case (l, r) of (Just (as, xLast), Just (bs, yLast)) -> Just (bs ++ ((xLast, f) : as), yLast) (Just (as, xLast), Nothing) -> Just ((xLast, f) : as, y) @@ -476,8 +483,8 @@ pretty0 binaryApps xs last = do let xs' = reverse xs - psh <- join <$> traverse (uncurry (r 3)) (take 1 xs') - pst <- join <$> traverse (uncurry (r 10)) (drop 1 xs') + psh <- join <$> traverse (uncurry (r (InfixOp Lowest))) (take 1 xs') + pst <- join <$> traverse (uncurry (r (InfixOp Highest))) (drop 1 xs') let ps = psh <> pst let unbroken = PP.spaced (ps <> [last]) broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last] @@ -490,8 +497,8 @@ pretty0 _ -> undefined r p a f = sequenceA - [ pretty0 (ac (if isBlock a then 12 else (fromMaybe p (infixPrecedence f))) Normal im doc) a, - pretty0 (AmbientContext 10 Normal Infix im doc False) f + [ pretty0 (ac (if isBlock a then Top else (fromMaybe p (termPrecedence f))) Normal im doc) a, + pretty0 (AmbientContext Application Normal Infix im doc False) f ] case (term, binaryOpsPred) of @@ -504,27 +511,27 @@ pretty0 let conRef = DD.pairCtorRef name <- elideFQN im <$> applyPPE2 PrettyPrintEnv.termName conRef let pair = parenIfInfix name ic $ styleHashQualified'' (fmt (S.TermReference conRef)) name - x' <- pretty0 (ac 10 Normal im doc) x - pure . paren (p >= 10) $ + x' <- pretty0 (ac Application Normal im doc) x + pure . paren (p >= Application) $ pair `PP.hang` PP.spaced [x', fmt (S.TermReference DD.unitCtorRef) "()"] (TupleTerm' xs, _) -> do let tupleLink p = fmt (S.TypeReference DD.pairRef) p let comma = tupleLink ", " `PP.orElse` ("\n" <> tupleLink ", ") - pelems <- traverse (fmap (PP.indentNAfterNewline 2) . goNormal 0) xs + pelems <- traverse (fmap (PP.indentNAfterNewline 2) . goNormal Annotation) xs let clist = PP.sep comma pelems let open = tupleLink "(" `PP.orElse` tupleLink "( " let close = tupleLink ")" `PP.orElse` ("\n" <> tupleLink ")") pure $ PP.group (open <> clist <> close) (App' f@(Builtin' "Any.Any") arg, _) -> - paren (p >= 10) <$> (PP.hang <$> goNormal 9 f <*> goNormal 10 arg) + paren (p >= Application) <$> (PP.hang <$> goNormal (InfixOp Highest) f <*> goNormal Application arg) (DD.Rewrites' rs, _) -> do let kw = fmt S.ControlKeyword "@rewrite" arr = fmt S.ControlKeyword "==>" control = fmt S.ControlKeyword - sub kw lhs = PP.sep " " <$> sequence [pure $ control kw, goNormal 0 lhs, pure arr] - go (DD.RewriteTerm' lhs rhs) = PP.hang <$> sub "term" lhs <*> goNormal 0 rhs - go (DD.RewriteCase' lhs rhs) = PP.hang <$> sub "case" lhs <*> goNormal 0 rhs + sub kw lhs = PP.sep " " <$> sequence [pure $ control kw, goNormal Annotation lhs, pure arr] + go (DD.RewriteTerm' lhs rhs) = PP.hang <$> sub "term" lhs <*> goNormal Annotation rhs + go (DD.RewriteCase' lhs rhs) = PP.hang <$> sub "case" lhs <*> goNormal Annotation rhs go (DD.RewriteSignature' vs lhs rhs) = do lhs <- TypePrinter.pretty0 im 0 lhs PP.hang (PP.sep " " (stuff lhs)) <$> TypePrinter.pretty0 im 0 rhs @@ -534,17 +541,17 @@ pretty0 <> [fmt S.Var (PP.text (Var.name v)) | v <- vs] <> (if null vs then [] else [fmt S.TypeOperator "."]) <> [lhs, arr] - go tm = goNormal 10 tm + go tm = goNormal Application tm PP.hang kw <$> fmap PP.lines (traverse go rs) (Bytes' bs, _) -> pure $ PP.group $ fmt S.BytesLiteral "0xs" <> PP.shown (Bytes.fromWord8s (map fromIntegral bs)) app@(BinaryAppPred' f _ _) -> do - let prec = infixPrecedence f + let prec = termPrecedence f case unBinaryAppsPred' app of Just (apps, lastArg) -> do - prettyLast <- pretty0 (ac (fromMaybe (length Precedence.levels + 3) prec) Normal im doc) lastArg + prettyLast <- pretty0 (ac (fromMaybe (InfixOp Highest) prec) Normal im doc) lastArg prettyApps <- binaryApps apps prettyLast - pure $ paren (p > fromMaybe 3 prec) prettyApps + pure $ paren (p > fromMaybe (InfixOp Lowest) prec) prettyApps Nothing -> error "crash" -- let prec = fmap ((-) 9) $ termPrecedence f -- prettyF <- pretty0 (AmbientContext 10 Normal Infix im doc False) f @@ -554,19 +561,19 @@ pretty0 -- (prettyA <> " " <> prettyF <> " " <> prettyB) -- `PP.orElse` (prettyA `PP.hangUngrouped` prettyF <> " " <> prettyB) (And' a b, _) -> do - let prec = fmap ((-) 9) $ Precedence.precedence "&&" + let prec = operatorPrecedence "&&" prettyF = fmt S.ControlKeyword "&&" - prettyA <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) a - prettyB <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) b - pure . parenNoGroup (p > fromMaybe 3 prec) $ + prettyA <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) a + prettyB <- pretty0 (ac (fromMaybe (InfixOp Highest) prec) Normal im doc) b + pure . parenNoGroup (p > fromMaybe (InfixOp Lowest) prec) $ (prettyA <> " " <> prettyF <> " " <> prettyB) `PP.orElse` (prettyA `PP.hangUngrouped` prettyF <> " " <> prettyB) (Or' a b, _) -> do - let prec = fmap ((-) 9) $ Precedence.precedence "||" + let prec = operatorPrecedence "||" prettyF = fmt S.ControlKeyword "||" - prettyA <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) a - prettyB <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) b - pure . parenNoGroup (p > fromMaybe 3 prec) $ + prettyA <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) a + prettyB <- pretty0 (ac (fromMaybe (InfixOp Highest) prec) Normal im doc) b + pure . parenNoGroup (p > fromMaybe (InfixOp Lowest) prec) $ (prettyA <> " " <> prettyF <> " " <> prettyB) `PP.orElse` (prettyA `PP.hangUngrouped` prettyF <> " " <> prettyB) -- BinaryAppsPred' apps lastArg -> do @@ -597,16 +604,16 @@ pretty0 ...) -} (App' x (Constructor' (ConstructorReference DD.UnitRef 0)), _) | isLeaf x -> do - px <- pretty0 (ac (if isBlock x then 0 else 9) Normal im doc) x - pure . paren (p >= 11 || isBlock x && p >= 3) $ + px <- pretty0 (ac (if isBlock x then Annotation else InfixOp Highest) Normal im doc) x + pure . paren (p >= Prefix || isBlock x && p >= (InfixOp Lowest)) $ px <> fmt S.Unit (l "()") (Apps' f (unsnoc -> Just (args, lastArg)), _) | isSoftHangable lastArg -> do - fun <- goNormal 9 f - args' <- traverse (goNormal 10) args - lastArg' <- goNormal 0 lastArg + fun <- goNormal (InfixOp Highest) f + args' <- traverse (goNormal Application) args + lastArg' <- goNormal Annotation lastArg let softTab = PP.softbreak <> ("" `PP.orElse` " ") - pure . paren (p >= 3) $ + pure . paren (p >= (InfixOp Lowest)) $ PP.group (PP.group (PP.group (PP.sep softTab (fun : args') <> softTab)) <> lastArg') -- (Ands' xs lastArg, _) -> -- paren (p >= 10) <$> do @@ -621,28 +628,28 @@ pretty0 | binaryOpsPred f -> -- Special case for overapplied binary op do - prettyB <- pretty0 (ac 3 Normal im doc) b - prettyR <- PP.spacedTraverse (pretty0 (ac 10 Normal im doc)) r + prettyB <- pretty0 (ac (InfixOp Lowest) Normal im doc) b + prettyR <- PP.spacedTraverse (pretty0 (ac Application Normal im doc)) r prettyA <- binaryApps [(f, a)] prettyB pure $ paren True $ PP.hang prettyA prettyR AppsPred' f args -> - paren (p >= 10) <$> do - f' <- pretty0 (ac 10 Normal im doc) f - args' <- PP.spacedTraverse (pretty0 (ac 10 Normal im doc)) args + paren (p >= Application) <$> do + f' <- pretty0 (ac Application Normal im doc) f + args' <- PP.spacedTraverse (pretty0 (ac Application Normal im doc)) args pure $ f' `PP.hang` args' _other -> case (term, \v -> nonUnitArgPred v && not (isDelay term)) of (LamsNamedMatch' [] branches, _) -> do pbs <- printCase im doc branches - pure . paren (p >= 3) $ + pure . paren (p >= InfixOp Lowest) $ PP.group (fmt S.ControlKeyword "cases") `PP.hang` pbs LamsNamedPred' vs body -> do - prettyBody <- pretty0 (ac 2 Normal im doc) body + prettyBody <- pretty0 (ac Control Normal im doc) body let hang = case body of Delay' (Lets' _ _) -> PP.softHang Lets' _ _ -> PP.softHang Match' _ _ -> PP.softHang _ -> PP.hang - pure . paren (p >= 3) $ + pure . paren (p >= InfixOp Lowest) $ PP.group (varList vs <> fmt S.ControlKeyword " ->") `hang` prettyBody _other -> go term @@ -662,14 +669,14 @@ pretty0 printLet elideUnit sc bs e im uses = do bs <- traverse printBinding bs body <- body e - pure . paren (sc /= Block && p >= 12) . letIntro $ PP.lines (uses <> bs <> body) + pure . paren (sc /= Block && p >= Top) . letIntro $ PP.lines (uses <> bs <> body) where body (Constructor' (ConstructorReference DD.UnitRef 0)) | elideUnit = pure [] - body e = (: []) <$> pretty0 (ac 0 Normal im doc) e + body e = (: []) <$> pretty0 (ac Annotation Normal im doc) e printBinding (v, binding) = if Var.isAction v - then pretty0 (ac (-1) Normal im doc) binding - else renderPrettyBinding <$> prettyBinding0' (ac (-1) Normal im doc) (HQ.unsafeFromVar v) binding + then pretty0 (ac Bottom Normal im doc) binding + else renderPrettyBinding <$> prettyBinding0' (ac Bottom Normal im doc) (HQ.unsafeFromVar v) binding letIntro = case sc of Block -> id Normal -> \x -> fmt S.ControlKeyword "let" `PP.hang` x @@ -712,7 +719,7 @@ prettyPattern :: (Var v) => PrettyPrintEnv -> AmbientContext -> - Int -> + Precedence -> [v] -> Pattern loc -> (Pretty SyntaxText, [v]) @@ -739,7 +746,7 @@ prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of Pattern.Text _ t -> (fmt S.TextLiteral $ l $ show t, vs) TuplePattern pats | length pats /= 1 -> - let (pats_printed, tail_vs) = patterns (-1) vs pats + let (pats_printed, tail_vs) = patterns Bottom vs pats in (PP.parenthesizeCommas pats_printed, tail_vs) Pattern.Constructor _ ref [] -> (styleHashQualified'' (fmt $ S.TermReference conRef) name, vs) @@ -747,10 +754,10 @@ prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of name = elideFQN im $ PrettyPrintEnv.termName n conRef conRef = Referent.Con ref CT.Data Pattern.Constructor _ ref pats -> - let (pats_printed, tail_vs) = patternsSep 10 PP.softbreak vs pats + let (pats_printed, tail_vs) = patternsSep Application PP.softbreak vs pats name = elideFQN im $ PrettyPrintEnv.termName n conRef conRef = Referent.Con ref CT.Data - in ( paren (p >= 10) $ + in ( paren (p >= Application) $ styleHashQualified'' (fmt $ S.TermReference conRef) name `PP.hang` pats_printed, tail_vs @@ -758,15 +765,15 @@ prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of Pattern.As _ pat -> case vs of (v : tail_vs) -> - let (printed, eventual_tail) = prettyPattern n c 11 tail_vs pat - in (paren (p >= 11) (fmt S.Var (l $ Var.nameStr v) <> fmt S.DelimiterChar (l "@") <> printed), eventual_tail) + let (printed, eventual_tail) = prettyPattern n c Prefix tail_vs pat + in (paren (p >= Prefix) (fmt S.Var (l $ Var.nameStr v) <> fmt S.DelimiterChar (l "@") <> printed), eventual_tail) _ -> error "prettyPattern: Expected at least one var" Pattern.EffectPure _ pat -> - let (printed, eventual_tail) = prettyPattern n c (-1) vs pat + let (printed, eventual_tail) = prettyPattern n c Bottom vs pat in (PP.sep " " [fmt S.DelimiterChar "{", printed, fmt S.DelimiterChar "}"], eventual_tail) Pattern.EffectBind _ ref pats k_pat -> - let (pats_printed, tail_vs) = patternsSep 10 PP.softbreak vs pats - (k_pat_printed, eventual_tail) = prettyPattern n c 0 tail_vs k_pat + let (pats_printed, tail_vs) = patternsSep Application PP.softbreak vs pats + (k_pat_printed, eventual_tail) = prettyPattern n c Annotation tail_vs k_pat name = elideFQN im $ PrettyPrintEnv.termName n conRef conRef = Referent.Con ref CT.Effect in ( PP.group @@ -782,16 +789,16 @@ prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of eventual_tail ) Pattern.SequenceLiteral _ pats -> - let (pats_printed, tail_vs) = patternsSep (-1) (fmt S.DelimiterChar ", ") vs pats + let (pats_printed, tail_vs) = patternsSep Bottom (fmt S.DelimiterChar ", ") vs pats in (fmt S.DelimiterChar "[" <> pats_printed <> fmt S.DelimiterChar "]", tail_vs) Pattern.SequenceOp _ l op r -> let (pl, lvs) = prettyPattern n c p vs l - (pr, rvs) = prettyPattern n c (p + 1) lvs r + (pr, rvs) = prettyPattern n c (increment p) lvs r f i s = (paren (p >= i) (pl <> " " <> fmt (S.Op op) s <> " " <> pr), rvs) in case op of - Pattern.Cons -> f 0 "+:" - Pattern.Snoc -> f 0 ":+" - Pattern.Concat -> f 0 "++" + Pattern.Cons -> f Annotation "+:" + Pattern.Snoc -> f Annotation ":+" + Pattern.Concat -> f Annotation "++" where l :: (IsString s) => String -> s l = fromString @@ -874,14 +881,14 @@ printCase im doc ms0 = grid = traverse go ms patLhs env vs pats = case pats of - [pat] -> PP.group (fst (prettyPattern env (ac 0 Block im doc) (-1) vs pat)) + [pat] -> PP.group (fst (prettyPattern env (ac Annotation Block im doc) Bottom vs pat)) pats -> PP.group . PP.sep (PP.indentAfterNewline " " $ "," <> PP.softbreak) . (`evalState` vs) . for pats $ \pat -> do vs <- State.get - let (p, rem) = prettyPattern env (ac 0 Block im doc) (-1) vs pat + let (p, rem) = prettyPattern env (ac Annotation Block im doc) Bottom vs pat State.put rem pure p arrow = fmt S.ControlKeyword "->" @@ -904,8 +911,8 @@ printCase im doc ms0 = -- strip off any Abs-chain around the guard, guard variables are rendered -- like any other variable, ex: case Foo x y | x < y -> ... PP.spaceIfNeeded (fmt S.DelimiterChar "|") - <$> pretty0 (ac 2 Normal im doc) g - printBody = pretty0 (ac 0 Block im doc) + <$> pretty0 (ac Control Normal im doc) g + printBody = pretty0 (ac Annotation Block im doc) -- A pretty term binding, split into the type signature (possibly empty) and the term. data PrettyBinding = PrettyBinding @@ -964,7 +971,7 @@ prettyBinding_ :: Term2 v at ap v a -> Pretty SyntaxText prettyBinding_ go ppe n tm = - runPretty (avoidShadowing tm ppe) . fmap go $ prettyBinding0 (ac (-2) Block Map.empty MaybeDoc) n tm + runPretty (avoidShadowing tm ppe) . fmap go $ prettyBinding0 (ac Basement Block Map.empty MaybeDoc) n tm prettyBinding' :: (Var v) => @@ -1165,12 +1172,12 @@ isSymbolic = maybe False Name.isSymboly . HQ.toName emptyAc :: AmbientContext -emptyAc = ac (-1) Normal Map.empty MaybeDoc +emptyAc = ac Bottom Normal Map.empty MaybeDoc emptyBlockAc :: AmbientContext -emptyBlockAc = ac (-1) Block Map.empty MaybeDoc +emptyBlockAc = ac Bottom Block Map.empty MaybeDoc -ac :: Int -> BlockContext -> Imports -> DocLiteralContext -> AmbientContext +ac :: Precedence -> BlockContext -> Imports -> DocLiteralContext -> AmbientContext ac prec bc im doc = AmbientContext prec bc NonInfix im doc False fmt :: S.Element r -> Pretty (S.SyntaxText' r) -> Pretty (S.SyntaxText' r) @@ -2254,7 +2261,3 @@ isLeaf (Constructor' {}) = True isLeaf (Request' {}) = True isLeaf (Ref' {}) = True isLeaf _ = False - --- | Indicates this is the RHS of a top-level definition. -isTopLevelPrecedence :: Int -> Bool -isTopLevelPrecedence i = i == -2 From 29981373eedbed80a1102afe451367a262a72df2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Sat, 17 Aug 2024 22:02:41 -0400 Subject: [PATCH 591/631] Transcripts --- .../boolean-op-pretty-print-2819.output.md | 4 ++-- unison-src/transcripts/builtins.md | 16 ++++++++-------- unison-src/transcripts/builtins.output.md | 16 ++++++++-------- 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/unison-src/transcripts/boolean-op-pretty-print-2819.output.md b/unison-src/transcripts/boolean-op-pretty-print-2819.output.md index b840f4bbc0..1609f89a39 100644 --- a/unison-src/transcripts/boolean-op-pretty-print-2819.output.md +++ b/unison-src/transcripts/boolean-op-pretty-print-2819.output.md @@ -31,7 +31,7 @@ scratch/main> view hangExample hangExample : Boolean hangExample = - ("a long piece of text to hang the line" == "") - && ("a long piece of text to hang the line" == "") + "a long piece of text to hang the line" == "" + && "a long piece of text to hang the line" == "" ``` diff --git a/unison-src/transcripts/builtins.md b/unison-src/transcripts/builtins.md index 6834b85eb1..5f6a154fac 100644 --- a/unison-src/transcripts/builtins.md +++ b/unison-src/transcripts/builtins.md @@ -170,17 +170,17 @@ scratch/main> add ```unison:hide test> Boolean.tests.orTable = checks [ - true || true == true, - true || false == true, - false || true == true, - false || false == false + (true || true) == true, + (true || false) == true, + (false || true) == true, + (false || false) == false ] test> Boolean.tests.andTable = checks [ - true && true == true, - false && true == false, - true && false == false, - false && false == false + (true && true) == true, + (false && true) == false, + (true && false) == false, + (false && false) == false ] test> Boolean.tests.notTable = checks [ diff --git a/unison-src/transcripts/builtins.output.md b/unison-src/transcripts/builtins.output.md index 3a4538f30a..efa1f53afa 100644 --- a/unison-src/transcripts/builtins.output.md +++ b/unison-src/transcripts/builtins.output.md @@ -157,17 +157,17 @@ test> Nat.tests.conversions = ``` unison test> Boolean.tests.orTable = checks [ - true || true == true, - true || false == true, - false || true == true, - false || false == false + (true || true) == true, + (true || false) == true, + (false || true) == true, + (false || false) == false ] test> Boolean.tests.andTable = checks [ - true && true == true, - false && true == false, - true && false == false, - false && false == false + (true && true) == true, + (false && true) == false, + (true && false) == false, + (false && false) == false ] test> Boolean.tests.notTable = checks [ From 3e896408e955db61ce15a0fb0cd5b600de5b755a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Sat, 17 Aug 2024 22:03:57 -0400 Subject: [PATCH 592/631] transcripts --- .../transcripts/dependents-dependencies-debugfile.output.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-src/transcripts/dependents-dependencies-debugfile.output.md b/unison-src/transcripts/dependents-dependencies-debugfile.output.md index a02c491694..f7398fd480 100644 --- a/unison-src/transcripts/dependents-dependencies-debugfile.output.md +++ b/unison-src/transcripts/dependents-dependencies-debugfile.output.md @@ -23,7 +23,7 @@ scratch/main> debug.file type outside.A#6l6krl7n4l type outside.B#eo6rj0lj1b inside.p#htoo5rnb54 - inside.q#vtdbqaojv6 + inside.q#1mqcoh3tnk inside.r#nkgohbke6n outside.c#f3lgjvjqoo outside.d#ukd7tu6kds From d242ae9353dd9ee2f7c597e1b902979579844b50 Mon Sep 17 00:00:00 2001 From: Brian McKenna Date: Tue, 20 Aug 2024 11:20:06 +0000 Subject: [PATCH 593/631] Fix UI on Windows The quotes seem to be preventing the UI from loading on my system and quotes are not needed in this situation in Batch. --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index db53c80ac0..6c16a0924a 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -246,7 +246,7 @@ jobs: file: ucm.cmd content: | @echo off - SET UCM_WEB_UI="%~dp0ui" + SET UCM_WEB_UI=%~dp0ui "%~dp0unison\unison.exe" --runtime-path "%~dp0runtime\unison-runtime.exe" %* - name: package everything together run: | From f48880ff424a70631eac118ebb4da5e7c3dadc62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Tue, 20 Aug 2024 08:29:53 -0400 Subject: [PATCH 594/631] More parens for do blocks --- parser-typechecker/src/Unison/Syntax/TermPrinter.hs | 5 +++-- unison-src/transcripts-round-trip/main.output.md | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index 8a8a9dbbaa..b500d37f78 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -497,7 +497,7 @@ pretty0 _ -> undefined r p a f = sequenceA - [ pretty0 (ac (if isBlock a then Top else (fromMaybe p (termPrecedence f))) Normal im doc) a, + [ pretty0 (ac (if isBlock a then Top else fromMaybe p (termPrecedence f)) Normal im doc) a, pretty0 (AmbientContext Application Normal Infix im doc False) f ] @@ -1670,13 +1670,14 @@ isDestructuringBind scrutinee [MatchCase pat _ (ABT.AbsN' vs _)] = Pattern.Unbound _ -> False isDestructuringBind _ _ = False -isBlock :: (Ord v) => Term2 vt at ap v a -> Bool +isBlock :: (Var v, Ord v) => Term2 vt at ap v a -> Bool isBlock tm = case tm of If' {} -> True Handle' _ _ -> True Match' _ _ -> True LetBlock _ _ -> True + DDelay' _ -> True _ -> False pattern LetBlock :: diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index def5266331..9ca7bab026 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -590,8 +590,8 @@ softhang22 = softhang2 [0, 1, 2, 3, 4, 5] cases softhang23 : 'Nat softhang23 = do - use Nat + catchAll do + use Nat + x = 1 y = 2 x + y From b64ac8be62c306afba1d69faef57943a8947d052 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Tue, 20 Aug 2024 08:34:42 -0400 Subject: [PATCH 595/631] Get rid of commented-out code --- .../src/Unison/Syntax/TermPrinter.hs | 47 ------------------- 1 file changed, 47 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index b500d37f78..66829e0021 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -553,13 +553,6 @@ pretty0 prettyApps <- binaryApps apps prettyLast pure $ paren (p > fromMaybe (InfixOp Lowest) prec) prettyApps Nothing -> error "crash" - -- let prec = fmap ((-) 9) $ termPrecedence f - -- prettyF <- pretty0 (AmbientContext 10 Normal Infix im doc False) f - -- prettyA <- pretty0 (ac (fromMaybe 3 prec) Normal im doc) a - -- prettyB <- pretty0 (ac (fromMaybe (length Precedence.levels + 3) prec) Normal im doc) b - -- pure . parenNoGroup (p > fromMaybe 3 prec) $ - -- (prettyA <> " " <> prettyF <> " " <> prettyB) - -- `PP.orElse` (prettyA `PP.hangUngrouped` prettyF <> " " <> prettyB) (And' a b, _) -> do let prec = operatorPrecedence "&&" prettyF = fmt S.ControlKeyword "&&" @@ -576,13 +569,6 @@ pretty0 pure . parenNoGroup (p > fromMaybe (InfixOp Lowest) prec) $ (prettyA <> " " <> prettyF <> " " <> prettyB) `PP.orElse` (prettyA `PP.hangUngrouped` prettyF <> " " <> prettyB) - -- BinaryAppsPred' apps lastArg -> do - -- prettyLast <- pretty0 (ac 3 Normal im doc) lastArg - -- prettyApps <- binaryApps apps prettyLast - -- pure $ paren (p >= 3) prettyApps - -- Note that && and || are at the same precedence, which can cause - -- confusion, so for clarity we do not want to elide the parentheses in a - -- case like `(x || y) && z`. {- When a delayed computation block is passed to a function as the last argument in a context where the ambient precedence is low enough, we can elide parentheses @@ -615,14 +601,6 @@ pretty0 let softTab = PP.softbreak <> ("" `PP.orElse` " ") pure . paren (p >= (InfixOp Lowest)) $ PP.group (PP.group (PP.group (PP.sep softTab (fun : args') <> softTab)) <> lastArg') - -- (Ands' xs lastArg, _) -> - -- paren (p >= 10) <$> do - -- lastArg' <- pretty0 (ac 10 Normal im doc) lastArg - -- booleanOps (fmt S.ControlKeyword "&&") xs lastArg' - -- (Ors' xs lastArg, _) -> - -- paren (p >= 10) <$> do - -- lastArg' <- pretty0 (ac 10 Normal im doc) lastArg - -- booleanOps (fmt S.ControlKeyword "||") xs lastArg' _other -> case (term, nonForcePred) of OverappliedBinaryAppPred' f a b r | binaryOpsPred f -> @@ -689,31 +667,6 @@ pretty0 nonUnitArgPred :: (Var v) => v -> Bool nonUnitArgPred v = Var.name v /= "()" --- -- Render sequence of infix &&s or ||s, like [x2, x1], --- -- meaning (x1 && x2) && (x3 rendered by the caller), producing --- -- "x1 && x2 &&". The result is built from the right. --- booleanOps :: --- Pretty SyntaxText -> --- [Term3 v PrintAnnotation] -> --- Pretty SyntaxText -> --- m (Pretty SyntaxText) --- booleanOps op xs last = do --- ps <- join <$> traverse r (reverse xs) --- let unbroken = PP.spaced (ps <> [last]) --- broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last] --- pure (unbroken `PP.orElse` broken) --- where --- psCols ps = case take 2 ps of --- [x, y] -> (x, y) : psCols (drop 2 ps) --- [x] -> [(x, "")] --- [] -> [] --- _ -> undefined --- r a = --- sequence --- [ pretty0 (ac (if isBlock a then 12 else 10) Normal im doc) a, --- pure op --- ] - prettyPattern :: forall v loc. (Var v) => From 3e40cb174f116462766dcd51e1241e25f5df63bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Tue, 20 Aug 2024 08:47:17 -0400 Subject: [PATCH 596/631] Add roundtrip tests --- .../transcripts-round-trip/main.output.md | 40 ++++++++++++++++++- .../reparses-with-same-hash.u | 30 ++++++++++++++ 2 files changed, 69 insertions(+), 1 deletion(-) diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index 9ca7bab026..d11b9e210d 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -24,7 +24,7 @@ scratch/a1> edit 1-1000 ☝️ - I added 110 definitions to the top of scratch.u + I added 111 definitions to the top of scratch.u You can edit them there, then run `update` to replace the definitions currently in this namespace. @@ -122,6 +122,44 @@ ex3a = a = do qux3 + qux3 () +fixity : '('()) +fixity = + do + use Nat * + + (===) = (==) + f <| x = f x + (<<) f g x = f (g x) + (>>) f g x = g (f x) + id x = x + (do + (%) = Nat.mod + ($) = (+) + c = 1 * (2 + 3) * 4 + d = true && (false || true) + z = true || false && true + e = 1 + 2 >= 3 + 4 + f = 9 % 2 === 0 + g = 0 == 9 % 2 + h = 2 * (10 $ 20) + i1 = 1 * 2 $ (3 * 4) $ 5 + i2 = (1 * 2 $ 3) * 4 $ 5 + oo = (2 * 10 $ 20) * 30 $ 40 + ffffffffffffffffffff x = x + 1 + gg x = x * 2 + j = 10 |> ffffffffffffffffffff |> gg |> gg |> gg |> gg |> gg + k = ffffffffffffffffffff << gg << ffffffffffffffffffff <| 10 + l = 10 |> (ffffffffffffffffffff >> gg >> ffffffffffffffffffff) + zzz = 1 + 2 * 3 < 4 + 5 * 6 && 7 + 8 * 9 > 10 + 11 * 12 + zz = + (1 * 2 + 3 * 3 < 4 + 5 * 6 && 7 + 8 * 9 > 10 + 11 * 12) + === (1 + 3 * 3 < 4 + 5 * 6 && 7 + 8 * 9 > 10 + 11 * 12) + zzzz = + 1 * 2 + 3 * 3 < 4 + 5 * 6 + && 7 + 8 * 9 > 10 + 11 * 12 === 1 + 3 * 3 < 4 + 5 * 6 + && 7 + 8 * 9 > 10 + 11 * 12 + ()) + |> id + fix_1035 : Text fix_1035 = use Text ++ diff --git a/unison-src/transcripts-round-trip/reparses-with-same-hash.u b/unison-src/transcripts-round-trip/reparses-with-same-hash.u index 5d75eff442..8aac55c727 100644 --- a/unison-src/transcripts-round-trip/reparses-with-same-hash.u +++ b/unison-src/transcripts-round-trip/reparses-with-same-hash.u @@ -594,3 +594,33 @@ fix_4729c = {{ }}) {{ This is a callout with a title }} ``` }} + +fixity = do + (===) = (##Universal.==) + (<|) f x = f x + (<<) f g x = f (g x) + (>>) f g x = g (f x) + id x = x + (do + (%) = Nat.mod + ($) = (Nat.+) + c = 1 * (2 + 3) * 4 + d = true && let false || true + z = true || false && true + e = 1 + 2 >= (3 + 4) + f = 9 % 2 === 0 + g = 0 == (9 % 2) + h = 2 * (10 $ 20) + i1 = 1 * 2 $ (3 * 4) $ 5 + i2 = 1 * 2 $ 3 * 4 $ 5 + oo = (((2 * 10) $ 20) * 30) $ 40 + ffffffffffffffffffff x = x + 1 + gg x = x * 2 + j = 10 |> ffffffffffffffffffff |> gg |> gg |> gg |> gg |> gg + k = ffffffffffffffffffff << gg << ffffffffffffffffffff <| 10 + l = 10 |> (ffffffffffffffffffff >> gg >> ffffffffffffffffffff) + zzz = ((1 + (2 * 3)) < (4 + (5 * 6))) && ((((7 + (8 * 9)) > ((10 + (11 * 12)))))) + zz = (1 * 2 + 3 * 3 < (4 + 5 * 6) && ((7 + 8 * 9) > (10 + 11 * 12))) === (1 + 3 * 3 < (4 + 5 * 6) && (7 + 8 * 9 > (10 + 11 * 12))) + zzzz = 1 * 2 + 3 * 3 < 4 + 5 * 6 && 7 + 8 * 9 > 10 + 11 * 12 === 1 + 3 * 3 < 4 + 5 * 6 && 7 + 8 * 9 > 10 + 11 * 12 + () + ) |> id From b1a4d73ece46feb86309f6ac7681ad06fb2c3706 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 20 Aug 2024 11:38:43 -0600 Subject: [PATCH 597/631] Fix dev-ui-install.sh MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit I ran into this when i tried running it in a non-POSIX shell. Nothing happened. Bash, when asked to run a script without a shebang will interpret it itself, while other shells behave differently (and I think this even depends on the OS – BSD (like macOS) & Linux handle `execvp` differently). This adds a shebang and some “strict” settings. --- dev-ui-install.sh | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/dev-ui-install.sh b/dev-ui-install.sh index a9f3d5d64d..0ade79bf2a 100755 --- a/dev-ui-install.sh +++ b/dev-ui-install.sh @@ -1,3 +1,6 @@ +#!/usr/bin/env sh +set -eu + echo "This script downloads the latest Unison Local UI release" echo "and puts it in the correct spot next to the unison" echo "executable built by stack." @@ -7,4 +10,4 @@ stack build curl -L https://github.com/unisonweb/unison-local-ui/releases/download/latest/unisonLocal.zip --output unisonLocal.zip parent_dir="$(dirname -- $(stack exec which unison))" mkdir -p "$parent_dir/ui" -unzip -o unisonLocal.zip -d "$parent_dir/ui" +unzip -q -o unisonLocal.zip -d "$parent_dir/ui" From 4c166f05d38d8879b6acec9bb1ca4b86afebd5e8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Tue, 20 Aug 2024 13:58:50 -0400 Subject: [PATCH 598/631] Add exponentiation operators --- parser-typechecker/src/Unison/Syntax/Precedence.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Syntax/Precedence.hs b/parser-typechecker/src/Unison/Syntax/Precedence.hs index e5f7bd757d..2a74b1181f 100644 --- a/parser-typechecker/src/Unison/Syntax/Precedence.hs +++ b/parser-typechecker/src/Unison/Syntax/Precedence.hs @@ -62,7 +62,8 @@ infixLevels = ["==", "!==", "!=", "==="], ["<", ">", ">=", "<="], ["+", "-"], - ["*", "/", "%"] + ["*", "/", "%"], + ["^", "^^", "**"] ] -- | Returns the precedence of an infix operator, if it has one. From cc80583f2f743980cb040505271c800ee5c2993f Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Tue, 20 Aug 2024 16:54:37 -0600 Subject: [PATCH 599/631] Add a transcript to show that #4711 has been fixed Closes #4711. --- unison-src/transcripts/fix4711.md | 19 ++++++++ unison-src/transcripts/fix4711.output.md | 57 ++++++++++++++++++++++++ 2 files changed, 76 insertions(+) create mode 100644 unison-src/transcripts/fix4711.md create mode 100644 unison-src/transcripts/fix4711.output.md diff --git a/unison-src/transcripts/fix4711.md b/unison-src/transcripts/fix4711.md new file mode 100644 index 0000000000..a670fe1016 --- /dev/null +++ b/unison-src/transcripts/fix4711.md @@ -0,0 +1,19 @@ +# Delayed Int literal doesn't round trip + +```ucm:hide +scratch/main> builtins.merge +``` + +```unison +thisWorks = '(+1) + +thisDoesNotWork = ['(+1)] +``` + +Since this is fixed, `thisDoesNotWork` now does work. + +```ucm +scratch/main> add +scratch/main> edit thisWorks thisDoesNotWork +scratch/main> load +``` diff --git a/unison-src/transcripts/fix4711.output.md b/unison-src/transcripts/fix4711.output.md new file mode 100644 index 0000000000..3360bac85c --- /dev/null +++ b/unison-src/transcripts/fix4711.output.md @@ -0,0 +1,57 @@ +# Delayed Int literal doesn't round trip + +``` unison +thisWorks = '(+1) + +thisDoesNotWork = ['(+1)] +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + thisDoesNotWork : ['{g} Int] + thisWorks : 'Int + +``` +Since this is fixed, `thisDoesNotWork` now does work. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + thisDoesNotWork : ['{g} Int] + thisWorks : 'Int + +scratch/main> edit thisWorks thisDoesNotWork + + ☝️ + + I added 2 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. + +scratch/main> load + + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. + +``` +``` unison:added-by-ucm scratch.u +thisDoesNotWork : ['{g} Int] +thisDoesNotWork = [do +1] + +thisWorks : 'Int +thisWorks = do +1 +``` + From a7a80c90e7caae52c049ea2ec50450024ff2bfaa Mon Sep 17 00:00:00 2001 From: Brian McKenna Date: Wed, 21 Aug 2024 00:47:52 +0000 Subject: [PATCH 600/631] Add puffnfresh to contributors --- CONTRIBUTORS.markdown | 1 + 1 file changed, 1 insertion(+) diff --git a/CONTRIBUTORS.markdown b/CONTRIBUTORS.markdown index 5649b15dd0..e35d40033b 100644 --- a/CONTRIBUTORS.markdown +++ b/CONTRIBUTORS.markdown @@ -87,3 +87,4 @@ The format for this list: name, GitHub handle * Dan Doel (@dolio) * Eric Torreborre (@etorreborre) * Eduard Nicodei (@neduard) +* Brian McKenna (@puffnfresh) From c8414eb9cecba34541288c089ac50a604cc9c7d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Wed, 21 Aug 2024 00:39:07 -0400 Subject: [PATCH 601/631] Simpler infix printer --- .../src/Unison/Syntax/TermPrinter.hs | 160 +++++++++--------- 1 file changed, 79 insertions(+), 81 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index 66829e0021..4bca67bdcf 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -439,67 +439,67 @@ pretty0 . NameSegment.toEscapedText . Name.lastSegment _ -> Nothing - unBinaryAppsPred' :: - ( Term3 v PrintAnnotation, - Term3 v PrintAnnotation -> Bool - ) -> - Maybe - ( [ ( Term3 v PrintAnnotation, - Term3 v PrintAnnotation - ) - ], - Term3 v PrintAnnotation - ) - unBinaryAppsPred' (t, isInfix) = - go t isInfix - where - go t pred = - case unBinaryAppPred (t, pred) of - Just (f, x, y) -> - let precf = termPrecedence f - -- We only chain together infix operators if they have - -- higher precedence (lower raw precedence) than the - -- current operator. If there is no precedence, we only - -- chain if it's literally the same operator. - inChain compare g = isInfix g && (fromMaybe (g == f) $ compare <$> termPrecedence g <*> precf) - l = unBinaryAppsPred' (x, inChain (>=)) - r = unBinaryAppsPred' (y, inChain (>)) - in case (l, r) of - (Just (as, xLast), Just (bs, yLast)) -> Just (bs ++ ((xLast, f) : as), yLast) - (Just (as, xLast), Nothing) -> Just ((xLast, f) : as, y) - (Nothing, Just (bs, yLast)) -> Just (bs ++ [(x, f)], yLast) - (Nothing, Nothing) -> Just ([(x, f)], y) - Nothing -> Nothing - - -- Render a binary infix operator sequence, like [(a2, f2), (a1, f1)], - -- meaning (a1 `f1` a2) `f2` (a3 rendered by the caller), producing - -- "a1 `f1` a2 `f2`". Except the operators are all symbolic, so we won't - -- produce any backticks. We build the result out from the right, - -- starting at `f2`. - binaryApps :: - [(Term3 v PrintAnnotation, Term3 v PrintAnnotation)] -> - Pretty SyntaxText -> - m (Pretty SyntaxText) - binaryApps xs last = - do - let xs' = reverse xs - psh <- join <$> traverse (uncurry (r (InfixOp Lowest))) (take 1 xs') - pst <- join <$> traverse (uncurry (r (InfixOp Highest))) (drop 1 xs') - let ps = psh <> pst - let unbroken = PP.spaced (ps <> [last]) - broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last] - pure (unbroken `PP.orElse` broken) - where - psCols ps = case take 2 ps of - [x, y] -> (x, y) : psCols (drop 2 ps) - [x] -> [(x, "")] - [] -> [] - _ -> undefined - r p a f = - sequenceA - [ pretty0 (ac (if isBlock a then Top else fromMaybe p (termPrecedence f)) Normal im doc) a, - pretty0 (AmbientContext Application Normal Infix im doc False) f - ] + -- unBinaryAppsPred' :: + -- ( Term3 v PrintAnnotation, + -- Term3 v PrintAnnotation -> Bool + -- ) -> + -- Maybe + -- ( [ ( Term3 v PrintAnnotation, + -- Term3 v PrintAnnotation + -- ) + -- ], + -- Term3 v PrintAnnotation + -- ) + -- unBinaryAppsPred' (t, isInfix) = + -- go t isInfix + -- where + -- go t pred = + -- case unBinaryAppPred (t, pred) of + -- Just (f, x, y) -> + -- let precf = termPrecedence f + -- -- We only chain together infix operators if they have + -- -- higher precedence (lower raw precedence) than the + -- -- current operator. If there is no precedence, we only + -- -- chain if it's literally the same operator. + -- inChain compare g = isInfix g && (fromMaybe (g == f) $ compare <$> termPrecedence g <*> precf) + -- l = unBinaryAppsPred' (x, inChain (>=)) + -- r = unBinaryAppsPred' (y, inChain (>)) + -- in case (l, r) of + -- (Just (as, xLast), Just (bs, yLast)) -> Just (bs ++ ((xLast, f) : as), yLast) + -- (Just (as, xLast), Nothing) -> Just ((xLast, f) : as, y) + -- (Nothing, Just (bs, yLast)) -> Just (bs ++ [(x, f)], yLast) + -- (Nothing, Nothing) -> Just ([(x, f)], y) + -- Nothing -> Nothing + + -- Render a binary infix operator sequence, like [(a2, f2), (a1, f1)], + -- meaning (a1 `f1` a2) `f2` (a3 rendered by the caller), producing + -- "a1 `f1` a2 `f2`". Except the operators are all symbolic, so we won't + -- produce any backticks. We build the result out from the right, + -- starting at `f2`. + -- binaryApps :: + -- [(Term3 v PrintAnnotation, Term3 v PrintAnnotation)] -> + -- Pretty SyntaxText -> + -- m (Pretty SyntaxText) + -- binaryApps xs last = + -- do + -- let xs' = reverse xs + -- psh <- join <$> traverse (uncurry (r (InfixOp Lowest))) (take 1 xs') + -- pst <- join <$> traverse (uncurry (r (InfixOp Highest))) (drop 1 xs') + -- let ps = psh <> pst + -- let unbroken = PP.spaced (ps <> [last]) + -- broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last] + -- pure (unbroken `PP.orElse` broken) + -- where + -- psCols ps = case take 2 ps of + -- [x, y] -> (x, y) : psCols (drop 2 ps) + -- [x] -> [(x, "")] + -- [] -> [] + -- _ -> undefined + -- r p a f = + -- sequenceA + -- [ pretty0 (ac (if isBlock a then Top else fromMaybe p (termPrecedence f)) Normal im doc) a, + -- pretty0 (AmbientContext Application Normal Infix im doc False) f + -- ] case (term, binaryOpsPred) of (DD.Doc, _) @@ -545,29 +545,27 @@ pretty0 PP.hang kw <$> fmap PP.lines (traverse go rs) (Bytes' bs, _) -> pure $ PP.group $ fmt S.BytesLiteral "0xs" <> PP.shown (Bytes.fromWord8s (map fromIntegral bs)) - app@(BinaryAppPred' f _ _) -> do + BinaryAppPred' f a b -> do let prec = termPrecedence f - case unBinaryAppsPred' app of - Just (apps, lastArg) -> do - prettyLast <- pretty0 (ac (fromMaybe (InfixOp Highest) prec) Normal im doc) lastArg - prettyApps <- binaryApps apps prettyLast - pure $ paren (p > fromMaybe (InfixOp Lowest) prec) prettyApps - Nothing -> error "crash" + prettyF <- pretty0 (AmbientContext Application Normal Infix im doc False) f + prettyA <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) a + prettyB <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) b + pure . parenNoGroup (p > fromMaybe (InfixOp Lowest) prec) $ + (prettyA <> " " <> prettyF <> " " <> prettyB) `PP.orElse` (prettyA `PP.hangUngrouped` (PP.column2 [(prettyF, prettyB)])) (And' a b, _) -> do let prec = operatorPrecedence "&&" prettyF = fmt S.ControlKeyword "&&" prettyA <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) a - prettyB <- pretty0 (ac (fromMaybe (InfixOp Highest) prec) Normal im doc) b + prettyB <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) b pure . parenNoGroup (p > fromMaybe (InfixOp Lowest) prec) $ - (prettyA <> " " <> prettyF <> " " <> prettyB) - `PP.orElse` (prettyA `PP.hangUngrouped` prettyF <> " " <> prettyB) + (prettyA <> " " <> prettyF <> " " <> prettyB) `PP.orElse` (prettyA `PP.hangUngrouped` (PP.column2 [(prettyF, prettyB)])) (Or' a b, _) -> do let prec = operatorPrecedence "||" prettyF = fmt S.ControlKeyword "||" prettyA <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) a - prettyB <- pretty0 (ac (fromMaybe (InfixOp Highest) prec) Normal im doc) b + prettyB <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) b pure . parenNoGroup (p > fromMaybe (InfixOp Lowest) prec) $ - (prettyA <> " " <> prettyF <> " " <> prettyB) + PP.group (prettyA <> " " <> prettyF <> " " <> prettyB) `PP.orElse` (prettyA `PP.hangUngrouped` prettyF <> " " <> prettyB) {- When a delayed computation block is passed to a function as the last argument @@ -602,14 +600,14 @@ pretty0 pure . paren (p >= (InfixOp Lowest)) $ PP.group (PP.group (PP.group (PP.sep softTab (fun : args') <> softTab)) <> lastArg') _other -> case (term, nonForcePred) of - OverappliedBinaryAppPred' f a b r - | binaryOpsPred f -> - -- Special case for overapplied binary op - do - prettyB <- pretty0 (ac (InfixOp Lowest) Normal im doc) b - prettyR <- PP.spacedTraverse (pretty0 (ac Application Normal im doc)) r - prettyA <- binaryApps [(f, a)] prettyB - pure $ paren True $ PP.hang prettyA prettyR + -- OverappliedBinaryAppPred' f a b r + -- | binaryOpsPred f -> + -- -- Special case for overapplied binary op + -- do + -- prettyB <- pretty0 (ac (InfixOp Lowest) Normal im doc) b + -- prettyR <- PP.spacedTraverse (pretty0 (ac Application Normal im doc)) r + -- prettyA <- binaryApps [(f, a)] prettyB + -- pure $ paren True $ PP.hang prettyA prettyR AppsPred' f args -> paren (p >= Application) <$> do f' <- pretty0 (ac Application Normal im doc) f From 035e800a2a41be5416f855069fec69fb388d3cc1 Mon Sep 17 00:00:00 2001 From: SimaDovakin Date: Wed, 21 Aug 2024 18:29:54 +0300 Subject: [PATCH 602/631] Added support of the binary notation for Nat and Int. --- parser-typechecker/src/Unison/PrintError.hs | 12 ++++++++++++ unison-src/transcripts/error-messages.md | 6 +++++- .../transcripts/error-messages.output.md | 18 +++++++++++++++++- .../src/Unison/Syntax/Lexer/Unison.hs | 7 ++++++- 4 files changed, 40 insertions(+), 3 deletions(-) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 691d7cd3ef..bbc5381c7d 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -1427,6 +1427,18 @@ renderParseErrors s = \case <> "after the" <> Pr.group (style ErrorSite "0o" <> ".") ] + L.InvalidBinaryLiteral -> + Pr.lines + [ "This number isn't valid syntax: ", + "", + excerpt, + Pr.wrap $ + "I was expecting only binary characters" + <> "(one of" + <> Pr.group (style Code "01" <> ")") + <> "after the" + <> Pr.group (style ErrorSite "0b" <> ".") + ] L.InvalidShortHash h -> Pr.lines [ "Invalid hash: " <> style ErrorSite (fromString h), diff --git a/unison-src/transcripts/error-messages.md b/unison-src/transcripts/error-messages.md index 8490e491a2..2157f9f502 100644 --- a/unison-src/transcripts/error-messages.md +++ b/unison-src/transcripts/error-messages.md @@ -37,6 +37,10 @@ x = 0xoogabooga -- invalid hex chars x = 0o987654321 -- 9 and 8 are not valid octal char ``` +```unison:error +x = 0b3201 -- 3 and 2 are not valid binary chars +``` + ```unison:error x = 0xsf -- odd number of hex chars in a bytes literal ``` @@ -81,7 +85,7 @@ foo = cases ```unison:error -- Missing a '->' x = match Some a with - None -> + None -> 1 Some _ 2 diff --git a/unison-src/transcripts/error-messages.output.md b/unison-src/transcripts/error-messages.output.md index 03e7e652ac..baa8cb54e5 100644 --- a/unison-src/transcripts/error-messages.output.md +++ b/unison-src/transcripts/error-messages.output.md @@ -103,6 +103,22 @@ x = 0o987654321 -- 9 and 8 are not valid octal char I was expecting only octal characters (one of 01234567) after the 0o. +``` +``` unison +x = 0b3201 -- 3 and 2 are not valid binary chars +``` + +``` ucm + + Loading changes detected in scratch.u. + + This number isn't valid syntax: + + 1 | x = 0b3201 -- 3 and 2 are not valid binary chars + + I was expecting only binary characters (one of 01) after the + 0b. + ``` ``` unison x = 0xsf -- odd number of hex chars in a bytes literal @@ -245,7 +261,7 @@ foo = cases ``` unison -- Missing a '->' x = match Some a with - None -> + None -> 1 Some _ 2 diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs index 9c50e2731f..2f3ff41d00 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -87,6 +87,7 @@ data Err | InvalidBytesLiteral String | InvalidHexLiteral | InvalidOctalLiteral + | InvalidBinaryLiteral | Both Err Err | MissingFractional String -- ex `1.` rather than `1.04` | MissingExponent String -- ex `1e` rather than `1e3` @@ -533,7 +534,7 @@ lexemes eof = case Bytes.fromBase16 $ Bytes.fromWord8s (fromIntegral . ord <$> s) of Left _ -> err start (InvalidBytesLiteral $ "0xs" <> s) Right bs -> pure (Bytes bs) - otherbase = octal <|> hex + otherbase = octal <|> hex <|> binary octal = do start <- posP commitAfter2 sign (lit "0o") $ \sign _ -> @@ -542,6 +543,10 @@ lexemes eof = start <- posP commitAfter2 sign (lit "0x") $ \sign _ -> fmap (num sign) LP.hexadecimal <|> err start InvalidHexLiteral + binary = do + start <- posP + commitAfter2 sign (lit "0b") $ \sign _ -> + fmap (num sign) LP.binary <|> err start InvalidBinaryLiteral num :: Maybe String -> Integer -> Lexeme num sign n = Numeric (fromMaybe "" sign <> show n) From 4c6139ae7d5d94d53b8ba85ae7325e609297ff57 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 21 Aug 2024 15:01:51 -0400 Subject: [PATCH 603/631] term name resolution tweak: don't prefer names from the file over names from the namespace --- .../src/Unison/Syntax/FileParser.hs | 36 ++------ .../src/Unison/UnisonFile/Names.hs | 69 ++------------- unison-core/src/Unison/Names/ResolvesTo.hs | 20 +++++ unison-core/src/Unison/Term.hs | 87 ++++++++----------- unison-core/src/Unison/Type/Names.hs | 23 +---- unison-core/unison-core1.cabal | 1 + 6 files changed, 80 insertions(+), 156 deletions(-) create mode 100644 unison-core/src/Unison/Names/ResolvesTo.hs diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index f2e0da2592..e899fb2c57 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -113,13 +113,8 @@ file = do let importNames = [(Name.unsafeParseVar v, Name.unsafeParseVar v2) | (v, v2) <- imports] let locals = Names.importing importNames (UF.names env) -- At this stage of the file parser, we've parsed all the type and ability - -- declarations. The `push locals` here has the effect - -- of making suffix-based name resolution prefer type and constructor names coming - -- from the local file. - -- - -- There's some more complicated logic below to have suffix-based name resolution - -- make use of _terms_ from the local file. - local (\e -> e {names = Names.push locals namesStart}) do + -- declarations. + local (\e -> e {names = Names.shadowing locals namesStart}) do names <- asks names stanzas <- do unNamespacedStanzas0 <- sepBy semi stanza @@ -155,27 +150,12 @@ file = do -- [foo.alice, bar.alice, zonk.bob] fqLocalTerms :: [v] fqLocalTerms = (stanzas >>= getVars) <> (view _1 <$> accessors) - -- suffixified local term bindings shadow any same-named thing from the outer codebase scope - -- example: `foo.bar` in local file scope will shadow `foo.bar` and `bar` in codebase scope - let (curNames, resolveLocals) = - ( Names.shadowTerms locals names, - resolveLocals - ) - where - -- Each unique suffix mapped to its fully qualified name - canonicalVars :: Map v v - canonicalVars = UFN.variableCanonicalizer fqLocalTerms - - -- All unique local term name suffixes - these we want to - -- avoid resolving to a term that's in the codebase - locals :: [Name.Name] - locals = (Name.unsafeParseVar <$> Map.keys canonicalVars) - - -- A function to replace unique local term suffixes with their - -- fully qualified name - replacements = [(v, Term.var () v2) | (v, v2) <- Map.toList canonicalVars, v /= v2] - resolveLocals = ABT.substsInheritAnnotation replacements - let bindNames = Term.bindSomeNames Name.unsafeParseVar (Set.fromList fqLocalTerms) curNames . resolveLocals + let bindNames = + Term.bindNames + Name.unsafeParseVar + Name.toVar + (Set.fromList fqLocalTerms) + (Names.shadowTerms (map Name.unsafeParseVar fqLocalTerms) names) terms <- case List.validate (traverseOf _3 bindNames) terms of Left es -> resolutionFailures (toList es) Right terms -> pure terms diff --git a/parser-typechecker/src/Unison/UnisonFile/Names.hs b/parser-typechecker/src/Unison/UnisonFile/Names.hs index 6a0d77ff12..4cbcd020fe 100644 --- a/parser-typechecker/src/Unison/UnisonFile/Names.hs +++ b/parser-typechecker/src/Unison/UnisonFile/Names.hs @@ -1,7 +1,12 @@ -module Unison.UnisonFile.Names where +module Unison.UnisonFile.Names + ( addNamesFromTypeCheckedUnisonFile, + addNamesFromUnisonFile, + environmentFor, + toNames, + typecheckedToNames, + ) +where -import Control.Lens -import Data.List.Extra (nubOrd) import Data.Map qualified as Map import Data.Set qualified as Set import Unison.ABT qualified as ABT @@ -9,7 +14,6 @@ import Unison.DataDeclaration (DataDeclaration, EffectDeclaration (..)) import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.Names qualified as DD.Names import Unison.Hashing.V2.Convert qualified as Hashing -import Unison.Name qualified as Name import Unison.Names (Names (..)) import Unison.Names.ResolutionResult qualified as Names import Unison.NamesWithHistory qualified as Names @@ -17,15 +21,12 @@ import Unison.Prelude import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.Syntax.Name qualified as Name -import Unison.Term qualified as Term import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Env (Env (..)) import Unison.UnisonFile.Error (Error (DupDataAndAbility, UnknownType)) -import Unison.UnisonFile.Type (TypecheckedUnisonFile (TypecheckedUnisonFileId), UnisonFile (UnisonFileId)) -import Unison.Util.List qualified as List +import Unison.UnisonFile.Type (TypecheckedUnisonFile, UnisonFile) import Unison.Util.Relation qualified as Relation import Unison.Var (Var) -import Unison.Var qualified as Var import Unison.WatchKind qualified as WK toNames :: (Var v) => UnisonFile v a -> Names @@ -64,58 +65,6 @@ typecheckedToNames uf = Names (terms <> ctors) types addNamesFromTypeCheckedUnisonFile :: (Var v) => TypecheckedUnisonFile v a -> Names -> Names addNamesFromTypeCheckedUnisonFile unisonFile names = Names.shadowing (typecheckedToNames unisonFile) names -typecheckedUnisonFile0 :: (Ord v) => TypecheckedUnisonFile v a -typecheckedUnisonFile0 = TypecheckedUnisonFileId Map.empty Map.empty mempty mempty mempty - --- Substitutes free type and term variables occurring in the terms of this --- `UnisonFile` using `externalNames`. --- --- Hash-qualified names are substituted during parsing, but non-HQ names are --- substituted at the end of parsing, since they can be locally bound. Example, in --- `x -> x + math.sqrt 2`, we don't know if `math.sqrt` is locally bound until --- we are done parsing, whereas `math.sqrt#abc` can be resolved immediately --- as it can't refer to a local definition. -bindNames :: - (Var v) => - Names -> - UnisonFile v a -> - Names.ResolutionResult v a (UnisonFile v a) -bindNames names (UnisonFileId d e ts ws) = do - -- todo: consider having some kind of binding structure for terms & watches - -- so that you don't weirdly have free vars to tiptoe around. - -- The free vars should just be the things that need to be bound externally. - let termVarsSet = Map.keysSet ts <> Set.fromList (Map.elems ws >>= map (view _1)) - -- todo: can we clean up this lambda using something like `second` - ts' <- traverse (\(a, t) -> (a,) <$> Term.bindNames Name.unsafeParseVar termVarsSet names t) ts - ws' <- traverse (traverse (\(v, a, t) -> (v,a,) <$> Term.bindNames Name.unsafeParseVar termVarsSet names t)) ws - pure $ UnisonFileId d e ts' ws' - --- | Given the set of fully-qualified variable names, this computes --- a Map from unique suffixes to the fully qualified name. --- --- Example, given [foo.bar, qux.bar, baz.quaffle], this returns: --- --- Map [ foo.bar -> foo.bar --- , qux.bar -> qux.bar --- , baz.quaffle -> baz.quaffle --- , quaffle -> baz.quaffle --- ] --- --- This is used to replace variable references with their canonical --- fully qualified variables. --- --- It's used below in `environmentFor` and also during the term resolution --- process. -variableCanonicalizer :: forall v. (Var v) => [v] -> Map v v -variableCanonicalizer vs = - done $ List.multimap do - v <- vs - let n = Name.unsafeParseVar v - suffix <- Name.suffixes n - pure (Var.named (Name.toText suffix), v) - where - done xs = Map.fromList [(k, v) | (k, nubOrd -> [v]) <- Map.toList xs] <> Map.fromList [(v, v) | v <- vs] - -- This function computes hashes for data and effect declarations, and -- also returns a function for resolving strings to (Reference, ConstructorId) -- for parsing of pattern matching diff --git a/unison-core/src/Unison/Names/ResolvesTo.hs b/unison-core/src/Unison/Names/ResolvesTo.hs new file mode 100644 index 0000000000..6bb8087216 --- /dev/null +++ b/unison-core/src/Unison/Names/ResolvesTo.hs @@ -0,0 +1,20 @@ +module Unison.Names.ResolvesTo + ( ResolvesTo (..), + partitionResolutions, + ) +where + +import Unison.Name (Name) +import Unison.Prelude + +data ResolvesTo ref + = ResolvesToNamespace ref + | ResolvesToLocal Name + +partitionResolutions :: [(v, ResolvesTo ref)] -> ([(v, ref)], [(v, Name)]) +partitionResolutions = + partitionEithers . map f + where + f = \case + (v, ResolvesToNamespace ref) -> Left (v, ref) + (v, ResolvesToLocal name) -> Right (v, name) diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index 6d3ebebf76..a6886140fd 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -10,6 +10,7 @@ import Control.Monad.Writer.Strict qualified as Writer import Data.Generics.Sum (_Ctor) import Data.List qualified as List import Data.Map qualified as Map +import Data.Sequence qualified as Seq import Data.Sequence qualified as Sequence import Data.Set qualified as Set import Data.Text qualified as Text @@ -27,6 +28,7 @@ import Unison.Name qualified as Name import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names +import Unison.Names.ResolvesTo (ResolvesTo (..), partitionResolutions) import Unison.NamesWithHistory qualified as Names import Unison.Pattern (Pattern) import Unison.Pattern qualified as Pattern @@ -39,6 +41,7 @@ import Unison.Type (Type) import Unison.Type qualified as Type import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.List (multimap, validate) +import Unison.Util.Relation qualified as Relation import Unison.Var (Var) import Unison.Var qualified as Var import Unsafe.Coerce (unsafeCoerce) @@ -149,67 +152,53 @@ bindNames :: forall v a. (Var v) => (v -> Name.Name) -> + (Name.Name -> v) -> Set v -> Names -> Term v a -> Names.ResolutionResult v a (Term v a) -bindNames unsafeVarToName keepFreeTerms ns e = do - let freeTmVars = [(v, a) | (v, a) <- ABT.freeVarOccurrences keepFreeTerms e] - -- !_ = trace "bindNames.free term vars: " () - -- !_ = traceShow $ fst <$> freeTmVars +bindNames unsafeVarToName nameToVar localVars ns term = do + let freeTmVars = ABT.freeVarOccurrences localVars term freeTyVars = - [ (v, a) | (v, as) <- Map.toList (freeTypeVarAnnotations e), a <- as + [ (v, a) | (v, as) <- Map.toList (freeTypeVarAnnotations term), a <- as ] - -- !_ = trace "bindNames.free type vars: " () - -- !_ = traceShow $ fst <$> freeTyVars - okTm :: (v, a) -> Names.ResolutionResult v a (v, Term v a) - okTm (v, a) = case Names.lookupHQTerm Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns of - rs - | Set.size rs == 1 -> - pure (v, fromReferent a $ Set.findMin rs) - | Set.size rs == 0 -> Left (pure (Names.TermResolutionFailure v a Names.NotFound)) - | otherwise -> Left (pure (Names.TermResolutionFailure v a (Names.Ambiguous ns rs Set.empty))) + localNames = map unsafeVarToName (Set.toList localVars) + + okTm :: (v, a) -> Names.ResolutionResult v a (Maybe (v, ResolvesTo Referent)) + okTm (v, a) = + let name = unsafeVarToName v + exactNamespaceMatches = Names.lookupHQTerm Names.ExactName (HQ.NameOnly name) ns + suffixNamespaceMatches = Name.searchByRankedSuffix name (Names.terms ns) + localMatches = + Name.searchBySuffix name (Relation.fromList (map (\name -> (name, name)) localNames)) + in case (Set.size exactNamespaceMatches, Set.size suffixNamespaceMatches, Set.size localMatches) of + (1, _, _) -> good (ResolvesToNamespace (Set.findMin exactNamespaceMatches)) + (n, _, _) | n > 1 -> ambiguousSoLeaveFreeForTDNR + (_, 0, 0) -> bad Names.NotFound + (_, 1, 0) -> good (ResolvesToNamespace (Set.findMin suffixNamespaceMatches)) + (_, 0, 1) -> good (ResolvesToLocal (Set.findMin localMatches)) + _ -> ambiguousSoLeaveFreeForTDNR + where + good = Right . Just . (v,) + bad = Left . Seq.singleton . Names.TermResolutionFailure v a + ambiguousSoLeaveFreeForTDNR = Right Nothing + + okTy :: (v, a) -> Names.ResolutionResult v a (v, Type v a) okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns of rs | Set.size rs == 1 -> pure (v, Type.ref a $ Set.findMin rs) | Set.size rs == 0 -> Left (pure (Names.TypeResolutionFailure v a Names.NotFound)) | otherwise -> Left (pure (Names.TypeResolutionFailure v a (Names.Ambiguous ns rs Set.empty))) - termSubsts <- validate okTm freeTmVars + (namespaceTermResolutions, localTermResolutions) <- + partitionResolutions . catMaybes <$> validate okTm freeTmVars + let termSubsts = + [(v, fromReferent () ref) | (v, ref) <- namespaceTermResolutions] + ++ [(v, var () (nameToVar name)) | (v, name) <- localTermResolutions] typeSubsts <- validate okTy freeTyVars - pure . substTypeVars typeSubsts . ABT.substsInheritAnnotation termSubsts $ e - --- This function replaces free term and type variables with --- hashes found in the provided `Names`, using suffix-based --- lookup. Any terms not found in the `Names` are kept free. -bindSomeNames :: - forall v a. - (Var v) => - (v -> Name.Name) -> - Set v -> - Names -> - Term v a -> - Names.ResolutionResult v a (Term v a) --- bindSomeNames ns e | trace "Term.bindSome" False --- || trace "Names =" False --- || traceShow ns False --- || trace "Free type vars:" False --- || traceShow (freeTypeVars e) False --- || trace "Free term vars:" False --- || traceShow (freeVars e) False --- || traceShow e False --- = undefined -bindSomeNames unsafeVarToName avoid ns e = bindNames unsafeVarToName (avoid <> varsToTDNR) ns e - where - -- `Term.bindNames` takes a set of variables that are not substituted. - -- These should be the variables that will be subject to TDNR, which - -- we compute as the set of variables whose names cannot be found in `ns`. - -- - -- This allows TDNR to disambiguate those names (if multiple definitions - -- share the same suffix) or to report the type expected for that name - -- (if a free variable is being used as a typed hole). - varsToTDNR = Set.filter notFound (freeVars e) - notFound var = - Set.size (Name.searchByRankedSuffix (unsafeVarToName var) (Names.terms ns)) /= 1 + pure $ + term + & ABT.substsInheritAnnotation termSubsts + & substTypeVars typeSubsts -- Prepare a term for type-directed name resolution by replacing -- any remaining free variables with blanks to be resolved by TDNR diff --git a/unison-core/src/Unison/Type/Names.hs b/unison-core/src/Unison/Type/Names.hs index f1afbb0bc5..5bbf57fea5 100644 --- a/unison-core/src/Unison/Type/Names.hs +++ b/unison-core/src/Unison/Type/Names.hs @@ -11,6 +11,7 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names) import Unison.Names.ResolutionResult qualified as Names +import Unison.Names.ResolvesTo (ResolvesTo (..), partitionResolutions) import Unison.NamesWithHistory qualified as Names import Unison.Prelude import Unison.Reference (TypeReference) @@ -20,10 +21,6 @@ import Unison.Util.List qualified as List import Unison.Util.Relation qualified as Relation import Unison.Var (Var) -data ResolvesTo - = ResolvesToNamespace TypeReference - | ResolvesToLocal Name - bindNames :: forall a v. (Var v) => @@ -54,7 +51,7 @@ bindNames unsafeVarToName nameToVar localVars namespaceNames ty = -- -- 1. An exact match in the namespace. -- 2. A suffix match in the namespace. - -- 3. A suffix match in the local names.. + -- 3. A suffix match in the local names. resolvedVars :: [(v, a, (Set TypeReference, Set TypeReference), Set Name)] resolvedVars = map @@ -66,7 +63,7 @@ bindNames unsafeVarToName nameToVar localVars namespaceNames ty = checkAmbiguity :: (v, a, (Set TypeReference, Set TypeReference), Set Name) -> - Either (Seq (Names.ResolutionFailure v a)) (v, ResolvesTo) + Either (Seq (Names.ResolutionFailure v a)) (v, ResolvesTo TypeReference) checkAmbiguity (v, a, (exactNamespaceMatches, suffixNamespaceMatches), localMatches) = case (Set.size exactNamespaceMatches, Set.size suffixNamespaceMatches, Set.size localMatches) of (1, _, _) -> good (ResolvesToNamespace (Set.findMin exactNamespaceMatches)) @@ -79,19 +76,7 @@ bindNames unsafeVarToName nameToVar localVars namespaceNames ty = bad = Left . Seq.singleton . Names.TypeResolutionFailure v a good = Right . (v,) in List.validate checkAmbiguity resolvedVars <&> \resolutions -> - let -- Partition the resolutions into external/local - namespaceResolutions :: [(v, TypeReference)] - localResolutions :: [(v, Name)] - (namespaceResolutions, localResolutions) = - resolutions - -- Cast our nice informative ResolvesTo type to an Either, just to use `partitionEithers` - -- Is there a `partitonWith :: (a -> Either b c) -> [a] -> ([b], [c])` somewhere? - & map - ( \case - (v, ResolvesToNamespace ref) -> Left (v, ref) - (v, ResolvesToLocal name) -> Right (v, name) - ) - & partitionEithers + let (namespaceResolutions, localResolutions) = partitionResolutions resolutions in ty -- Apply namespace resolutions (replacing "Foo" with #Foo where "Foo" refers to namespace) & bindExternal namespaceResolutions diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal index f6cfed41d8..146a132d9c 100644 --- a/unison-core/unison-core1.cabal +++ b/unison-core/unison-core1.cabal @@ -43,6 +43,7 @@ library Unison.Name.Internal Unison.Names Unison.Names.ResolutionResult + Unison.Names.ResolvesTo Unison.NamesWithHistory Unison.Pattern Unison.Position From d474cf83a50e4ee9dab04c975ca405142f29baa1 Mon Sep 17 00:00:00 2001 From: SimaDovakin Date: Thu, 22 Aug 2024 16:19:12 +0300 Subject: [PATCH 604/631] Edited heading in transcripts for testing syntax error of the invalid binary chars. --- unison-src/transcripts/error-messages.md | 2 +- unison-src/transcripts/error-messages.output.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-src/transcripts/error-messages.md b/unison-src/transcripts/error-messages.md index 2157f9f502..f3b0353806 100644 --- a/unison-src/transcripts/error-messages.md +++ b/unison-src/transcripts/error-messages.md @@ -27,7 +27,7 @@ x = 1e- -- missing an exponent x = 1E+ -- missing an exponent ``` -### Hex, octal, and bytes literals +### Hex, octal, binary, and bytes literals ```unison:error x = 0xoogabooga -- invalid hex chars diff --git a/unison-src/transcripts/error-messages.output.md b/unison-src/transcripts/error-messages.output.md index baa8cb54e5..714b3c5845 100644 --- a/unison-src/transcripts/error-messages.output.md +++ b/unison-src/transcripts/error-messages.output.md @@ -70,7 +70,7 @@ x = 1E+ -- missing an exponent `1e+37`. ``` -### Hex, octal, and bytes literals +### Hex, octal, binary, and bytes literals ``` unison x = 0xoogabooga -- invalid hex chars From df14641265c71d52023a75a542c626287f45fbab Mon Sep 17 00:00:00 2001 From: SimaDovakin Date: Thu, 22 Aug 2024 16:24:21 +0300 Subject: [PATCH 605/631] Added vim syntax highlight for the numbers' binary notation. --- editor-support/vim/syntax/unison.vim | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/editor-support/vim/syntax/unison.vim b/editor-support/vim/syntax/unison.vim index ec193723a7..45ceda9f87 100644 --- a/editor-support/vim/syntax/unison.vim +++ b/editor-support/vim/syntax/unison.vim @@ -48,7 +48,7 @@ syn match uSpecialCharError contained "\\&\|'''\+" syn region uString start=+"+ skip=+\\\\\|\\"+ end=+"+ contains=uSpecialChar syn match uCharacter "[^a-zA-Z0-9_']'\([^\\]\|\\[^']\+\|\\'\)'"lc=1 contains=uSpecialChar,uSpecialCharError syn match uCharacter "^'\([^\\]\|\\[^']\+\|\\'\)'" contains=uSpecialChar,uSpecialCharError -syn match uNumber "\<[0-9]\+\>\|\<0[xX][0-9a-fA-F]\+\>\|\<0[oO][0-7]\+\>" +syn match uNumber "\<[0-9]\+\>\|\<0[xX][0-9a-fA-F]\+\>\|\<0[oO][0-7]\+\>|\<0b[01]\+\>" syn match uFloat "\<[0-9]\+\.[0-9]\+\([eE][-+]\=[0-9]\+\)\=\>" " Keyword definitions. These must be patterns instead of keywords @@ -83,7 +83,7 @@ syn region uDocDirective contained matchgroup=unisonDocDirective start="\(@ syn match uDebug "\<\(todo\|bug\|Debug.trace\)\>" -" things like +" things like " > my_func 1 3 " test> Function.tap.tests.t1 = check let " use Nat == + @@ -101,7 +101,7 @@ if version >= 508 || !exists("did_u_syntax_inits") else command -nargs=+ HiLink hi def link endif - + HiLink uWatch Debug HiLink uDocMono Delimiter HiLink unisonDocDirective Import From 3ce567525e4c9217a25e318c93cfdfec734835b4 Mon Sep 17 00:00:00 2001 From: SimaDovakin Date: Thu, 22 Aug 2024 16:30:42 +0300 Subject: [PATCH 606/631] Fixed vim syntax highlight for numbers' binary notation. --- editor-support/vim/syntax/unison.vim | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/editor-support/vim/syntax/unison.vim b/editor-support/vim/syntax/unison.vim index 45ceda9f87..bbbfa8b915 100644 --- a/editor-support/vim/syntax/unison.vim +++ b/editor-support/vim/syntax/unison.vim @@ -48,7 +48,7 @@ syn match uSpecialCharError contained "\\&\|'''\+" syn region uString start=+"+ skip=+\\\\\|\\"+ end=+"+ contains=uSpecialChar syn match uCharacter "[^a-zA-Z0-9_']'\([^\\]\|\\[^']\+\|\\'\)'"lc=1 contains=uSpecialChar,uSpecialCharError syn match uCharacter "^'\([^\\]\|\\[^']\+\|\\'\)'" contains=uSpecialChar,uSpecialCharError -syn match uNumber "\<[0-9]\+\>\|\<0[xX][0-9a-fA-F]\+\>\|\<0[oO][0-7]\+\>|\<0b[01]\+\>" +syn match uNumber "\<[0-9]\+\>\|\<0[xX][0-9a-fA-F]\+\>\|\<0[oO][0-7]\+\>\|\<0b[01]\+\>" syn match uFloat "\<[0-9]\+\.[0-9]\+\([eE][-+]\=[0-9]\+\)\=\>" " Keyword definitions. These must be patterns instead of keywords From 46672dfe0d1dfd6977926b50799ff145aa027c2d Mon Sep 17 00:00:00 2001 From: SimaDovakin Date: Thu, 22 Aug 2024 17:12:11 +0300 Subject: [PATCH 607/631] Added symbol class for consistency. --- editor-support/vim/syntax/unison.vim | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/editor-support/vim/syntax/unison.vim b/editor-support/vim/syntax/unison.vim index bbbfa8b915..3bd3b2ef68 100644 --- a/editor-support/vim/syntax/unison.vim +++ b/editor-support/vim/syntax/unison.vim @@ -48,7 +48,7 @@ syn match uSpecialCharError contained "\\&\|'''\+" syn region uString start=+"+ skip=+\\\\\|\\"+ end=+"+ contains=uSpecialChar syn match uCharacter "[^a-zA-Z0-9_']'\([^\\]\|\\[^']\+\|\\'\)'"lc=1 contains=uSpecialChar,uSpecialCharError syn match uCharacter "^'\([^\\]\|\\[^']\+\|\\'\)'" contains=uSpecialChar,uSpecialCharError -syn match uNumber "\<[0-9]\+\>\|\<0[xX][0-9a-fA-F]\+\>\|\<0[oO][0-7]\+\>\|\<0b[01]\+\>" +syn match uNumber "\<[0-9]\+\>\|\<0[xX][0-9a-fA-F]\+\>\|\<0[oO][0-7]\+\>\|\<0[bB][01]\+\>" syn match uFloat "\<[0-9]\+\.[0-9]\+\([eE][-+]\=[0-9]\+\)\=\>" " Keyword definitions. These must be patterns instead of keywords From f9113108c8b8395a5ff91f53ab4887e363bbb0f9 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 22 Aug 2024 13:12:42 -0400 Subject: [PATCH 608/631] get ambiguous term error message properly suffixifying names --- .../src/Unison/PrettyPrintEnv/Names.hs | 21 ++ .../src/Unison/Runtime/IOSource.hs | 4 +- .../src/Unison/UnisonFile/Names.hs | 4 - .../Codebase/Editor/HandleInput/Load.hs | 31 ++- unison-core/src/Unison/Names/ResolvesTo.hs | 1 + unison-src/transcripts/name-resolution.md | 89 +++++++- .../transcripts/name-resolution.output.md | 196 ++++++++++++++++-- 7 files changed, 313 insertions(+), 33 deletions(-) diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs index 5d8264202c..46d3fb220c 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs @@ -9,6 +9,7 @@ module Unison.PrettyPrintEnv.Names dontSuffixify, suffixifyByHash, suffixifyByName, + suffixifyByHashWithUnhashedTermsInScope, -- * Pretty-print env makePPE, @@ -23,11 +24,14 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names) import Unison.Names qualified as Names +import Unison.Names.ResolvesTo (ResolvesTo (..)) import Unison.NamesWithHistory qualified as Names import Unison.Prelude import Unison.PrettyPrintEnv (PrettyPrintEnv (PrettyPrintEnv)) import Unison.Reference (TypeReference) import Unison.Referent (Referent) +import Unison.Util.Relation (Relation) +import Unison.Util.Relation qualified as Relation ------------------------------------------------------------------------------------------------------------------------ -- Namer @@ -84,6 +88,23 @@ suffixifyByHash names = suffixifyType = \name -> Name.suffixifyByHash name (Names.types names) } +suffixifyByHashWithUnhashedTermsInScope :: Set Name -> Names -> Suffixifier +suffixifyByHashWithUnhashedTermsInScope localTermNames namespaceNames = + Suffixifier + { suffixifyTerm = \name -> + Name.suffixifyByHash + name + terms, -- (Relation.mapRanMonotonic ResolvesToNamespace (Names.terms names)), + suffixifyType = \name -> Name.suffixifyByHash name (Names.types namespaceNames) + } + where + terms :: Relation Name (ResolvesTo Referent) + terms = + Names.terms namespaceNames + & Relation.subtractDom localTermNames + & Relation.mapRan ResolvesToNamespace + & Relation.union (Relation.fromList (map (\name -> (name, ResolvesToLocal name)) (Set.toList localTermNames))) + ------------------------------------------------------------------------------------------------------------------------ -- Pretty-print env diff --git a/parser-typechecker/src/Unison/Runtime/IOSource.hs b/parser-typechecker/src/Unison/Runtime/IOSource.hs index 4848851f89..2480e28925 100644 --- a/parser-typechecker/src/Unison/Runtime/IOSource.hs +++ b/parser-typechecker/src/Unison/Runtime/IOSource.hs @@ -543,8 +543,8 @@ d1 Doc.++ d2 = use Doc2 match (d1,d2) with (Join ds, Join ds2) -> Join (ds List.++ ds2) - (Join ds, _) -> Join (List.snoc ds d2) - (_, Join ds) -> Join (List.cons d1 ds) + (Join ds, _) -> Join (ds List.:+ d2) + (_, Join ds) -> Join (d1 List.+: ds) _ -> Join [d1,d2] unique[q1905679b27a97a4098bc965574da880c1074183a2c55ff1d481619c7fb8a1e1] type diff --git a/parser-typechecker/src/Unison/UnisonFile/Names.hs b/parser-typechecker/src/Unison/UnisonFile/Names.hs index 4cbcd020fe..cfe22ef7e8 100644 --- a/parser-typechecker/src/Unison/UnisonFile/Names.hs +++ b/parser-typechecker/src/Unison/UnisonFile/Names.hs @@ -1,6 +1,5 @@ module Unison.UnisonFile.Names ( addNamesFromTypeCheckedUnisonFile, - addNamesFromUnisonFile, environmentFor, toNames, typecheckedToNames, @@ -35,9 +34,6 @@ toNames uf = datas <> effects datas = foldMap (DD.Names.dataDeclToNames' Name.unsafeParseVar) (Map.toList (UF.dataDeclarationsId uf)) effects = foldMap (DD.Names.effectDeclToNames' Name.unsafeParseVar) (Map.toList (UF.effectDeclarationsId uf)) -addNamesFromUnisonFile :: (Var v) => UnisonFile v a -> Names -> Names -addNamesFromUnisonFile unisonFile names = Names.shadowing (toNames unisonFile) names - typecheckedToNames :: (Var v) => TypecheckedUnisonFile v a -> Names typecheckedToNames uf = Names (terms <> ctors) types where diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs index ce5e1aa993..4a2ceeb016 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs @@ -10,6 +10,7 @@ import Control.Lens ((.=)) import Control.Monad.Reader (ask) import Control.Monad.State.Strict qualified as State import Data.Map.Strict qualified as Map +import Data.Set qualified as Set import Data.Text qualified as Text import System.Environment (withArgs) import Unison.Cli.Monad (Cli) @@ -26,16 +27,20 @@ import Unison.Codebase.Editor.Slurp qualified as Slurp import Unison.Codebase.Runtime qualified as Runtime import Unison.FileParsers qualified as FileParsers import Unison.Names (Names) +import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Ann import Unison.Parsers qualified as Parsers import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference qualified as Reference import Unison.Result qualified as Result import Unison.Symbol (Symbol) +import Unison.Syntax.Name qualified as Name import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Term qualified as Term @@ -43,6 +48,7 @@ import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF import Unison.Util.Timing qualified as Timing +import Unison.Var qualified as Var import Unison.WatchKind qualified as WK handleLoad :: Maybe FilePath -> Cli () @@ -106,8 +112,29 @@ loadUnisonFile sourceName text = do computeTypecheckingEnvironment (FileParsers.ShouldUseTndr'Yes parsingEnv) codebase [] unisonFile let Result.Result notes maybeTypecheckedUnisonFile = FileParsers.synthesizeFile typecheckingEnv unisonFile maybeTypecheckedUnisonFile & onNothing do - let namesWithFileDefinitions = UF.addNamesFromUnisonFile unisonFile names - pped <- Cli.prettyPrintEnvDeclFromNames namesWithFileDefinitions + let pped = + let ns = + names + -- Shadow just the type decl and constructor names (because the unison file didn't typecheck so we + -- don't have term `Names`) + & Names.unionLeft (UF.toNames unisonFile) + in PPED.makePPED + (PPE.hqNamer 10 ns) + ( PPE.suffixifyByHashWithUnhashedTermsInScope + ( Set.union + (Set.map Name.unsafeParseVar (Map.keysSet (UF.terms unisonFile))) + ( foldMap + ( foldMap \case + (v, _, _) -> + case Var.typeOf v of + Var.User _ -> Set.singleton (Name.unsafeParseVar v) + _ -> Set.empty + ) + (UF.watches unisonFile) + ) + ) + ns + ) let suffixifiedPPE = PPED.suffixifiedPPE pped let tes = [err | Result.TypeError err <- toList notes] cbs = diff --git a/unison-core/src/Unison/Names/ResolvesTo.hs b/unison-core/src/Unison/Names/ResolvesTo.hs index 6bb8087216..378b4af486 100644 --- a/unison-core/src/Unison/Names/ResolvesTo.hs +++ b/unison-core/src/Unison/Names/ResolvesTo.hs @@ -10,6 +10,7 @@ import Unison.Prelude data ResolvesTo ref = ResolvesToNamespace ref | ResolvesToLocal Name + deriving stock (Eq, Ord, Show) partitionResolutions :: [(v, ResolvesTo ref)] -> ([(v, ref)], [(v, Name)]) partitionResolutions = diff --git a/unison-src/transcripts/name-resolution.md b/unison-src/transcripts/name-resolution.md index 5dac5ee7c2..3e0ef716ec 100644 --- a/unison-src/transcripts/name-resolution.md +++ b/unison-src/transcripts/name-resolution.md @@ -93,16 +93,16 @@ scratch/main> project.delete scratch # Example 4 -We have a namespace term `Woot.state : Nat` and a file term `Something.state : Text -> Something`. A reference to the -term `state : Text` resolves to `Something.state`, which shadows `Woot.state`. (This behavior will change). +We have a namespace term `ns.foo : Nat` and a file term `file.foo : Text`. A reference to the term `foo` is ambiguous, +but resolves to `ns.foo` via TDNR. ```ucm scratch/main> builtins.mergeio lib.builtins ``` ```unison -Woot.state : Nat -Woot.state = 42 +ns.foo : Nat +ns.foo = 42 ``` ```ucm @@ -110,11 +110,84 @@ scratch/main> add ``` ```unison -type Something = { state : Text } +file.foo : Text +file.foo = "foo" -ex = do - s = Something "hello" - state s ++ " world!" +bar : Text +bar = foo ++ "bar" +``` + +```ucm +scratch/main> project.delete scratch +``` + +# Example 4 + +We have a namespace term `ns.foo : Nat` and a file term `file.foo : Text`. A reference to the term `foo` is ambiguous, +but resolves to `file.foo` via TDNR. + +```ucm +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +ns.foo : Nat +ns.foo = 42 +``` + +```ucm +scratch/main> add +``` + +```unison +file.foo : Text +file.foo = "foo" + +bar : Nat +bar = foo + 42 +``` + +```ucm +scratch/main> project.delete scratch +``` + +# Example 4 + +We have a namespace term `ns.foo : Nat` and a file term `file.foo : Nat`. A reference to the term `foo` is ambiguous. +A reference to `ns.foo` or `file.foo` work fine. + +```ucm +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +ns.foo : Nat +ns.foo = 42 +``` + +```ucm +scratch/main> add +``` + +```unison:error +file.foo : Nat +file.foo = 43 + +bar : Nat +bar = foo + 10 +``` + +```unison +file.foo : Nat +file.foo = 43 + +bar : Nat +bar = file.foo + ns.foo +``` + +```ucm +scratch/main> add +scratch/main> view bar ``` ```ucm diff --git a/unison-src/transcripts/name-resolution.output.md b/unison-src/transcripts/name-resolution.output.md index 0e636b96d6..0624a26a8e 100644 --- a/unison-src/transcripts/name-resolution.output.md +++ b/unison-src/transcripts/name-resolution.output.md @@ -227,8 +227,8 @@ scratch/main> project.delete scratch ``` # Example 4 -We have a namespace term `Woot.state : Nat` and a file term `Something.state : Text -> Something`. A reference to the -term `state : Text` resolves to `Something.state`, which shadows `Woot.state`. (This behavior will change). +We have a namespace term `ns.foo : Nat` and a file term `file.foo : Text`. A reference to the term `foo` is ambiguous, +but resolves to `ns.foo` via TDNR. ``` ucm scratch/main> builtins.mergeio lib.builtins @@ -237,8 +237,8 @@ scratch/main> builtins.mergeio lib.builtins ``` ``` unison -Woot.state : Nat -Woot.state = 42 +ns.foo : Nat +ns.foo = 42 ``` ``` ucm @@ -251,7 +251,7 @@ Woot.state = 42 ⍟ These new definitions are ok to `add`: - Woot.state : Nat + ns.foo : Nat ``` ``` ucm @@ -259,15 +259,15 @@ scratch/main> add ⍟ I've added these definitions: - Woot.state : Nat + ns.foo : Nat ``` ``` unison -type Something = { state : Text } +file.foo : Text +file.foo = "foo" -ex = do - s = Something "hello" - state s ++ " world!" +bar : Text +bar = foo ++ "bar" ``` ``` ucm @@ -280,13 +280,175 @@ ex = do ⍟ These new definitions are ok to `add`: - type Something - Something.state : Something -> Text - Something.state.modify : (Text ->{g} Text) - -> Something - ->{g} Something - Something.state.set : Text -> Something -> Something - ex : 'Text + bar : Text + file.foo : Text + +``` +``` ucm +scratch/main> project.delete scratch + +``` +# Example 4 + +We have a namespace term `ns.foo : Nat` and a file term `file.foo : Text`. A reference to the term `foo` is ambiguous, +but resolves to `file.foo` via TDNR. + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. + +``` +``` unison +ns.foo : Nat +ns.foo = 42 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + ns.foo : Nat + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ns.foo : Nat + +``` +``` unison +file.foo : Text +file.foo = "foo" + +bar : Nat +bar = foo + 42 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bar : Nat + file.foo : Text + +``` +``` ucm +scratch/main> project.delete scratch + +``` +# Example 4 + +We have a namespace term `ns.foo : Nat` and a file term `file.foo : Nat`. A reference to the term `foo` is ambiguous. +A reference to `ns.foo` or `file.foo` work fine. + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. + +``` +``` unison +ns.foo : Nat +ns.foo = 42 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + ns.foo : Nat + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ns.foo : Nat + +``` +``` unison +file.foo : Nat +file.foo = 43 + +bar : Nat +bar = foo + 10 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I couldn't figure out what foo refers to here: + + 5 | bar = foo + 10 + + The name foo is ambiguous. Its type should be: Nat + + I found some terms in scope that have matching names and + types. Maybe you meant one of these: + + file.foo : Nat + ns.foo : Nat + +``` +``` unison +file.foo : Nat +file.foo = 43 + +bar : Nat +bar = file.foo + ns.foo +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bar : Nat + file.foo : Nat + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + file.foo : Nat + +scratch/main> view bar + + bar : Nat + bar = + use Nat + + file.foo + ns.foo ``` ``` ucm From f03f784ed822857045c75f66957d905086dd9994 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 22 Aug 2024 13:40:53 -0400 Subject: [PATCH 609/631] show type suggestions for holes again --- unison-core/src/Unison/Name.hs | 6 ++++++ unison-core/src/Unison/Term.hs | 9 +++++---- unison-syntax/src/Unison/Syntax/Parser.hs | 8 ++------ 3 files changed, 13 insertions(+), 10 deletions(-) diff --git a/unison-core/src/Unison/Name.hs b/unison-core/src/Unison/Name.hs index 0bbe9ba4a8..9b8aaa5275 100644 --- a/unison-core/src/Unison/Name.hs +++ b/unison-core/src/Unison/Name.hs @@ -36,6 +36,7 @@ module Unison.Name -- * To organize later commonPrefix, + isBlank, preferShallowLibDepth, searchByRankedSuffix, searchBySuffix, @@ -72,6 +73,7 @@ import Unison.Prelude import Unison.Util.Alphabetical (Alphabetical, compareAlphabetical) import Unison.Util.List qualified as List import Unison.Util.Relation qualified as R +import qualified Data.Text as Text -- | @compareSuffix x y@ compares the suffix of @y@ (in reverse segment order) that is as long as @x@ to @x@ (in reverse -- segment order). @@ -545,6 +547,10 @@ suffixifyByHash fqn rel = refs = R.searchDom (compareSuffix suffix) rel +-- | A `Name` is blank when it is unqualified and begins with a `_` (also implying that it is wordy) +isBlank :: Name -> Bool +isBlank n = isUnqualified n && Text.isPrefixOf "_" (NameSegment.toUnescapedText $ lastSegment n) + -- | Returns the common prefix of two names as segments -- -- Note: the returned segments are NOT reversed. diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index a6886140fd..07e0130c2e 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -173,15 +173,16 @@ bindNames unsafeVarToName nameToVar localVars ns term = do Name.searchBySuffix name (Relation.fromList (map (\name -> (name, name)) localNames)) in case (Set.size exactNamespaceMatches, Set.size suffixNamespaceMatches, Set.size localMatches) of (1, _, _) -> good (ResolvesToNamespace (Set.findMin exactNamespaceMatches)) - (n, _, _) | n > 1 -> ambiguousSoLeaveFreeForTDNR - (_, 0, 0) -> bad Names.NotFound + (n, _, _) | n > 1 -> leaveFreeForTdnr + (_, 0, 0) -> if Name.isBlank name then leaveFreeForHoleSuggestions else bad Names.NotFound (_, 1, 0) -> good (ResolvesToNamespace (Set.findMin suffixNamespaceMatches)) (_, 0, 1) -> good (ResolvesToLocal (Set.findMin localMatches)) - _ -> ambiguousSoLeaveFreeForTDNR + _ -> leaveFreeForTdnr where good = Right . Just . (v,) bad = Left . Seq.singleton . Names.TermResolutionFailure v a - ambiguousSoLeaveFreeForTDNR = Right Nothing + leaveFreeForHoleSuggestions = Right Nothing + leaveFreeForTdnr = Right Nothing okTy :: (v, a) -> Names.ResolutionResult v a (v, Type v a) okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns of diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index bd243b0d3d..0f8835d4c3 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -281,19 +281,15 @@ closeBlock = void <$> matchToken L.Close optionalCloseBlock :: (Ord v) => P v m (L.Token ()) optionalCloseBlock = closeBlock <|> (\() -> L.Token () mempty mempty) <$> P.eof --- | A `Name` is blank when it is unqualified and begins with a `_` (also implying that it is wordy) -isBlank :: Name -> Bool -isBlank n = Name.isUnqualified n && Text.isPrefixOf "_" (INameSegment.toUnescapedText $ Name.lastSegment n) - -- | A HQ Name is blank when its Name is blank and it has no hash. isBlank' :: HQ'.HashQualified Name -> Bool isBlank' = \case - HQ'.NameOnly n -> isBlank n + HQ'.NameOnly n -> Name.isBlank n HQ'.HashQualified _ _ -> False wordyPatternName :: (Var v) => P v m (L.Token v) wordyPatternName = queryToken \case - L.WordyId (HQ'.NameOnly n) -> if isBlank n then Nothing else Just $ Name.toVar n + L.WordyId (HQ'.NameOnly n) -> if Name.isBlank n then Nothing else Just $ Name.toVar n _ -> Nothing -- | Parse a prefix identifier e.g. Foo or (+), discarding any hash From a025454783f2de870b6b53c4610002d8e6a9df1d Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 22 Aug 2024 15:30:56 -0600 Subject: [PATCH 610/631] =?UTF-8?q?Turn=20a=20possible=20=E2=80=9Cimpossib?= =?UTF-8?q?le=E2=80=9D=20into=20a=20parse=20failure?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit From #5179, there’s a case where we hit an `error "impossible"`, which doesn’t provide much context. This turns it into a parse failure, so we have #thte state of the lexer when this happens again. It also adds a comment that describes when this “impossible” case gets hit. --- unison-syntax/src/Unison/Syntax/Lexer/Unison.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs index 9c50e2731f..ac31fdcac4 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -203,7 +203,9 @@ token'' tok p = do else if column p < top l then S.put (env {layout = pop l}) >> ((Token Close p p :) <$> pops p) - else error "impossible" + else -- we hit this branch exactly when `token''` is given the state + -- `{layout = [], opening = Nothing, inLayout = True}` + fail "internal error: token''" -- don't emit virtual semis in (, {, or [ blocks topContainsVirtualSemis :: Layout -> Bool From a1ba98e38a88d72a477a1ba21842a875b837fbf4 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 22 Aug 2024 23:24:50 -0600 Subject: [PATCH 611/631] Add a transcript to test empty `match` It currently fails. --- unison-src/transcripts/fix4731.md | 33 +++++++++++++ unison-src/transcripts/fix4731.output.md | 61 ++++++++++++++++++++++++ 2 files changed, 94 insertions(+) create mode 100644 unison-src/transcripts/fix4731.md create mode 100644 unison-src/transcripts/fix4731.output.md diff --git a/unison-src/transcripts/fix4731.md b/unison-src/transcripts/fix4731.md new file mode 100644 index 0000000000..974a55db33 --- /dev/null +++ b/unison-src/transcripts/fix4731.md @@ -0,0 +1,33 @@ +```unison +structural type Void = +``` + +```ucm +scratch/main> add +``` + +We should be able to `match` on empty types like `Void`. + +```unison +Void.absurdly : '{e} Void ->{e} a +Void.absurdly v = match !v with +``` + +```unison +Void.absurdly : Void -> a +Void.absurdly v = match v with +``` + +And empty `cases` should also work. + +```unison +Void.absurdly : Void -> a +Void.absurdly = cases +``` + +But empty function bodies are not allowed. + +```unison:error +Void.absurd : Void -> a +Void.absurd x = +``` diff --git a/unison-src/transcripts/fix4731.output.md b/unison-src/transcripts/fix4731.output.md new file mode 100644 index 0000000000..2633daf7a1 --- /dev/null +++ b/unison-src/transcripts/fix4731.output.md @@ -0,0 +1,61 @@ +``` unison +structural type Void = +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + structural type Void + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type Void + +``` +We should be able to `match` on empty types like `Void`. + +``` unison +Void.absurdly : '{e} Void ->{e} a +Void.absurdly v = match !v with +``` + +``` ucm + + Loading changes detected in scratch.u. + + 😶 + + I expected some patterns after a match / with or cases but I + didn't find any. + + 2 | Void.absurdly v = match !v with + + +``` + + + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + + + 😶 + + I expected some patterns after a match / with or cases but I + didn't find any. + + 2 | Void.absurdly v = match !v with + + From 1132a6b4bd8bf933d8a69b580f0d9ec0a8361c22 Mon Sep 17 00:00:00 2001 From: Greg Pfeil Date: Thu, 22 Aug 2024 23:11:02 -0600 Subject: [PATCH 612/631] Support pattern matching on empty types MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Previously, `match` and `cases` expressions needed to have at least one pattern to match on. This allows them to work with zero patterns, which is useful for matching on empty types. Since `EmptyMatch` is no longer a failure case, errors that previously said “I expected some patterns after a match / with or cases but I didn't find any,” now say “Pattern match doesn't cover all possible cases”. Fixes #4731. --- .../src/Unison/PatternMatchCoverage.hs | 18 ++--- .../Unison/PatternMatchCoverage/Desugar.hs | 3 +- .../Unison/PatternMatchCoverage/GrdTree.hs | 8 +-- .../src/Unison/PatternMatchCoverage/Solve.hs | 8 +-- parser-typechecker/src/Unison/PrintError.hs | 15 ----- .../src/Unison/Syntax/TermParser.hs | 34 ++++------ .../src/Unison/Typechecker/Context.hs | 6 +- .../transcripts/error-messages.output.md | 9 ++- unison-src/transcripts/fix4731.output.md | 66 +++++++++++++++---- unison-syntax/src/Unison/Parser/Ann.hs | 1 + unison-syntax/src/Unison/Syntax/Parser.hs | 2 - 11 files changed, 84 insertions(+), 86 deletions(-) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage.hs b/parser-typechecker/src/Unison/PatternMatchCoverage.hs index 30973b8256..75cd0a7ce4 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage.hs @@ -35,7 +35,6 @@ module Unison.PatternMatchCoverage ) where -import Data.List.NonEmpty (nonEmpty) import Data.Set qualified as Set import Debug.Trace import Unison.Debug @@ -63,16 +62,14 @@ checkMatch :: checkMatch scrutineeType cases = do ppe <- getPrettyPrintEnv v0 <- fresh - mgrdtree0 <- traverse (desugarMatch scrutineeType v0) (nonEmpty cases) - doDebug (P.hang (title "desugared:") (prettyGrdTreeMaybe (prettyPmGrd ppe) (\_ -> "") mgrdtree0)) (pure ()) + grdtree0 <- desugarMatch scrutineeType v0 cases + doDebug (P.hang (title "desugared:") (prettyGrdTree (prettyPmGrd ppe) (\_ -> "") grdtree0)) (pure ()) let initialUncovered = Set.singleton (NC.markDirty v0 $ NC.declVar v0 scrutineeType id NC.emptyNormalizedConstraints) - (uncovered, grdtree1) <- case mgrdtree0 of - Nothing -> pure (initialUncovered, Nothing) - Just grdtree0 -> fmap Just <$> uncoverAnnotate initialUncovered grdtree0 + (uncovered, grdtree1) <- uncoverAnnotate initialUncovered grdtree0 doDebug ( P.sep "\n" - [ P.hang (title "annotated:") (prettyGrdTreeMaybe (NC.prettyDnf ppe) (NC.prettyDnf ppe . fst) grdtree1), + [ P.hang (title "annotated:") (prettyGrdTree (NC.prettyDnf ppe) (NC.prettyDnf ppe . fst) grdtree1), P.hang (title "uncovered:") (NC.prettyDnf ppe uncovered) ] ) @@ -80,14 +77,9 @@ checkMatch scrutineeType cases = do uncoveredExpanded <- concat . fmap Set.toList <$> traverse (expandSolution v0) (Set.toList uncovered) doDebug (P.hang (title "uncovered expanded:") (NC.prettyDnf ppe (Set.fromList uncoveredExpanded))) (pure ()) let sols = map (generateInhabitants v0) uncoveredExpanded - let (_accessible, inaccessible, redundant) = case grdtree1 of - Nothing -> ([], [], []) - Just x -> classify x + let (_accessible, inaccessible, redundant) = classify grdtree1 pure (redundant, inaccessible, sols) where - prettyGrdTreeMaybe prettyNode prettyLeaf = \case - Nothing -> "" - Just x -> prettyGrdTree prettyNode prettyLeaf x title = P.bold doDebug out = case shouldDebug PatternCoverage of True -> trace (P.toAnsiUnbroken out) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs index 8587d44d6c..b813145986 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs @@ -3,7 +3,6 @@ module Unison.PatternMatchCoverage.Desugar ) where -import Data.List.NonEmpty (NonEmpty (..)) import U.Core.ABT qualified as ABT import Unison.Pattern import Unison.Pattern qualified as Pattern @@ -25,7 +24,7 @@ desugarMatch :: -- | scrutinee variable v -> -- | match cases - NonEmpty (MatchCase loc (Term' vt v loc)) -> + [MatchCase loc (Term' vt v loc)] -> m (GrdTree (PmGrd vt v loc) loc) desugarMatch scrutineeType v0 cs0 = Fork <$> traverse desugarClause cs0 where diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/GrdTree.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/GrdTree.hs index 15b28e3da3..bf84bd71c2 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/GrdTree.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/GrdTree.hs @@ -10,8 +10,6 @@ module Unison.PatternMatchCoverage.GrdTree ) where -import Data.List.NonEmpty (NonEmpty (..)) -import Data.List.NonEmpty qualified as NEL import Data.ListLike (ListLike) import Unison.PatternMatchCoverage.Fix import Unison.Prelude @@ -55,7 +53,7 @@ data GrdTreeF n l a | -- | A constraint of some kind (structural pattern match, boolan guard, etc) GrdF n a | -- | A list of alternative matches, tried in order - ForkF (NonEmpty a) + ForkF [a] deriving stock (Functor, Show) prettyGrdTree :: forall n l s. (ListLike s Char, IsString s) => (n -> Pretty s) -> (l -> Pretty s) -> GrdTree n l -> Pretty s @@ -64,7 +62,7 @@ prettyGrdTree prettyNode prettyLeaf = cata phi phi = \case LeafF l -> prettyLeaf l GrdF n rest -> sep " " [prettyNode n, "──", rest] - ForkF xs -> "──" <> group (sep "\n" (makeTree $ NEL.toList xs)) + ForkF xs -> "──" <> group (sep "\n" $ makeTree xs) makeTree :: [Pretty s] -> [Pretty s] makeTree = \case [] -> [] @@ -82,7 +80,7 @@ pattern Leaf x = Fix (LeafF x) pattern Grd :: n -> GrdTree n l -> GrdTree n l pattern Grd x rest = Fix (GrdF x rest) -pattern Fork :: NonEmpty (GrdTree n l) -> GrdTree n l +pattern Fork :: [GrdTree n l] -> GrdTree n l pattern Fork alts = Fix (ForkF alts) {-# COMPLETE Leaf, Grd, Fork #-} diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs index b605750686..29e93d187f 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs @@ -16,7 +16,6 @@ import Data.Foldable import Data.Function import Data.Functor import Data.Functor.Compose -import Data.List.NonEmpty (NonEmpty (..)) import Data.Map qualified as Map import Data.Sequence qualified as Seq import Data.Set qualified as Set @@ -74,12 +73,11 @@ uncoverAnnotate z grdtree0 = cata phi grdtree0 z LeafF l -> \nc -> do nc' <- ensureInhabited' nc pure (Set.empty, Leaf (nc', l)) - ForkF (kinit :| ks) -> \nc0 -> do + ForkF ks -> \nc0 -> do -- depth-first fold in match-case order to acculate the -- constraints for a match failure at every case. - (nc1, t1) <- kinit nc0 - (ncfinal, ts) <- foldlM (\(nc, ts) a -> a nc >>= \(nc', t) -> pure (nc', t : ts)) (nc1, []) ks - pure (ncfinal, Fork (t1 :| reverse ts)) + (ncfinal, ts) <- foldlM (\(nc, ts) a -> a nc >>= \(nc', t) -> pure (nc', t : ts)) (nc0, []) ks + pure (ncfinal, Fork $ reverse ts) GrdF grd k -> \nc0 -> case grd of PmEffect var con convars -> handleGrd (PosEffect var (Effect con) convars) (NegEffect var (Effect con)) k nc0 PmEffectPure var resume -> handleGrd (PosEffect var NoEffect [resume]) (NegEffect var NoEffect) k nc0 diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 691d7cd3ef..8e2c458b34 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -1774,21 +1774,6 @@ renderParseErrors s = \case tokenAsErrorSite s tok ] in (msg, [rangeForToken tok]) - go (Parser.EmptyMatch tok) = - let msg = - Pr.indentN 2 . Pr.callout "😶" $ - Pr.lines - [ Pr.wrap - ( "I expected some patterns after a " - <> style ErrorSite "match" - <> "/" - <> style ErrorSite "with" - <> " or cases but I didn't find any." - ), - "", - tokenAsErrorSite s tok - ] - in (msg, [rangeForToken tok]) go (Parser.EmptyWatch tok) = let msg = Pr.lines diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 85406c84bf..ee4ac0450e 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -171,22 +171,13 @@ match = do P.try (openBlockWith "with") <|> do t <- anyToken P.customFailure (ExpectedBlockOpen "with" t) - (_arities, cases) <- NonEmpty.unzip <$> matchCases1 start + (_arities, cases) <- unzip <$> matchCases _ <- optionalCloseBlock - pure $ - Term.match - (ann start <> ann (NonEmpty.last cases)) - scrutinee - (toList cases) - -matchCases1 :: (Monad m, Var v) => L.Token () -> P v m (NonEmpty (Int, Term.MatchCase Ann (Term v Ann))) -matchCases1 start = do - cases <- - (sepBy semi matchCase) - <&> \cases_ -> [(n, c) | (n, cs) <- cases_, c <- cs] - case cases of - [] -> P.customFailure (EmptyMatch start) - (c : cs) -> pure (c NonEmpty.:| cs) + let anns = foldr ((<>) . ann) (ann start) $ lastMay cases + pure $ Term.match anns scrutinee cases + +matchCases :: (Monad m, Var v) => P v m [(Int, Term.MatchCase Ann (Term v Ann))] +matchCases = sepBy semi matchCase <&> \cases_ -> [(n, c) | (n, cs) <- cases_, c <- cs] -- Returns the arity of the pattern and the `MatchCase`. Examples: -- @@ -369,16 +360,17 @@ handle = label "handle" do -- Meaning the newline gets overwritten when pretty-printing and it messes things up. pure $ Term.handle (handleSpan <> ann handler) handler b -checkCasesArities :: (Ord v, Annotated a) => NonEmpty (Int, a) -> P v m (Int, NonEmpty a) -checkCasesArities cases@((i, _) NonEmpty.:| rest) = - case List.find (\(j, _) -> j /= i) rest of +checkCasesArities :: (Ord v, Annotated a) => [(Int, a)] -> P v m (Int, [a]) +checkCasesArities = \case + [] -> pure (1, []) + cases@((i, _) : rest) -> case List.find (\(j, _) -> j /= i) rest of Nothing -> pure (i, snd <$> cases) Just (j, a) -> P.customFailure $ PatternArityMismatch i j (ann a) lamCase :: (Monad m, Var v) => TermP v m lamCase = do start <- openBlockWith "cases" - cases <- matchCases1 start + cases <- matchCases (arity, cases) <- checkCasesArities cases _ <- optionalCloseBlock lamvars <- replicateM arity (Parser.uniqueName 10) @@ -390,8 +382,8 @@ lamCase = do lamvarTerm = case lamvarTerms of [e] -> e es -> DD.tupleTerm es - anns = ann start <> ann (NonEmpty.last cases) - matchTerm = Term.match anns lamvarTerm (toList cases) + anns = foldr ((<>) . ann) (ann start) $ lastMay cases + matchTerm = Term.match anns lamvarTerm cases let annotatedVars = (Ann.GeneratedFrom $ ann start,) <$> vars pure $ Term.lam' anns annotatedVars matchTerm diff --git a/parser-typechecker/src/Unison/Typechecker/Context.hs b/parser-typechecker/src/Unison/Typechecker/Context.hs index 214fe95a0c..767fa37316 100644 --- a/parser-typechecker/src/Unison/Typechecker/Context.hs +++ b/parser-typechecker/src/Unison/Typechecker/Context.hs @@ -1526,10 +1526,8 @@ ensurePatternCoverage theMatch _theMatchType _scrutinee scrutineeType cases = do } (redundant, _inaccessible, uncovered) <- flip evalStateT pmcState do checkMatch scrutineeType cases - let checkUncovered = case Nel.nonEmpty uncovered of - Nothing -> pure () - Just xs -> failWith (UncoveredPatterns matchLoc xs) - checkRedundant = foldr (\a b -> failWith (RedundantPattern a) *> b) (pure ()) redundant + let checkUncovered = maybe (pure ()) (failWith . UncoveredPatterns matchLoc) $ Nel.nonEmpty uncovered + checkRedundant = foldr ((*>) . failWith . RedundantPattern) (pure ()) redundant checkUncovered *> checkRedundant checkCases :: diff --git a/unison-src/transcripts/error-messages.output.md b/unison-src/transcripts/error-messages.output.md index 03e7e652ac..148218a759 100644 --- a/unison-src/transcripts/error-messages.output.md +++ b/unison-src/transcripts/error-messages.output.md @@ -191,13 +191,12 @@ foo = match 1 with Loading changes detected in scratch.u. - 😶 - - I expected some patterns after a match / with or cases but I - didn't find any. - + Pattern match doesn't cover all possible cases: 2 | foo = match 1 with + + Patterns not matched: + * _ ``` ``` unison diff --git a/unison-src/transcripts/fix4731.output.md b/unison-src/transcripts/fix4731.output.md index 2633daf7a1..89801fcfcd 100644 --- a/unison-src/transcripts/fix4731.output.md +++ b/unison-src/transcripts/fix4731.output.md @@ -34,28 +34,66 @@ Void.absurdly v = match !v with Loading changes detected in scratch.u. - 😶 - - I expected some patterns after a match / with or cases but I - didn't find any. - - 2 | Void.absurdly v = match !v with + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + Void.absurdly : '{e} Void ->{e} a ``` +``` unison +Void.absurdly : Void -> a +Void.absurdly v = match v with +``` +``` ucm + Loading changes detected in scratch.u. -🛑 + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + Void.absurdly : Void -> a -The transcript failed due to an error in the stanza above. The error is: +``` +And empty `cases` should also work. +``` unison +Void.absurdly : Void -> a +Void.absurdly = cases +``` - 😶 - - I expected some patterns after a match / with or cases but I - didn't find any. - - 2 | Void.absurdly v = match !v with +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + Void.absurdly : Void -> a + +``` +But empty function bodies are not allowed. +``` unison +Void.absurd : Void -> a +Void.absurd x = +``` + +``` ucm + + Loading changes detected in scratch.u. + + I expected a block after this (in red), but there wasn't one. Maybe check your indentation: + 2 | Void.absurd x = + + +``` diff --git a/unison-syntax/src/Unison/Parser/Ann.hs b/unison-syntax/src/Unison/Parser/Ann.hs index e4b361d148..1b73adeaf6 100644 --- a/unison-syntax/src/Unison/Parser/Ann.hs +++ b/unison-syntax/src/Unison/Parser/Ann.hs @@ -29,6 +29,7 @@ startingLine _ = Nothing instance Monoid Ann where mempty = External +-- | This instance is commutative. instance Semigroup Ann where Ann s1 e1 <> Ann s2 e2 = Ann (min s1 s2) (max e1 e2) -- If we have a concrete location from a file, use it diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index bd243b0d3d..822fc46fcb 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -164,8 +164,6 @@ data Error v | UnknownType (L.Token (HQ.HashQualified Name)) (Set Reference) | UnknownId (L.Token (HQ.HashQualified Name)) (Set Referent) (Set Reference) | ExpectedBlockOpen String (L.Token L.Lexeme) - | -- | Indicates a cases or match/with which doesn't have any patterns - EmptyMatch (L.Token ()) | EmptyWatch Ann | UseInvalidPrefixSuffix (Either (L.Token Name) (L.Token Name)) (Maybe [L.Token Name]) | UseEmpty (L.Token String) -- an empty `use` statement From 82d012fdb1638d9c121994dca5ab3bb7afb587d7 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 23 Aug 2024 12:08:22 -0400 Subject: [PATCH 613/631] emit a proper resolution result for constructors --- .../src/Unison/Hashing/V2/Convert.hs | 4 +-- parser-typechecker/src/Unison/PrintError.hs | 33 ++++++++--------- parser-typechecker/src/Unison/Result.hs | 2 +- .../src/Unison/Syntax/FileParser.hs | 2 +- .../src/Unison/Syntax/TermParser.hs | 36 +++++++++++++------ .../src/Unison/UnisonFile/Names.hs | 2 +- .../src/Unison/Codebase/Editor/Output.hs | 2 +- unison-core/src/Unison/DataDeclaration.hs | 2 +- .../src/Unison/DataDeclaration/Names.hs | 2 +- .../src/Unison/Names/ResolutionResult.hs | 19 ++++------ unison-core/src/Unison/NamesWithHistory.hs | 4 --- unison-core/src/Unison/Term.hs | 20 ++++++----- unison-core/src/Unison/Type.hs | 8 +++-- unison-core/src/Unison/Type/Names.hs | 6 ++-- .../src/Unison/Hashing/V2/DataDeclaration.hs | 4 +-- .../src/Unison/Hashing/V2/Type.hs | 5 +-- unison-syntax/src/Unison/Syntax/Parser.hs | 3 +- 17 files changed, 84 insertions(+), 70 deletions(-) diff --git a/parser-typechecker/src/Unison/Hashing/V2/Convert.hs b/parser-typechecker/src/Unison/Hashing/V2/Convert.hs index 7585e6b8b9..972c55db2a 100644 --- a/parser-typechecker/src/Unison/Hashing/V2/Convert.hs +++ b/parser-typechecker/src/Unison/Hashing/V2/Convert.hs @@ -227,7 +227,7 @@ h2mReferent getCT = \case hashDataDecls :: (Var v) => Map v (Memory.DD.DataDeclaration v a) -> - ResolutionResult v a [(v, Memory.Reference.Id, Memory.DD.DataDeclaration v a)] + ResolutionResult a [(v, Memory.Reference.Id, Memory.DD.DataDeclaration v a)] hashDataDecls memDecls = do let hashingDecls = fmap m2hDecl memDecls hashingResult <- Hashing.hashDecls Name.unsafeParseVar hashingDecls @@ -239,7 +239,7 @@ hashDataDecls memDecls = do hashDecls :: (Var v) => Map v (Memory.DD.Decl v a) -> - ResolutionResult v a [(v, Memory.Reference.Id, Memory.DD.Decl v a)] + ResolutionResult a [(v, Memory.Reference.Id, Memory.DD.Decl v a)] hashDecls memDecls = do -- want to unwrap the decl before doing the rehashing, and then wrap it back up the same way let howToReassemble = diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 4b46cdd03f..fb9974bfd0 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -33,6 +33,7 @@ import Unison.ABT qualified as ABT import Unison.Builtin.Decls (unitRef, pattern TupleType') import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) import Unison.HashQualified (HashQualified) +import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' import Unison.Kind (Kind) import Unison.Kind qualified as Kind @@ -1968,11 +1969,11 @@ intLiteralSyntaxTip term expectedType = case (term, expectedType) of -- | Pretty prints resolution failure annotations, including a table of disambiguation -- suggestions. prettyResolutionFailures :: - forall v a. - (Annotated a, Var v, Ord a) => + forall a. + (Annotated a, Ord a) => -- | src String -> - [Names.ResolutionFailure v a] -> + [Names.ResolutionFailure a] -> Pretty ColorText prettyResolutionFailures s allFailures = Pr.callout "❓" $ @@ -1987,39 +1988,39 @@ prettyResolutionFailures s allFailures = where -- Collapses identical failures which may have multiple annotations into a single failure. -- uniqueFailures - ambiguitiesToTable :: [Names.ResolutionFailure v a] -> Pretty ColorText + ambiguitiesToTable :: [Names.ResolutionFailure a] -> Pretty ColorText ambiguitiesToTable failures = - let pairs :: ([(v, Maybe (NESet String))]) + let pairs :: ([(HQ.HashQualified Name, Maybe (NESet String))]) pairs = nubOrd . fmap toAmbiguityPair $ failures spacerRow = ("", "") in Pr.column2Header "Symbol" "Suggestions" $ spacerRow : (intercalateMap [spacerRow] prettyRow pairs) - toAmbiguityPair :: Names.ResolutionFailure v annotation -> (v, Maybe (NESet String)) + toAmbiguityPair :: Names.ResolutionFailure annotation -> (HQ.HashQualified Name, Maybe (NESet String)) toAmbiguityPair = \case - (Names.TermResolutionFailure v _ (Names.Ambiguous names refs localNames)) -> do + (Names.TermResolutionFailure name _ (Names.Ambiguous names refs localNames)) -> do let ppe = ppeFromNames names - in ( v, + in ( name, Just $ NES.unsafeFromSet (Set.map (showTermRef ppe) refs <> Set.map (Text.unpack . Name.toText) localNames) ) - (Names.TypeResolutionFailure v _ (Names.Ambiguous names refs localNames)) -> do + (Names.TypeResolutionFailure name _ (Names.Ambiguous names refs localNames)) -> do let ppe = ppeFromNames names - in ( v, + in ( name, Just $ NES.unsafeFromSet (Set.map (showTypeRef ppe) refs <> Set.map (Text.unpack . Name.toText) localNames) ) - (Names.TermResolutionFailure v _ Names.NotFound) -> (v, Nothing) - (Names.TypeResolutionFailure v _ Names.NotFound) -> (v, Nothing) + (Names.TermResolutionFailure name _ Names.NotFound) -> (name, Nothing) + (Names.TypeResolutionFailure name _ Names.NotFound) -> (name, Nothing) ppeFromNames :: Names.Names -> PPE.PrettyPrintEnv ppeFromNames names = PPE.makePPE (PPE.hqNamer PPE.todoHashLength names) PPE.dontSuffixify - prettyRow :: (v, Maybe (NESet String)) -> [(Pretty ColorText, Pretty ColorText)] - prettyRow (v, mSet) = case mSet of - Nothing -> [(prettyVar v, Pr.hiBlack "No matches")] - Just suggestions -> zip ([prettyVar v] ++ repeat "") (Pr.string <$> toList suggestions) + prettyRow :: (HQ.HashQualified Name, Maybe (NESet String)) -> [(Pretty ColorText, Pretty ColorText)] + prettyRow (name, mSet) = case mSet of + Nothing -> [(prettyHashQualified0 name, Pr.hiBlack "No matches")] + Just suggestions -> zip ([prettyHashQualified0 name] ++ repeat "") (Pr.string <$> toList suggestions) useExamples :: Pretty ColorText useExamples = diff --git a/parser-typechecker/src/Unison/Result.hs b/parser-typechecker/src/Unison/Result.hs index 63df0a99e0..1c542c524f 100644 --- a/parser-typechecker/src/Unison/Result.hs +++ b/parser-typechecker/src/Unison/Result.hs @@ -18,7 +18,7 @@ type ResultT notes f = MaybeT (WriterT notes f) data Note v loc = Parsing (Parser.Err v) - | NameResolutionFailures [Names.ResolutionFailure v loc] + | NameResolutionFailures [Names.ResolutionFailure loc] | UnknownSymbol v loc | TypeError (Context.ErrorNote v loc) | TypeInfo (Context.InfoNote v loc) diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index e899fb2c57..0b2a30cef4 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -44,7 +44,7 @@ import Unison.WatchKind (WatchKind) import Unison.WatchKind qualified as UF import Prelude hiding (readFile) -resolutionFailures :: (Ord v) => [Names.ResolutionFailure v Ann] -> P v m x +resolutionFailures :: (Ord v) => [Names.ResolutionFailure Ann] -> P v m x resolutionFailures es = P.customFailure (ResolutionFailures es) file :: forall m v. (Monad m, Var v) => P v m (UnisonFile v Ann) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 85406c84bf..3a969ca031 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -40,6 +40,7 @@ import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names +import Unison.Names.ResolutionResult (ResolutionError (..), ResolutionFailure (..)) import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann (Ann)) import Unison.Parser.Ann qualified as Ann @@ -48,6 +49,7 @@ import Unison.Pattern qualified as Pattern import Unison.Prelude import Unison.Reference (Reference) import Unison.Referent (Referent) +import Unison.Referent qualified as Referent import Unison.Syntax.Lexer.Unison qualified as L import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) import Unison.Syntax.NameSegment qualified as NameSegment @@ -285,7 +287,10 @@ parsePattern = label "pattern" root else pure (Pattern.Var (ann v), [tokenToPair v]) unbound :: P v m (Pattern Ann, [(Ann, v)]) unbound = (\tok -> (Pattern.Unbound (ann tok), [])) <$> blank - ctor :: CT.ConstructorType -> (L.Token (HQ.HashQualified Name) -> Set ConstructorReference -> Error v) -> P v m (L.Token ConstructorReference) + ctor :: + CT.ConstructorType -> + (L.Token (HQ.HashQualified Name) -> Set ConstructorReference -> Error v) -> + P v m (L.Token ConstructorReference) ctor ct err = do -- this might be a var, so we avoid consuming it at first tok <- P.try (P.lookAhead hqPrefixId) @@ -294,23 +299,34 @@ parsePattern = label "pattern" root -- starts with a lowercase case Names.lookupHQPattern Names.IncludeSuffixes (L.payload tok) ct names of s - | Set.null s -> die tok s - | Set.size s > 1 -> die tok s - | otherwise -> -- matched ctor name, consume the token - do _ <- anyToken; pure (Set.findMin s <$ tok) + | Set.null s -> die names tok s + | Set.size s > 1 -> die names tok s + | otherwise -> do + -- matched ctor name, consume the token + _ <- anyToken + pure (Set.findMin s <$ tok) where isLower = Text.all Char.isLower . Text.take 1 . Name.toText isIgnored n = Text.take 1 (Name.toText n) == "_" - die hq s = case L.payload hq of - -- if token not hash qualified or uppercase, + die :: Names -> L.Token (HQ.HashQualified Name) -> Set ConstructorReference -> P v m a + die names hq s = case L.payload hq of + -- if token not hash qualified and not uppercase, -- fail w/out consuming it to allow backtracking HQ.NameOnly n | Set.null s && (isLower n || isIgnored n) -> fail $ "not a constructor name: " <> show n - -- it was hash qualified, and wasn't found in the env, that's a failure! - _ -> failCommitted $ err hq s - + -- it was hash qualified and/or uppercase, and wasn't found in the env, that's a failure! + _ -> + failCommitted $ + ResolutionFailures + [ TermResolutionFailure + (L.payload hq) + (ann hq) + if Set.null s + then NotFound + else Ambiguous names (Set.map (\ref -> Referent.Con ref ct) s) Set.empty + ] unzipPatterns f elems = case unzip elems of (patterns, vs) -> f patterns (join vs) effectBind0 = do diff --git a/parser-typechecker/src/Unison/UnisonFile/Names.hs b/parser-typechecker/src/Unison/UnisonFile/Names.hs index cfe22ef7e8..e0991c1c16 100644 --- a/parser-typechecker/src/Unison/UnisonFile/Names.hs +++ b/parser-typechecker/src/Unison/UnisonFile/Names.hs @@ -73,7 +73,7 @@ environmentFor :: Names -> Map v (DataDeclaration v a) -> Map v (EffectDeclaration v a) -> - Names.ResolutionResult v a (Either [Error v a] (Env v a)) + Names.ResolutionResult a (Either [Error v a] (Env v a)) environmentFor names dataDecls0 effectDecls0 = do let locallyBoundTypes = Map.keysSet dataDecls0 <> Map.keysSet effectDecls0 diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 1750c5f3a0..d51bcd4b89 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -218,7 +218,7 @@ data Output | NoExactTypeMatches | TypeAlreadyExists Path.Split' (Set Reference) | TypeParseError String (Parser.Err Symbol) - | ParseResolutionFailures String [Names.ResolutionFailure Symbol Ann] + | ParseResolutionFailures String [Names.ResolutionFailure Ann] | TypeHasFreeVars (Type Symbol Ann) | TermAlreadyExists Path.Split' (Set Referent) | LabeledReferenceAmbiguous Int (HQ.HashQualified Name) (Set LabeledDependency) diff --git a/unison-core/src/Unison/DataDeclaration.hs b/unison-core/src/Unison/DataDeclaration.hs index 6090406ae7..5972bd9abe 100644 --- a/unison-core/src/Unison/DataDeclaration.hs +++ b/unison-core/src/Unison/DataDeclaration.hs @@ -211,7 +211,7 @@ bindReferences :: Set v -> Map Name.Name Reference -> DataDeclaration v a -> - Names.ResolutionResult v a (DataDeclaration v a) + Names.ResolutionResult a (DataDeclaration v a) bindReferences unsafeVarToName keepFree names (DataDeclaration m a bound constructors) = do constructors <- for constructors $ \(a, v, ty) -> (a,v,) <$> Type.bindReferences unsafeVarToName keepFree names ty diff --git a/unison-core/src/Unison/DataDeclaration/Names.hs b/unison-core/src/Unison/DataDeclaration/Names.hs index 5aba864f3f..5cc2c297f1 100644 --- a/unison-core/src/Unison/DataDeclaration/Names.hs +++ b/unison-core/src/Unison/DataDeclaration/Names.hs @@ -53,6 +53,6 @@ bindNames :: Set v -> Names -> DataDeclaration v a -> - Names.ResolutionResult v a (DataDeclaration v a) + Names.ResolutionResult a (DataDeclaration v a) bindNames unsafeVarToName nameToVar localNames namespaceNames = traverseOf (#constructors' . traverse . _3) (Type.Names.bindNames unsafeVarToName nameToVar localNames namespaceNames) diff --git a/unison-core/src/Unison/Names/ResolutionResult.hs b/unison-core/src/Unison/Names/ResolutionResult.hs index 0359ce57ad..3b7246a35e 100644 --- a/unison-core/src/Unison/Names/ResolutionResult.hs +++ b/unison-core/src/Unison/Names/ResolutionResult.hs @@ -3,7 +3,6 @@ module Unison.Names.ResolutionResult ResolutionFailure (..), ResolutionResult, getAnnotation, - getVar, ) where @@ -12,6 +11,7 @@ import Unison.Names (Names) import Unison.Prelude import Unison.Reference (TypeReference) import Unison.Referent (Referent) +import Unison.HashQualified (HashQualified) data ResolutionError ref = NotFound @@ -25,20 +25,15 @@ data ResolutionError ref Ambiguous Names (Set ref) (Set Name) deriving (Eq, Ord, Show) --- | ResolutionFailure represents the failure to resolve a given variable. -data ResolutionFailure var annotation - = TypeResolutionFailure var annotation (ResolutionError TypeReference) - | TermResolutionFailure var annotation (ResolutionError Referent) +-- | ResolutionFailure represents the failure to resolve a given name. +data ResolutionFailure annotation + = TypeResolutionFailure (HashQualified Name) annotation (ResolutionError TypeReference) + | TermResolutionFailure (HashQualified Name) annotation (ResolutionError Referent) deriving (Eq, Ord, Show, Functor, Foldable, Traversable) -getAnnotation :: ResolutionFailure v a -> a +getAnnotation :: ResolutionFailure a -> a getAnnotation = \case TypeResolutionFailure _ a _ -> a TermResolutionFailure _ a _ -> a -getVar :: ResolutionFailure v a -> v -getVar = \case - TypeResolutionFailure v _ _ -> v - TermResolutionFailure v _ _ -> v - -type ResolutionResult v a r = Either (Seq (ResolutionFailure v a)) r +type ResolutionResult a r = Either (Seq (ResolutionFailure a)) r diff --git a/unison-core/src/Unison/NamesWithHistory.hs b/unison-core/src/Unison/NamesWithHistory.hs index 561fa557f8..e7e10fee6f 100644 --- a/unison-core/src/Unison/NamesWithHistory.hs +++ b/unison-core/src/Unison/NamesWithHistory.hs @@ -236,10 +236,6 @@ termName length r names = hq n = HQ'.take length (HQ'.fromNamedReferent n r) isConflicted n = R.manyDom n (Names.terms names) --- Set HashQualified -> Branch m -> Action' m v Names --- Set HashQualified -> Branch m -> Free (Command m i v) Names --- Set HashQualified -> Branch m -> Command m i v Names --- populate historical names lookupHQPattern :: SearchType -> HQ.HashQualified Name -> diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index 07e0130c2e..65202114e6 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -156,7 +156,7 @@ bindNames :: Set v -> Names -> Term v a -> - Names.ResolutionResult v a (Term v a) + Names.ResolutionResult a (Term v a) bindNames unsafeVarToName nameToVar localVars ns term = do let freeTmVars = ABT.freeVarOccurrences localVars term freeTyVars = @@ -164,10 +164,9 @@ bindNames unsafeVarToName nameToVar localVars ns term = do ] localNames = map unsafeVarToName (Set.toList localVars) - okTm :: (v, a) -> Names.ResolutionResult v a (Maybe (v, ResolvesTo Referent)) + okTm :: (v, a) -> Names.ResolutionResult a (Maybe (v, ResolvesTo Referent)) okTm (v, a) = - let name = unsafeVarToName v - exactNamespaceMatches = Names.lookupHQTerm Names.ExactName (HQ.NameOnly name) ns + let exactNamespaceMatches = Names.lookupHQTerm Names.ExactName (HQ.NameOnly name) ns suffixNamespaceMatches = Name.searchByRankedSuffix name (Names.terms ns) localMatches = Name.searchBySuffix name (Relation.fromList (map (\name -> (name, name)) localNames)) @@ -179,17 +178,20 @@ bindNames unsafeVarToName nameToVar localVars ns term = do (_, 0, 1) -> good (ResolvesToLocal (Set.findMin localMatches)) _ -> leaveFreeForTdnr where + name = unsafeVarToName v good = Right . Just . (v,) - bad = Left . Seq.singleton . Names.TermResolutionFailure v a + bad = Left . Seq.singleton . Names.TermResolutionFailure (HQ.NameOnly name) a leaveFreeForHoleSuggestions = Right Nothing leaveFreeForTdnr = Right Nothing - okTy :: (v, a) -> Names.ResolutionResult v a (v, Type v a) - okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns of + okTy :: (v, a) -> Names.ResolutionResult a (v, Type v a) + okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes hqName ns of rs | Set.size rs == 1 -> pure (v, Type.ref a $ Set.findMin rs) - | Set.size rs == 0 -> Left (pure (Names.TypeResolutionFailure v a Names.NotFound)) - | otherwise -> Left (pure (Names.TypeResolutionFailure v a (Names.Ambiguous ns rs Set.empty))) + | Set.size rs == 0 -> Left (Seq.singleton (Names.TypeResolutionFailure hqName a Names.NotFound)) + | otherwise -> Left (Seq.singleton (Names.TypeResolutionFailure hqName a (Names.Ambiguous ns rs Set.empty))) + where + hqName = HQ.NameOnly (unsafeVarToName v) (namespaceTermResolutions, localTermResolutions) <- partitionResolutions . catMaybes <$> validate okTm freeTmVars let termSubsts = diff --git a/unison-core/src/Unison/Type.hs b/unison-core/src/Unison/Type.hs index d779aa7ce1..a1fd4fec52 100644 --- a/unison-core/src/Unison/Type.hs +++ b/unison-core/src/Unison/Type.hs @@ -8,8 +8,10 @@ import Data.Generics.Sum (_Ctor) import Data.List.Extra (nubOrd) import Data.Map qualified as Map import Data.Monoid (Any (..)) +import Data.Sequence qualified as Seq import Data.Set qualified as Set import Unison.ABT qualified as ABT +import Unison.HashQualified qualified as HQ import Unison.Kind qualified as K import Unison.LabeledDependency qualified as LD import Unison.Name qualified as Name @@ -71,12 +73,14 @@ bindReferences :: Set v -> Map Name.Name TypeReference -> Type v a -> - Names.ResolutionResult v a (Type v a) + Names.ResolutionResult a (Type v a) bindReferences unsafeVarToName keepFree ns t = let fvs = ABT.freeVarOccurrences keepFree t rs = [(v, a, Map.lookup (unsafeVarToName v) ns) | (v, a) <- fvs] ok (v, _a, Just r) = pure (v, r) - ok (v, a, Nothing) = Left (pure (Names.TypeResolutionFailure v a Names.NotFound)) + ok (v, a, Nothing) = + Left $ + Seq.singleton (Names.TypeResolutionFailure (HQ.NameOnly (unsafeVarToName v)) a Names.NotFound) in List.validate ok rs <&> \es -> bindExternal es t newtype Monotype v a = Monotype {getPolytype :: Type v a} deriving (Eq) diff --git a/unison-core/src/Unison/Type/Names.hs b/unison-core/src/Unison/Type/Names.hs index 5bbf57fea5..0043e437a4 100644 --- a/unison-core/src/Unison/Type/Names.hs +++ b/unison-core/src/Unison/Type/Names.hs @@ -29,7 +29,7 @@ bindNames :: Set v -> Names -> Type v a -> - Names.ResolutionResult v a (Type v a) + Names.ResolutionResult a (Type v a) bindNames unsafeVarToName nameToVar localVars namespaceNames ty = let -- Identify the unresolved variables in the type: those whose names aren't an *exact* match for some locally-bound -- type. @@ -63,7 +63,7 @@ bindNames unsafeVarToName nameToVar localVars namespaceNames ty = checkAmbiguity :: (v, a, (Set TypeReference, Set TypeReference), Set Name) -> - Either (Seq (Names.ResolutionFailure v a)) (v, ResolvesTo TypeReference) + Either (Seq (Names.ResolutionFailure a)) (v, ResolvesTo TypeReference) checkAmbiguity (v, a, (exactNamespaceMatches, suffixNamespaceMatches), localMatches) = case (Set.size exactNamespaceMatches, Set.size suffixNamespaceMatches, Set.size localMatches) of (1, _, _) -> good (ResolvesToNamespace (Set.findMin exactNamespaceMatches)) @@ -73,7 +73,7 @@ bindNames unsafeVarToName nameToVar localVars namespaceNames ty = (_, 0, 1) -> good (ResolvesToLocal (Set.findMin localMatches)) _ -> bad (Names.Ambiguous namespaceNames suffixNamespaceMatches localMatches) where - bad = Left . Seq.singleton . Names.TypeResolutionFailure v a + bad = Left . Seq.singleton . Names.TypeResolutionFailure (HQ.NameOnly (unsafeVarToName v)) a good = Right . (v,) in List.validate checkAmbiguity resolvedVars <&> \resolutions -> let (namespaceResolutions, localResolutions) = partitionResolutions resolutions diff --git a/unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs b/unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs index 7d1d67ce41..3dc7b4eba0 100644 --- a/unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs +++ b/unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs @@ -76,7 +76,7 @@ hashDecls :: (Eq v, Var v, Show v) => (v -> Name.Name) -> Map v (DataDeclaration v a) -> - Names.ResolutionResult v a [(v, ReferenceId, DataDeclaration v a)] + Names.ResolutionResult a [(v, ReferenceId, DataDeclaration v a)] hashDecls unsafeVarToName decls = do -- todo: make sure all other external references are resolved before calling this let varToRef = hashDecls0 (void <$> decls) @@ -96,7 +96,7 @@ bindReferences :: Set v -> Map Name.Name Reference -> DataDeclaration v a -> - Names.ResolutionResult v a (DataDeclaration v a) + Names.ResolutionResult a (DataDeclaration v a) bindReferences unsafeVarToName keepFree names (DataDeclaration m a bound constructors) = do constructors <- for constructors $ \(a, v, ty) -> (a,v,) <$> Type.bindReferences unsafeVarToName keepFree names ty diff --git a/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs b/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs index 14a5e0e809..b1397d0e81 100644 --- a/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs +++ b/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs @@ -23,6 +23,7 @@ where import Data.Map qualified as Map import Data.Set qualified as Set import Unison.ABT qualified as ABT +import Unison.HashQualified qualified as HQ import Unison.Hashing.V2.ABT qualified as ABT import Unison.Hashing.V2.Kind qualified as K import Unison.Hashing.V2.Reference (Reference (..), pattern ReferenceDerived) @@ -64,12 +65,12 @@ bindReferences :: Set v -> Map Name.Name Reference -> Type v a -> - Names.ResolutionResult v a (Type v a) + Names.ResolutionResult a (Type v a) bindReferences unsafeVarToName keepFree ns t = let fvs = ABT.freeVarOccurrences keepFree t rs = [(v, a, Map.lookup (unsafeVarToName v) ns) | (v, a) <- fvs] ok (v, _a, Just r) = pure (v, r) - ok (v, a, Nothing) = Left (pure (Names.TypeResolutionFailure v a Names.NotFound)) + ok (v, a, Nothing) = Left (pure (Names.TypeResolutionFailure (HQ.NameOnly (unsafeVarToName v)) a Names.NotFound)) in List.validate ok rs <&> \es -> bindExternal es t -- some smart patterns diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 0f8835d4c3..27d248eaea 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -82,7 +82,6 @@ import Unison.HashQualifiedPrime qualified as HQ' import Unison.Hashable qualified as Hashable import Unison.Name as Name import Unison.NameSegment (NameSegment) -import Unison.NameSegment.Internal qualified as INameSegment import Unison.Names (Names) import Unison.Names.ResolutionResult qualified as Names import Unison.Parser.Ann (Ann (..), Annotated (..)) @@ -175,7 +174,7 @@ data Error v MissingTypeModifier (L.Token String) (L.Token v) | -- | A type was found in a position that requires a term TypeNotAllowed (L.Token (HQ.HashQualified Name)) - | ResolutionFailures [Names.ResolutionFailure v Ann] + | ResolutionFailures [Names.ResolutionFailure Ann] | DuplicateTypeNames [(v, [Ann])] | DuplicateTermNames [(v, [Ann])] | -- | PatternArityMismatch expectedArity actualArity location From 7cb62a2856830e5c9c61401876ea46e6674bf0a0 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 23 Aug 2024 12:20:25 -0400 Subject: [PATCH 614/631] delete now-unused UnknownAbilityConstructor/UnknownDataConstructor errors --- parser-typechecker/src/Unison/PrintError.hs | 21 ---------------- .../src/Unison/Syntax/TermParser.hs | 13 ++++------ .../tests/Unison/Test/Syntax/FileParser.hs | 24 +------------------ unison-syntax/src/Unison/Syntax/Parser.hs | 3 --- 4 files changed, 6 insertions(+), 55 deletions(-) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index fb9974bfd0..0ef0053834 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -32,7 +32,6 @@ import Text.Megaparsec qualified as P import Unison.ABT qualified as ABT import Unison.Builtin.Decls (unitRef, pattern TupleType') import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) -import Unison.HashQualified (HashQualified) import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' import Unison.Kind (Kind) @@ -1798,8 +1797,6 @@ renderParseErrors s = \case annotatedAsErrorSite s tok ] in (msg, maybeToList $ rangeForAnnotated tok) - go (Parser.UnknownAbilityConstructor tok _referents) = (unknownConstructor "ability" tok, [rangeForToken tok]) - go (Parser.UnknownDataConstructor tok _referents) = (unknownConstructor "data" tok, [rangeForToken tok]) go (Parser.UnknownId tok referents references) = let msg = Pr.lines @@ -1871,24 +1868,6 @@ renderParseErrors s = \case ] in (msg, [rangeForToken tok]) - unknownConstructor :: - String -> L.Token (HashQualified Name) -> Pretty ColorText - unknownConstructor ctorType tok = - Pr.lines - [ (Pr.wrap . mconcat) - [ "I don't know about any ", - fromString ctorType, - " constructor named ", - Pr.group - ( stylePretty ErrorSite (prettyHashQualified0 (L.payload tok)) - <> "." - ), - "Maybe make sure it's correctly spelled and that you've imported it:" - ], - "", - tokenAsErrorSite s tok - ] - annotatedAsErrorSite :: (Annotated a) => String -> a -> Pretty ColorText annotatedAsErrorSite = annotatedAsStyle ErrorSite diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 3a969ca031..e89960e9c3 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -287,11 +287,8 @@ parsePattern = label "pattern" root else pure (Pattern.Var (ann v), [tokenToPair v]) unbound :: P v m (Pattern Ann, [(Ann, v)]) unbound = (\tok -> (Pattern.Unbound (ann tok), [])) <$> blank - ctor :: - CT.ConstructorType -> - (L.Token (HQ.HashQualified Name) -> Set ConstructorReference -> Error v) -> - P v m (L.Token ConstructorReference) - ctor ct err = do + ctor :: CT.ConstructorType -> P v m (L.Token ConstructorReference) + ctor ct = do -- this might be a var, so we avoid consuming it at first tok <- P.try (P.lookAhead hqPrefixId) names <- asks names @@ -330,7 +327,7 @@ parsePattern = label "pattern" root unzipPatterns f elems = case unzip elems of (patterns, vs) -> f patterns (join vs) effectBind0 = do - tok <- ctor CT.Effect UnknownAbilityConstructor + tok <- ctor CT.Effect leaves <- many leaf _ <- reserved "->" pure (tok, leaves) @@ -354,11 +351,11 @@ parsePattern = label "pattern" root -- ex: unique type Day = Mon | Tue | ... nullaryCtor = P.try do - tok <- ctor CT.Data UnknownDataConstructor + tok <- ctor CT.Data pure (Pattern.Constructor (ann tok) (L.payload tok) [], []) constructor = do - tok <- ctor CT.Data UnknownDataConstructor + tok <- ctor CT.Data let f patterns vs = let loc = foldl (<>) (ann tok) $ map ann patterns in (Pattern.Constructor loc (L.payload tok) patterns, vs) diff --git a/parser-typechecker/tests/Unison/Test/Syntax/FileParser.hs b/parser-typechecker/tests/Unison/Test/Syntax/FileParser.hs index f436e5efe3..7896d75fd9 100644 --- a/parser-typechecker/tests/Unison/Test/Syntax/FileParser.hs +++ b/parser-typechecker/tests/Unison/Test/Syntax/FileParser.hs @@ -60,9 +60,7 @@ test = emptyWatchTest, signatureNeedsAccompanyingBodyTest, emptyBlockTest, - expectedBlockOpenTest, - unknownDataConstructorTest, - unknownAbilityConstructorTest + expectedBlockOpenTest ] expectFileParseFailure :: String -> (P.Error Symbol -> Test ()) -> Test () @@ -117,26 +115,6 @@ expectedBlockOpenTest = P.ExpectedBlockOpen _ _ -> ok _ -> crash "Error wasn't ExpectedBlockOpen" -unknownDataConstructorTest :: Test () -unknownDataConstructorTest = - scope "unknownDataConstructorTest" $ - expectFileParseFailure "m a = match a with A -> 1" expectation - where - expectation :: (Var e) => P.Error e -> Test () - expectation e = case e of - P.UnknownDataConstructor _ _ -> ok - _ -> crash "Error wasn't UnknownDataConstructor" - -unknownAbilityConstructorTest :: Test () -unknownAbilityConstructorTest = - scope "unknownAbilityConstructorTest" $ - expectFileParseFailure "f e = match e with {E t -> u} -> 1" expectation - where - expectation :: (Var e) => P.Error e -> Test () - expectation e = case e of - P.UnknownAbilityConstructor _ _ -> ok - _ -> crash "Error wasn't UnknownAbilityConstructor" - parses :: String -> Test () parses s = scope s $ do let p :: UnisonFile Symbol P.Ann diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 27d248eaea..21513cd19b 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -75,7 +75,6 @@ import Text.Megaparsec qualified as P import U.Codebase.Reference (ReferenceType (..)) import U.Util.Base32Hex qualified as Base32Hex import Unison.ABT qualified as ABT -import Unison.ConstructorReference (ConstructorReference) import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' @@ -157,8 +156,6 @@ data Error v = SignatureNeedsAccompanyingBody (L.Token v) | DisallowedAbsoluteName (L.Token Name) | EmptyBlock (L.Token String) - | UnknownAbilityConstructor (L.Token (HQ.HashQualified Name)) (Set ConstructorReference) - | UnknownDataConstructor (L.Token (HQ.HashQualified Name)) (Set ConstructorReference) | UnknownTerm (L.Token (HQ.HashQualified Name)) (Set Referent) | UnknownType (L.Token (HQ.HashQualified Name)) (Set Reference) | UnknownId (L.Token (HQ.HashQualified Name)) (Set Referent) (Set Reference) From eefacbf48b01210cadd8baef5038dceb058ff1f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Fri, 23 Aug 2024 15:51:26 -0400 Subject: [PATCH 615/631] Remove comments --- .../src/Unison/Syntax/TermPrinter.hs | 62 ------------------- 1 file changed, 62 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index 4bca67bdcf..5d8ac3543e 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -439,68 +439,6 @@ pretty0 . NameSegment.toEscapedText . Name.lastSegment _ -> Nothing - -- unBinaryAppsPred' :: - -- ( Term3 v PrintAnnotation, - -- Term3 v PrintAnnotation -> Bool - -- ) -> - -- Maybe - -- ( [ ( Term3 v PrintAnnotation, - -- Term3 v PrintAnnotation - -- ) - -- ], - -- Term3 v PrintAnnotation - -- ) - -- unBinaryAppsPred' (t, isInfix) = - -- go t isInfix - -- where - -- go t pred = - -- case unBinaryAppPred (t, pred) of - -- Just (f, x, y) -> - -- let precf = termPrecedence f - -- -- We only chain together infix operators if they have - -- -- higher precedence (lower raw precedence) than the - -- -- current operator. If there is no precedence, we only - -- -- chain if it's literally the same operator. - -- inChain compare g = isInfix g && (fromMaybe (g == f) $ compare <$> termPrecedence g <*> precf) - -- l = unBinaryAppsPred' (x, inChain (>=)) - -- r = unBinaryAppsPred' (y, inChain (>)) - -- in case (l, r) of - -- (Just (as, xLast), Just (bs, yLast)) -> Just (bs ++ ((xLast, f) : as), yLast) - -- (Just (as, xLast), Nothing) -> Just ((xLast, f) : as, y) - -- (Nothing, Just (bs, yLast)) -> Just (bs ++ [(x, f)], yLast) - -- (Nothing, Nothing) -> Just ([(x, f)], y) - -- Nothing -> Nothing - - -- Render a binary infix operator sequence, like [(a2, f2), (a1, f1)], - -- meaning (a1 `f1` a2) `f2` (a3 rendered by the caller), producing - -- "a1 `f1` a2 `f2`". Except the operators are all symbolic, so we won't - -- produce any backticks. We build the result out from the right, - -- starting at `f2`. - -- binaryApps :: - -- [(Term3 v PrintAnnotation, Term3 v PrintAnnotation)] -> - -- Pretty SyntaxText -> - -- m (Pretty SyntaxText) - -- binaryApps xs last = - -- do - -- let xs' = reverse xs - -- psh <- join <$> traverse (uncurry (r (InfixOp Lowest))) (take 1 xs') - -- pst <- join <$> traverse (uncurry (r (InfixOp Highest))) (drop 1 xs') - -- let ps = psh <> pst - -- let unbroken = PP.spaced (ps <> [last]) - -- broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last] - -- pure (unbroken `PP.orElse` broken) - -- where - -- psCols ps = case take 2 ps of - -- [x, y] -> (x, y) : psCols (drop 2 ps) - -- [x] -> [(x, "")] - -- [] -> [] - -- _ -> undefined - -- r p a f = - -- sequenceA - -- [ pretty0 (ac (if isBlock a then Top else fromMaybe p (termPrecedence f)) Normal im doc) a, - -- pretty0 (AmbientContext Application Normal Infix im doc False) f - -- ] - case (term, binaryOpsPred) of (DD.Doc, _) | doc == MaybeDoc -> From 8a70414fdf1142796d9190a64a73d21d8902149a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ru=CC=81nar?= Date: Fri, 23 Aug 2024 19:17:24 -0400 Subject: [PATCH 616/631] More parens around do blocks --- .../src/Unison/Syntax/TermPrinter.hs | 19 +++++--------- .../transcripts-round-trip/main.output.md | 26 +++---------------- 2 files changed, 9 insertions(+), 36 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index 5d8ac3543e..cddc64399a 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -312,7 +312,7 @@ pretty0 | Match' _ _ <- x -> do px <- pretty0 (ac Annotation Block im doc) x let hang = if isSoftHangable x then PP.softHang else PP.hang - pure . paren (p >= Application) $ + pure . paren (p > Control) $ fmt S.ControlKeyword "do" `hang` px | otherwise -> do let (im0', uses0) = calcImports im x @@ -325,7 +325,7 @@ pretty0 -- this makes sure we get proper indentation if `px` spills onto -- multiple lines, since `do` introduces layout block let indent = PP.Width (if soft then 2 else 0) + (if soft && p < Application then 1 else 0) - pure . paren (p >= Application) $ + pure . paren (p > Control) $ fmt S.ControlKeyword "do" `hang` PP.lines (uses <> [PP.indentNAfterNewline indent px]) List' xs -> do let listLink p = fmt (S.TypeReference Type.listRef) p @@ -487,21 +487,21 @@ pretty0 let prec = termPrecedence f prettyF <- pretty0 (AmbientContext Application Normal Infix im doc False) f prettyA <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) a - prettyB <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) b + prettyB <- pretty0 (ac (fromMaybe (InfixOp Highest) prec) Normal im doc) b pure . parenNoGroup (p > fromMaybe (InfixOp Lowest) prec) $ (prettyA <> " " <> prettyF <> " " <> prettyB) `PP.orElse` (prettyA `PP.hangUngrouped` (PP.column2 [(prettyF, prettyB)])) (And' a b, _) -> do let prec = operatorPrecedence "&&" prettyF = fmt S.ControlKeyword "&&" prettyA <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) a - prettyB <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) b + prettyB <- pretty0 (ac (fromMaybe (InfixOp Highest) prec) Normal im doc) b pure . parenNoGroup (p > fromMaybe (InfixOp Lowest) prec) $ (prettyA <> " " <> prettyF <> " " <> prettyB) `PP.orElse` (prettyA `PP.hangUngrouped` (PP.column2 [(prettyF, prettyB)])) (Or' a b, _) -> do let prec = operatorPrecedence "||" prettyF = fmt S.ControlKeyword "||" prettyA <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) a - prettyB <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) b + prettyB <- pretty0 (ac (fromMaybe (InfixOp Highest) prec) Normal im doc) b pure . parenNoGroup (p > fromMaybe (InfixOp Lowest) prec) $ PP.group (prettyA <> " " <> prettyF <> " " <> prettyB) `PP.orElse` (prettyA `PP.hangUngrouped` prettyF <> " " <> prettyB) @@ -538,14 +538,6 @@ pretty0 pure . paren (p >= (InfixOp Lowest)) $ PP.group (PP.group (PP.group (PP.sep softTab (fun : args') <> softTab)) <> lastArg') _other -> case (term, nonForcePred) of - -- OverappliedBinaryAppPred' f a b r - -- | binaryOpsPred f -> - -- -- Special case for overapplied binary op - -- do - -- prettyB <- pretty0 (ac (InfixOp Lowest) Normal im doc) b - -- prettyR <- PP.spacedTraverse (pretty0 (ac Application Normal im doc)) r - -- prettyA <- binaryApps [(f, a)] prettyB - -- pure $ paren True $ PP.hang prettyA prettyR AppsPred' f args -> paren (p >= Application) <$> do f' <- pretty0 (ac Application Normal im doc) f @@ -1567,6 +1559,7 @@ isBlock tm = Match' _ _ -> True LetBlock _ _ -> True DDelay' _ -> True + Delay' _ -> True _ -> False pattern LetBlock :: diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index d11b9e210d..a2624eaf9d 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -163,8 +163,7 @@ fixity = fix_1035 : Text fix_1035 = use Text ++ - "aaaaaaaaaaaaaaaaaaaaaa" - ++ "bbbbbbbbbbbbbbbbbbbbbb" + "aaaaaaaaaaaaaaaaaaaaaa" ++ "bbbbbbbbbbbbbbbbbbbbbb" ++ "cccccccccccccccccccccc" ++ "dddddddddddddddddddddd" @@ -665,15 +664,7 @@ softhang28 = n -> forkAt 0 - (n - Nat.+ n - Nat.+ n - Nat.+ n - Nat.+ n - Nat.+ n - Nat.+ n - Nat.+ n - Nat.+ n + (n Nat.+ n Nat.+ n Nat.+ n Nat.+ n Nat.+ n Nat.+ n Nat.+ n Nat.+ n Nat.+ n Nat.+ n) @@ -693,18 +684,7 @@ softhang_b x = a = 1 b = 2 softhang - (100 - + 200 - + 300 - + 400 - + 500 - + 600 - + 700 - + 800 - + 900 - + 1000 - + 1100 - + 1200 + (100 + 200 + 300 + 400 + 500 + 600 + 700 + 800 + 900 + 1000 + 1100 + 1200 + 1300 + 1400 + 1500) From 2e71dff47dfb5e1e58e77cf284035cfc3ffe7884 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Sat, 24 Aug 2024 13:07:59 -0700 Subject: [PATCH 617/631] Kill Configurator and Unison Config --- CREDITS.md | 1 - contrib/cabal.project | 5 - nix/unison-project.nix | 1 - parser-typechecker/package.yaml | 1 - .../unison-parser-typechecker.cabal | 2 - stack.yaml | 3 - stack.yaml.lock | 11 - unison-cli/package.yaml | 1 - unison-cli/src/Unison/Cli/Monad.hs | 2 - unison-cli/src/Unison/Cli/MonadUtils.hs | 16 +- .../src/Unison/Codebase/Transcript/Runner.hs | 28 +- unison-cli/src/Unison/CommandLine.hs | 15 - unison-cli/src/Unison/CommandLine/Main.hs | 5 +- unison-cli/src/Unison/Main.hs | 441 ++++++++---------- unison-cli/tests/Unison/Test/Ucm.hs | 3 +- unison-cli/transcripts/Transcripts.hs | 2 +- unison-cli/unison-cli.cabal | 3 - 17 files changed, 215 insertions(+), 325 deletions(-) diff --git a/CREDITS.md b/CREDITS.md index 321060f338..bd367b3aef 100644 --- a/CREDITS.md +++ b/CREDITS.md @@ -52,7 +52,6 @@ These are listed in alphabetical order. | [comonad-5.0.6](https://hackage.haskell.org/package/comonad-5.0.6) | [BSD3](https://hackage.haskell.org/package/comonad-5.0.6/src/LICENSE) | | [concurrent-supply-0.1.8](https://hackage.haskell.org/package/concurrent-supply-0.1.8) | [BSD3](https://hackage.haskell.org/package/concurrent-supply-0.1.8/src/LICENSE) | | [conduit-1.3.2](https://hackage.haskell.org/package/conduit-1.3.2) | [MIT](https://hackage.haskell.org/package/conduit-1.3.2/src/LICENSE) | -| [configurator-0.3.0.0](https://hackage.haskell.org/package/configurator-0.3.0.0) | [BSD3](https://hackage.haskell.org/package/configurator-0.3.0.0/src/LICENSE) | | [containers-0.6.2.1](https://hackage.haskell.org/package/containers-0.6.2.1) | [BSD3](https://hackage.haskell.org/package/containers-0.6.2.1/src/LICENSE) | | [contravariant-1.5.2](https://hackage.haskell.org/package/contravariant-1.5.2) | [BSD3](https://hackage.haskell.org/package/contravariant-1.5.2/src/LICENSE) | | [cryptohash-md5-0.11.100.1](https://hackage.haskell.org/package/cryptohash-md5-0.11.100.1) | [BSD3](https://hackage.haskell.org/package/cryptohash-md5-0.11.100.1/src/LICENSE) | diff --git a/contrib/cabal.project b/contrib/cabal.project index d23809d841..8f13162c7f 100644 --- a/contrib/cabal.project +++ b/contrib/cabal.project @@ -36,11 +36,6 @@ packages: unison-syntax yaks/easytest -source-repository-package - type: git - location: https://github.com/unisonweb/configurator.git - tag: e47e9e9fe1f576f8c835183b9def52d73c01327a - source-repository-package type: git location: https://github.com/unisonweb/haskeline.git diff --git a/nix/unison-project.nix b/nix/unison-project.nix index aa191a5a44..3ca79d706b 100644 --- a/nix/unison-project.nix +++ b/nix/unison-project.nix @@ -25,7 +25,6 @@ in } ]; branchMap = { - "https://github.com/unisonweb/configurator.git"."e47e9e9fe1f576f8c835183b9def52d73c01327a" = "unison"; "https://github.com/unisonweb/shellmet.git"."2fd348592c8f51bb4c0ca6ba4bc8e38668913746" = "topic/avoid-callCommand"; }; } diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml index de5bbd70e3..5cc6ba5473 100644 --- a/parser-typechecker/package.yaml +++ b/parser-typechecker/package.yaml @@ -37,7 +37,6 @@ dependencies: - cereal - clock - concurrent-output - - configurator - containers >= 0.6.3 - cryptonite - data-default diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index b97cc70bb1..edc3182a5e 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -242,7 +242,6 @@ library , cereal , clock , concurrent-output - , configurator , containers >=0.6.3 , crypton-x509 , crypton-x509-store @@ -437,7 +436,6 @@ test-suite parser-typechecker-tests , clock , code-page , concurrent-output - , configurator , containers >=0.6.3 , crypton-x509 , crypton-x509-store diff --git a/stack.yaml b/stack.yaml index 19bccd7774..1eb80fdd2c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -51,9 +51,6 @@ packages: resolver: lts-22.26 extra-deps: - # broken version in snapshot - - github: unisonweb/configurator - commit: e47e9e9fe1f576f8c835183b9def52d73c01327a # This custom Haskeline alters ANSI rendering on Windows. # If changing the haskeline dependency, please ensure color renders properly in a # Windows terminal. diff --git a/stack.yaml.lock b/stack.yaml.lock index 61c24795ea..316b017f48 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -4,17 +4,6 @@ # https://docs.haskellstack.org/en/stable/lock_files packages: -- completed: - name: configurator - pantry-tree: - sha256: 90547cd983fd15ebdc803e057d3ef8735fe93a75e29a00f8a74eadc13ee0f6e9 - size: 955 - sha256: d4fd87fb7bfc5d8e9fbc3e4ee7302c6b1500cdc00fdb9b659d0f4849b6ebe2d5 - size: 15989 - url: https://github.com/unisonweb/configurator/archive/e47e9e9fe1f576f8c835183b9def52d73c01327a.tar.gz - version: 0.3.0.0 - original: - url: https://github.com/unisonweb/configurator/archive/e47e9e9fe1f576f8c835183b9def52d73c01327a.tar.gz - completed: name: haskeline pantry-tree: diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index 23b18fa9d9..ac5c0053be 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -23,7 +23,6 @@ dependencies: - co-log-core - code-page - concurrent-output - - configurator - containers >= 0.6.3 - cryptonite - directory diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index f712907fab..500a015a9a 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -62,7 +62,6 @@ import Control.Lens import Control.Monad.Reader (MonadReader (..)) import Control.Monad.State.Strict (MonadState) import Control.Monad.State.Strict qualified as State -import Data.Configurator.Types qualified as Configurator import Data.List.NonEmpty qualified as List (NonEmpty) import Data.List.NonEmpty qualified as List.NonEmpty import Data.List.NonEmpty qualified as NonEmpty @@ -160,7 +159,6 @@ type SourceName = Text data Env = Env { authHTTPClient :: AuthenticatedHttpClient, codebase :: Codebase IO Symbol Ann, - config :: Configurator.Config, credentialManager :: CredentialManager, -- | Generate a unique name. generateUniqueName :: IO Parser.UniqueName, diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 8ea64f0694..4546be1e84 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -1,10 +1,7 @@ -- | This module contains miscellaneous helper utils for rote actions in the Cli monad, like resolving a relative path -- to an absolute path, per the current path. module Unison.Cli.MonadUtils - ( -- * @.unisonConfig@ things - getConfig, - - -- * Paths + ( -- * Paths getCurrentPath, getCurrentProjectName, getCurrentProjectBranchName, @@ -88,8 +85,6 @@ where import Control.Lens import Control.Monad.Reader (ask) import Control.Monad.State -import Data.Configurator qualified as Configurator -import Data.Configurator.Types qualified as Configurator import Data.Foldable import Data.Set qualified as Set import U.Codebase.Branch qualified as V2 (Branch) @@ -138,15 +133,6 @@ import Unison.UnisonFile.Names qualified as UFN import Unison.Util.Set qualified as Set import Unison.Var qualified as Var ------------------------------------------------------------------------------------------------------------------------- --- .unisonConfig things - --- | Lookup a config value by key. -getConfig :: (Configurator.Configured a) => Text -> Cli (Maybe a) -getConfig key = do - Cli.Env {config} <- ask - liftIO (Configurator.lookup config key) - ------------------------------------------------------------------------------------------------------------------------ -- Getting paths, path resolution, etc. diff --git a/unison-cli/src/Unison/Codebase/Transcript/Runner.hs b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs index 6e084a2eba..7ba207298e 100644 --- a/unison-cli/src/Unison/Codebase/Transcript/Runner.hs +++ b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs @@ -13,8 +13,6 @@ import Crypto.Random qualified as Random import Data.Aeson qualified as Aeson import Data.Aeson.Encode.Pretty qualified as Aeson import Data.ByteString.Lazy.Char8 qualified as BL -import Data.Configurator qualified as Configurator -import Data.Configurator.Types (Config) import Data.IORef import Data.List (isSubsequenceOf) import Data.List.NonEmpty qualified as NonEmpty @@ -24,9 +22,7 @@ import Data.These (These (..)) import Data.UUID.V4 qualified as UUID import Network.HTTP.Client qualified as HTTP import System.Environment (lookupEnv) -import System.Exit (die) import System.IO qualified as IO -import System.IO.Error (catchIOError) import Text.Megaparsec qualified as P import U.Codebase.Sqlite.DbId qualified as Db import U.Codebase.Sqlite.Project (Project (..)) @@ -96,16 +92,15 @@ withRunner :: Verbosity -> UCMVersion -> FilePath -> - Maybe FilePath -> (Runner -> m r) -> m r -withRunner isTest verbosity ucmVersion nrtp configFile action = do - withRuntimes nrtp \runtime sbRuntime nRuntime -> withConfig \config -> do +withRunner isTest verbosity ucmVersion nrtp action = do + withRuntimes nrtp \runtime sbRuntime nRuntime -> do action \transcriptName transcriptSrc (codebaseDir, codebase) -> do Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) Server.defaultCodebaseServerOpts runtime codebase \baseUrl -> do let parsed = Transcript.stanzas transcriptName transcriptSrc result <- for parsed \stanzas -> do - liftIO $ run isTest verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime config ucmVersion (tShow baseUrl) + liftIO $ run isTest verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime ucmVersion (tShow baseUrl) pure . join $ first ParseError result where withRuntimes :: @@ -115,19 +110,6 @@ withRunner isTest verbosity ucmVersion nrtp configFile action = do RTI.withRuntime True RTI.Persistent ucmVersion \sbRuntime -> do action runtime sbRuntime =<< liftIO (RTI.startNativeRuntime ucmVersion nrtp) - withConfig :: forall a. ((Maybe Config -> m a) -> m a) - withConfig action = do - case configFile of - Nothing -> action Nothing - Just configFilePath -> do - let loadConfig = liftIO do - catchIOError - (watchConfig configFilePath) - \_ -> die "Your .unisonConfig could not be loaded. Check that it's correct!" - UnliftIO.bracket - loadConfig - (\(_config, cancelConfig) -> liftIO cancelConfig) - (\(config, _cancelConfig) -> action (Just config)) run :: -- | Whether to treat this transcript run as a transcript test, which will try to make output deterministic @@ -139,11 +121,10 @@ run :: Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> - Maybe Config -> UCMVersion -> Text -> IO (Either Error Text) -run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion baseURL = UnliftIO.try do +run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime ucmVersion baseURL = UnliftIO.try do httpManager <- HTTP.newManager HTTP.defaultManagerSettings (initialPP, emptyCausalHashId) <- Codebase.runTransaction codebase do (_, emptyCausalHashId) <- Codebase.emptyCausalHash @@ -427,7 +408,6 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV Cli.Env { authHTTPClient = authenticatedHTTPClient, codebase, - config = fromMaybe Configurator.empty config, credentialManager = credMan, generateUniqueName = do i <- atomicModifyIORef' seedRef \i -> let !i' = i + 1 in (i', i) diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 168e264894..99ac5799d9 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -6,7 +6,6 @@ module Unison.CommandLine ( allow, parseInput, prompt, - watchConfig, watchFileSystem, ) where @@ -15,9 +14,6 @@ import Control.Concurrent (forkIO, killThread) import Control.Lens hiding (aside) import Control.Monad.Except import Control.Monad.Trans.Except -import Data.Configurator (autoConfig, autoReload) -import Data.Configurator qualified as Config -import Data.Configurator.Types (Config, Worth (..)) import Data.List (isPrefixOf, isSuffixOf) import Data.Map qualified as Map import Data.Semialign qualified as Align @@ -50,23 +46,12 @@ import Unison.Util.TQueue qualified as Q import UnliftIO.STM import Prelude hiding (readFile, writeFile) -disableWatchConfig :: Bool -disableWatchConfig = False - allow :: FilePath -> Bool allow p = -- ignore Emacs .# prefixed files, see https://github.com/unisonweb/unison/issues/457 not (".#" `isPrefixOf` takeFileName p) && (isSuffixOf ".u" p || isSuffixOf ".uu" p) -watchConfig :: FilePath -> IO (Config, IO ()) -watchConfig path = - if disableWatchConfig - then pure (Config.empty, pure ()) - else do - (config, t) <- autoReload autoConfig [Optional path] - pure (config, killThread t) - watchFileSystem :: Q.TQueue Event -> FilePath -> IO (IO ()) watchFileSystem q dir = do (cancel, watcher) <- Watch.watchDirectory dir allow diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 914581664b..cfefd666c0 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -9,7 +9,6 @@ import Control.Exception (catch, displayException, finally, mask) import Control.Lens ((?~)) import Control.Lens.Lens import Crypto.Random qualified as Random -import Data.Configurator.Types (Config) import Data.IORef import Data.List.NonEmpty qualified as NEL import Data.List.NonEmpty qualified as NonEmpty @@ -124,7 +123,6 @@ main :: FilePath -> Welcome.Welcome -> PP.ProjectPathIds -> - Config -> [Either Event Input] -> Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> @@ -135,7 +133,7 @@ main :: (PP.ProjectPathIds -> IO ()) -> ShouldWatchFiles -> IO () -main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion lspCheckForChanges shouldWatchFiles = Ki.scoped \scope -> do +main dir welcome ppIds initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion lspCheckForChanges shouldWatchFiles = Ki.scoped \scope -> do _ <- Ki.fork scope do -- Pre-load the project root in the background so it'll be ready when a command needs it. projectRoot <- Codebase.expectProjectBranchRoot codebase ppIds.project ppIds.branch @@ -221,7 +219,6 @@ main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase Cli.Env { authHTTPClient, codebase, - config, credentialManager, loadSource = loadSourceFile, writeSource = writeSourceFile, diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index 990f11354f..498f2b6218 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -27,7 +27,6 @@ import Compat (defaultInterruptHandler, withInterruptHandler) import Control.Concurrent (newEmptyMVar, runInUnboundThread, takeMVar) import Control.Exception (displayException, evaluate) import Data.ByteString.Lazy qualified as BL -import Data.Configurator.Types (Config) import Data.Either.Validation (Validation (..)) import Data.List.NonEmpty (NonEmpty) import Data.Text qualified as Text @@ -57,7 +56,6 @@ import System.FilePath ) import System.IO (stderr) import System.IO.CodePage (withCP65001) -import System.IO.Error (catchIOError) import System.IO.Temp qualified as Temp import System.Path qualified as Path import Text.Megaparsec qualified as MP @@ -76,7 +74,6 @@ import Unison.Codebase.Runtime qualified as Rt import Unison.Codebase.SqliteCodebase qualified as SC import Unison.Codebase.Transcript.Runner qualified as Transcript import Unison.Codebase.Verbosity qualified as Verbosity -import Unison.CommandLine (watchConfig) import Unison.CommandLine.Helpers (plural') import Unison.CommandLine.Main qualified as CommandLine import Unison.CommandLine.Types qualified as CommandLine @@ -96,7 +93,6 @@ import Unison.Symbol (Symbol) import Unison.Util.Pretty qualified as P import Unison.Version (Version) import Unison.Version qualified as Version -import UnliftIO qualified import UnliftIO.Directory (getHomeDirectory) type Runtimes = @@ -143,220 +139,216 @@ main version = do (renderUsageInfo, globalOptions, command) <- parseCLIArgs progName (Text.unpack (Version.gitDescribeWithDate version)) nrtp <- fixNativeRuntimePath (nativeRuntimePath globalOptions) let GlobalOptions {codebasePathOption = mCodePathOption, exitOption, lspFormattingConfig} = globalOptions - withConfig mCodePathOption \config -> do - currentDir <- getCurrentDirectory - case command of - PrintVersion -> - Text.putStrLn $ Text.pack progName <> " version: " <> Version.gitDescribeWithDate version - Init -> do - exitError - ( P.lines - [ "The Init command has been removed", - P.newline, - P.wrap "Use --codebase-create to create a codebase at a specified location and open it:", - P.indentN 2 (P.hiBlue "$ ucm --codebase-create myNewCodebase"), - "Running UCM without the --codebase-create flag: ", - P.indentN 2 (P.hiBlue "$ ucm"), - P.wrap ("will " <> P.bold "always" <> " create a codebase in your home directory if one does not already exist.") + currentDir <- getCurrentDirectory + case command of + PrintVersion -> + Text.putStrLn $ Text.pack progName <> " version: " <> Version.gitDescribeWithDate version + Init -> do + exitError + ( P.lines + [ "The Init command has been removed", + P.newline, + P.wrap "Use --codebase-create to create a codebase at a specified location and open it:", + P.indentN 2 (P.hiBlue "$ ucm --codebase-create myNewCodebase"), + "Running UCM without the --codebase-create flag: ", + P.indentN 2 (P.hiBlue "$ ucm"), + P.wrap ("will " <> P.bold "always" <> " create a codebase in your home directory if one does not already exist.") + ] + ) + Run (RunFromSymbol mainName) args -> do + getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, _, theCodebase) -> do + RTI.withRuntime False RTI.OneOff (Version.gitDescribeWithDate version) \runtime -> do + withArgs args (execute theCodebase runtime mainName) >>= \case + Left err -> exitError err + Right () -> pure () + Run (RunFromFile file mainName) args + | not (isDotU file) -> exitError "Files must have a .u extension." + | otherwise -> do + e <- safeReadUtf8 file + case e of + Left _ -> exitError "I couldn't find that file or it is for some reason unreadable." + Right contents -> do + getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do + withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do + let fileEvent = Input.UnisonFileChanged (Text.pack file) contents + let noOpCheckForChanges _ = pure () + let serverUrl = Nothing + startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath + launch + version + currentDir + rt + sbrt + nrt + theCodebase + [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] + serverUrl + (PP.toIds startProjectPath) + initRes + noOpCheckForChanges + CommandLine.ShouldNotWatchFiles + Run (RunFromPipe mainName) args -> do + e <- safeReadUtf8StdIn + case e of + Left _ -> exitError "I had trouble reading this input." + Right contents -> do + getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do + withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do + let fileEvent = Input.UnisonFileChanged (Text.pack "") contents + let noOpCheckForChanges _ = pure () + let serverUrl = Nothing + startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath + launch + version + currentDir + rt + sbrt + nrt + theCodebase + [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] + serverUrl + (PP.toIds startProjectPath) + initRes + noOpCheckForChanges + CommandLine.ShouldNotWatchFiles + Run (RunCompiled file) args -> + BL.readFile file >>= \bs -> + try (evaluate $ RTI.decodeStandalone bs) >>= \case + Left (PE _cs err) -> do + exitError . P.lines $ + [ P.wrap . P.text $ + "I was unable to parse this file as a compiled\ + \ program. The parser generated the following error:", + "", + P.indentN 2 $ err ] - ) - Run (RunFromSymbol mainName) args -> do - getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, _, theCodebase) -> do - RTI.withRuntime False RTI.OneOff (Version.gitDescribeWithDate version) \runtime -> do - withArgs args (execute theCodebase runtime mainName) >>= \case - Left err -> exitError err - Right () -> pure () - Run (RunFromFile file mainName) args - | not (isDotU file) -> exitError "Files must have a .u extension." - | otherwise -> do - e <- safeReadUtf8 file - case e of - Left _ -> exitError "I couldn't find that file or it is for some reason unreadable." - Right contents -> do - getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do - withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do - let fileEvent = Input.UnisonFileChanged (Text.pack file) contents - let noOpCheckForChanges _ = pure () - let serverUrl = Nothing - startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath + Right (Left err) -> + exitError . P.lines $ + [ P.wrap . P.text $ + "I was unable to parse this file as a compiled\ + \ program. The parser generated the following error:", + "", + P.indentN 2 . P.wrap $ P.string err + ] + Left _ -> do + exitError . P.wrap . P.text $ + "I was unable to parse this file as a compiled\ + \ program. The parser generated an unrecognized error." + Right (Right (v, rf, w, sto)) + | not vmatch -> mismatchMsg + | otherwise -> + withArgs args (RTI.runStandalone sto w) >>= \case + Left err -> exitError err + Right () -> pure () + where + vmatch = v == Version.gitDescribeWithDate version + ws s = P.wrap (P.text s) + ifile + | 'c' : 'u' : '.' : rest <- reverse file = reverse rest + | otherwise = file + mismatchMsg = + PT.putPrettyLn . P.lines $ + [ ws + "I can't run this compiled program since \ + \it works with a different version of Unison \ + \than the one you're running.", + "", + "Compiled file version", + P.indentN 4 $ P.text v, + "", + "Your version", + P.indentN 4 $ P.text $ Version.gitDescribeWithDate version, + "", + P.wrap $ + "The program was compiled from hash " + <> (P.text $ "`" <> rf <> "`.") + <> "If you have that hash in your codebase," + <> "you can do:", + "", + P.indentN 4 $ + ".> compile " + <> P.text rf + <> " " + <> P.string ifile, + "", + P.wrap + "to produce a new compiled program \ + \that matches your version of Unison." + ] + Transcript shouldFork shouldSaveCodebase mrtsStatsFp transcriptFiles -> do + let action = runTranscripts version Verbosity.Verbose renderUsageInfo shouldFork shouldSaveCodebase mCodePathOption nrtp transcriptFiles + case mrtsStatsFp of + Nothing -> action + Just fp -> recordRtsStats fp action + Launch isHeadless codebaseServerOpts mayStartingProject shouldWatchFiles -> do + getCodebaseOrExit mCodePathOption (SC.MigrateAfterPrompt SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do + withRuntimes nrtp RTI.Persistent \(runtime, sbRuntime, nRuntime) -> do + startingProjectPath <- do + -- If the user didn't provide a starting path on the command line, put them in the most recent + -- path they cd'd to + case mayStartingProject of + Just startingProject -> do + Codebase.runTransaction theCodebase (ProjectUtils.getProjectAndBranchByNames startingProject) >>= \case + Nothing -> do + PT.putPrettyLn $ + P.callout + "❓" + ( P.lines + [ P.indentN 2 "I couldn't find the project branch: " <> P.text (into @Text startingProject) + ] + ) + System.exitFailure + Just pab -> do + pure $ PP.fromProjectAndBranch pab Path.absoluteEmpty + Nothing -> do + Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath + currentPP <- Codebase.runTransaction theCodebase do + PP.toIds <$> Codebase.expectCurrentProjectPath + changeSignal <- Signal.newSignalIO (Just currentPP) + let lspCheckForChanges pp = Signal.writeSignalIO changeSignal pp + -- Unfortunately, the windows IO manager on GHC 8.* is prone to just hanging forever + -- when waiting for input on handles, so if we listen for LSP connections it will + -- prevent UCM from shutting down properly. Hopefully we can re-enable LSP on + -- Windows when we move to GHC 9.* + -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1224 + void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime changeSignal + Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) codebaseServerOpts sbRuntime theCodebase $ \baseUrl -> do + case exitOption of + DoNotExit -> do + case isHeadless of + Headless -> do + PT.putPrettyLn $ + P.lines + [ "I've started the Codebase API server at", + P.text $ Server.urlFor Server.Api baseUrl, + "and the Codebase UI at", + P.text $ Server.urlFor (Server.ProjectBranchUI (ProjectAndBranch (UnsafeProjectName "scratch") (UnsafeProjectBranchName "main")) Path.absoluteEmpty Nothing) baseUrl + ] + PT.putPrettyLn $ + P.string "Running the codebase manager headless with " + <> P.shown GHC.Conc.numCapabilities + <> " " + <> plural' GHC.Conc.numCapabilities "cpu" "cpus" + <> "." + mvar <- newEmptyMVar + takeMVar mvar + WithCLI -> do + PT.putPrettyLn $ P.string "Now starting the Unison Codebase Manager (UCM)..." + launch version currentDir - config - rt - sbrt - nrt + runtime + sbRuntime + nRuntime theCodebase - [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] - serverUrl - (PP.toIds startProjectPath) + [] + (Just baseUrl) + (PP.toIds startingProjectPath) initRes - noOpCheckForChanges - CommandLine.ShouldNotWatchFiles - Run (RunFromPipe mainName) args -> do - e <- safeReadUtf8StdIn - case e of - Left _ -> exitError "I had trouble reading this input." - Right contents -> do - getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do - withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do - let fileEvent = Input.UnisonFileChanged (Text.pack "") contents - let noOpCheckForChanges _ = pure () - let serverUrl = Nothing - startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath - launch - version - currentDir - config - rt - sbrt - nrt - theCodebase - [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] - serverUrl - (PP.toIds startProjectPath) - initRes - noOpCheckForChanges - CommandLine.ShouldNotWatchFiles - Run (RunCompiled file) args -> - BL.readFile file >>= \bs -> - try (evaluate $ RTI.decodeStandalone bs) >>= \case - Left (PE _cs err) -> do - exitError . P.lines $ - [ P.wrap . P.text $ - "I was unable to parse this file as a compiled\ - \ program. The parser generated the following error:", - "", - P.indentN 2 $ err - ] - Right (Left err) -> - exitError . P.lines $ - [ P.wrap . P.text $ - "I was unable to parse this file as a compiled\ - \ program. The parser generated the following error:", - "", - P.indentN 2 . P.wrap $ P.string err - ] - Left _ -> do - exitError . P.wrap . P.text $ - "I was unable to parse this file as a compiled\ - \ program. The parser generated an unrecognized error." - Right (Right (v, rf, w, sto)) - | not vmatch -> mismatchMsg - | otherwise -> - withArgs args (RTI.runStandalone sto w) >>= \case - Left err -> exitError err - Right () -> pure () - where - vmatch = v == Version.gitDescribeWithDate version - ws s = P.wrap (P.text s) - ifile - | 'c' : 'u' : '.' : rest <- reverse file = reverse rest - | otherwise = file - mismatchMsg = - PT.putPrettyLn . P.lines $ - [ ws - "I can't run this compiled program since \ - \it works with a different version of Unison \ - \than the one you're running.", - "", - "Compiled file version", - P.indentN 4 $ P.text v, - "", - "Your version", - P.indentN 4 $ P.text $ Version.gitDescribeWithDate version, - "", - P.wrap $ - "The program was compiled from hash " - <> (P.text $ "`" <> rf <> "`.") - <> "If you have that hash in your codebase," - <> "you can do:", - "", - P.indentN 4 $ - ".> compile " - <> P.text rf - <> " " - <> P.string ifile, - "", - P.wrap - "to produce a new compiled program \ - \that matches your version of Unison." - ] - Transcript shouldFork shouldSaveCodebase mrtsStatsFp transcriptFiles -> do - let action = runTranscripts version Verbosity.Verbose renderUsageInfo shouldFork shouldSaveCodebase mCodePathOption nrtp transcriptFiles - case mrtsStatsFp of - Nothing -> action - Just fp -> recordRtsStats fp action - Launch isHeadless codebaseServerOpts mayStartingProject shouldWatchFiles -> do - getCodebaseOrExit mCodePathOption (SC.MigrateAfterPrompt SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do - withRuntimes nrtp RTI.Persistent \(runtime, sbRuntime, nRuntime) -> do - startingProjectPath <- do - -- If the user didn't provide a starting path on the command line, put them in the most recent - -- path they cd'd to - case mayStartingProject of - Just startingProject -> do - Codebase.runTransaction theCodebase (ProjectUtils.getProjectAndBranchByNames startingProject) >>= \case - Nothing -> do - PT.putPrettyLn $ - P.callout - "❓" - ( P.lines - [ P.indentN 2 "I couldn't find the project branch: " <> P.text (into @Text startingProject) - ] - ) - System.exitFailure - Just pab -> do - pure $ PP.fromProjectAndBranch pab Path.absoluteEmpty - Nothing -> do - Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath - currentPP <- Codebase.runTransaction theCodebase do - PP.toIds <$> Codebase.expectCurrentProjectPath - changeSignal <- Signal.newSignalIO (Just currentPP) - let lspCheckForChanges pp = Signal.writeSignalIO changeSignal pp - -- Unfortunately, the windows IO manager on GHC 8.* is prone to just hanging forever - -- when waiting for input on handles, so if we listen for LSP connections it will - -- prevent UCM from shutting down properly. Hopefully we can re-enable LSP on - -- Windows when we move to GHC 9.* - -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1224 - void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime changeSignal - Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) codebaseServerOpts sbRuntime theCodebase $ \baseUrl -> do - case exitOption of - DoNotExit -> do - case isHeadless of - Headless -> do - PT.putPrettyLn $ - P.lines - [ "I've started the Codebase API server at", - P.text $ Server.urlFor Server.Api baseUrl, - "and the Codebase UI at", - P.text $ Server.urlFor (Server.ProjectBranchUI (ProjectAndBranch (UnsafeProjectName "scratch") (UnsafeProjectBranchName "main")) Path.absoluteEmpty Nothing) baseUrl - ] - PT.putPrettyLn $ - P.string "Running the codebase manager headless with " - <> P.shown GHC.Conc.numCapabilities - <> " " - <> plural' GHC.Conc.numCapabilities "cpu" "cpus" - <> "." - mvar <- newEmptyMVar - takeMVar mvar - WithCLI -> do - PT.putPrettyLn $ P.string "Now starting the Unison Codebase Manager (UCM)..." - - launch - version - currentDir - config - runtime - sbRuntime - nRuntime - theCodebase - [] - (Just baseUrl) - (PP.toIds startingProjectPath) - initRes - lspCheckForChanges - shouldWatchFiles - Exit -> do Exit.exitSuccess + lspCheckForChanges + shouldWatchFiles + Exit -> do Exit.exitSuccess where -- (runtime, sandboxed runtime) withRuntimes :: FilePath -> RTI.RuntimeHost -> (Runtimes -> IO a) -> IO a @@ -366,17 +358,6 @@ main version = do action . (runtime,sbRuntime,) -- startNativeRuntime saves the path to `unison-runtime` =<< RTI.startNativeRuntime (Version.gitDescribeWithDate version) nrtp - withConfig :: Maybe CodebasePathOption -> (Config -> IO a) -> IO a - withConfig mCodePathOption action = do - UnliftIO.bracket - ( do - let mcodepath = fmap codebasePathOptionToPath mCodePathOption - configFilePath <- getConfigFilePath mcodepath - catchIOError (watchConfig configFilePath) $ \_ -> - exitError "Your .unisonConfig could not be loaded. Check that it's correct!" - ) - (\(_config, cancel) -> cancel) - (\(config, _cancel) -> action config) -- | Set user agent and configure TLS on global http client. -- Note that the authorized http client is distinct from the global http client. @@ -416,14 +397,12 @@ prepareTranscriptDir verbosity shouldFork mCodePathOption shouldSaveCodebase = d runTranscripts' :: Version -> String -> - Maybe FilePath -> FilePath -> FilePath -> NonEmpty MarkdownFile -> IO Bool -runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles = do +runTranscripts' version progName nativeRtp transcriptDir markdownFiles = do currentDir <- getCurrentDirectory - configFilePath <- getConfigFilePath mcodepath -- We don't need to create a codebase through `getCodebaseOrExit` as we've already done so previously. and <$> getCodebaseOrExit @@ -436,7 +415,6 @@ runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles Verbosity.Verbose (Version.gitDescribeWithDate version) nativeRtp - (Just configFilePath) \runTranscript -> do for markdownFiles $ \(MarkdownFile fileName) -> do transcriptSrc <- readUtf8 fileName @@ -503,7 +481,7 @@ runTranscripts version verbosity renderUsageInfo shouldFork shouldSaveTempCodeba progName <- getProgName transcriptDir <- prepareTranscriptDir verbosity shouldFork mCodePathOption shouldSaveTempCodebase completed <- - runTranscripts' version progName (Just transcriptDir) nativeRtp transcriptDir markdownFiles + runTranscripts' version progName nativeRtp transcriptDir markdownFiles case shouldSaveTempCodebase of DontSaveCodebase -> removeDirectoryRecursive transcriptDir SaveCodebase _ -> @@ -527,7 +505,6 @@ runTranscripts version verbosity renderUsageInfo shouldFork shouldSaveTempCodeba launch :: Version -> FilePath -> - Config -> Rt.Runtime Symbol -> Rt.Runtime Symbol -> Rt.Runtime Symbol -> @@ -539,7 +516,7 @@ launch :: (PP.ProjectPathIds -> IO ()) -> CommandLine.ShouldWatchFiles -> IO () -launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl startingPath initResult lspCheckForChanges shouldWatchFiles = do +launch version dir runtime sbRuntime nRuntime codebase inputs serverBaseUrl startingPath initResult lspCheckForChanges shouldWatchFiles = do showWelcomeHint <- Codebase.runTransaction codebase Queries.doProjectsExist let isNewCodebase = case initResult of CreatedCodebase -> NewlyCreatedCodebase @@ -550,7 +527,6 @@ launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseU dir welcome startingPath - config inputs runtime sbRuntime @@ -572,9 +548,6 @@ markdownFile md = case takeExtension md of isDotU :: String -> Bool isDotU file = takeExtension file == ".u" -getConfigFilePath :: Maybe FilePath -> IO FilePath -getConfigFilePath mcodepath = ( ".unisonConfig") <$> Codebase.getCodebaseDir mcodepath - getCodebaseOrExit :: Maybe CodebasePathOption -> SC.MigrationStrategy -> ((InitResult, CodebasePath, Codebase IO Symbol Ann) -> IO r) -> IO r getCodebaseOrExit codebasePathOption migrationStrategy action = do initOptions <- argsToCodebaseInitOptions codebasePathOption diff --git a/unison-cli/tests/Unison/Test/Ucm.hs b/unison-cli/tests/Unison/Test/Ucm.hs index 1a8033c52b..c0d2cb0977 100644 --- a/unison-cli/tests/Unison/Test/Ucm.hs +++ b/unison-cli/tests/Unison/Test/Ucm.hs @@ -67,7 +67,7 @@ runTranscript (Codebase codebasePath fmt) transcript = do let err e = fail $ "Parse error: \n" <> show e cbInit = case fmt of CodebaseFormat2 -> SC.init isTest = True - Transcript.withRunner isTest Verbosity.Silent "Unison.Test.Ucm.runTranscript Invalid Version String" rtp configFile $ + Transcript.withRunner isTest Verbosity.Silent "Unison.Test.Ucm.runTranscript Invalid Version String" rtp $ \runner -> do result <- Codebase.Init.withOpenCodebase cbInit "transcript" codebasePath SC.DoLock SC.DontMigrate \codebase -> do Codebase.runTransaction codebase (Codebase.installUcmDependencies codebase) @@ -77,7 +77,6 @@ runTranscript (Codebase codebasePath fmt) transcript = do pure output either (fail . P.toANSI 80 . P.shown) pure result where - configFile = Nothing -- Note: this needs to be properly configured if these tests ever -- need to do native compiles. But I suspect they won't. rtp = "native-compiler/bin" diff --git a/unison-cli/transcripts/Transcripts.hs b/unison-cli/transcripts/Transcripts.hs index 77220a3061..2b7d7677d0 100644 --- a/unison-cli/transcripts/Transcripts.hs +++ b/unison-cli/transcripts/Transcripts.hs @@ -49,7 +49,7 @@ testBuilder :: testBuilder expectFailure recordFailure runtimePath dir prelude transcript = scope transcript $ do outputs <- io . withTemporaryUcmCodebase SC.init Verbosity.Silent "transcript" SC.DoLock $ \(codebasePath, codebase) -> do let isTest = True - Transcript.withRunner isTest Verbosity.Silent "TODO: pass version here" runtimePath Nothing \runTranscript -> do + Transcript.withRunner isTest Verbosity.Silent "TODO: pass version here" runtimePath \runTranscript -> do for files \filePath -> do transcriptSrc <- readUtf8 filePath out <- silence $ runTranscript filePath transcriptSrc (codebasePath, codebase) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 6a3df61e73..a12b033231 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -205,7 +205,6 @@ library , co-log-core , code-page , concurrent-output - , configurator , containers >=0.6.3 , cryptonite , directory @@ -347,7 +346,6 @@ executable transcripts , co-log-core , code-page , concurrent-output - , configurator , containers >=0.6.3 , cryptonite , directory @@ -496,7 +494,6 @@ test-suite cli-tests , co-log-core , code-page , concurrent-output - , configurator , containers >=0.6.3 , cryptonite , directory From bbb04d9da25f577a75def3539492e8dc6c21f486 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 26 Aug 2024 13:37:19 -0400 Subject: [PATCH 618/631] get the transcripts passing (but a couple are still broken) --- .../src/Unison/Runtime/IOSource.hs | 3 +- .../src/Unison/Syntax/FileParser.hs | 17 ++- .../src/Unison/Syntax/TermParser.hs | 39 +++--- .../src/Unison/Codebase/Editor/HandleInput.hs | 3 +- .../Codebase/Editor/HandleInput/Load.hs | 7 +- unison-cli/src/Unison/LSP/FileAnalysis.hs | 3 +- unison-core/src/Unison/NamesWithHistory.hs | 2 +- unison-src/transcripts-using-base/base.u | 2 +- unison-src/transcripts/delete.md | 2 +- unison-src/transcripts/delete.output.md | 2 +- .../transcripts/destructuring-binds.output.md | 24 ++-- unison-src/transcripts/fix1578.md | 112 ------------------ unison-src/transcripts/fix1578.output.md | 105 ---------------- unison-src/transcripts/fix3037.output.md | 39 +++--- unison-src/transcripts/fix845.output.md | 22 ++-- unison-src/transcripts/io.md | 12 +- unison-src/transcripts/io.output.md | 12 +- unison-src/transcripts/namespace-directive.md | 2 +- .../transcripts/namespace-directive.output.md | 2 +- .../transcripts/pattern-match-coverage.md | 4 +- .../pattern-match-coverage.output.md | 25 ++-- unison-src/transcripts/suffixes.md | 32 ----- unison-src/transcripts/suffixes.output.md | 54 --------- unison-syntax/src/Unison/Syntax/Parser.hs | 32 ++++- 24 files changed, 150 insertions(+), 407 deletions(-) delete mode 100644 unison-src/transcripts/fix1578.md delete mode 100644 unison-src/transcripts/fix1578.output.md diff --git a/parser-typechecker/src/Unison/Runtime/IOSource.hs b/parser-typechecker/src/Unison/Runtime/IOSource.hs index 2480e28925..a589c9ae06 100644 --- a/parser-typechecker/src/Unison/Runtime/IOSource.hs +++ b/parser-typechecker/src/Unison/Runtime/IOSource.hs @@ -41,7 +41,8 @@ parsingEnv = Parser.ParsingEnv { uniqueNames = mempty, uniqueTypeGuid = \_ -> pure Nothing, - names = Builtin.names + names = Builtin.names, + maybeNamespace = Nothing } typecheckingEnv :: Typechecker.Env Symbol Ann diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 0b2a30cef4..ce3d01382c 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -52,10 +52,11 @@ file = do _ <- openBlock -- Parse an optional directive like "namespace foo.bar" - maybeNamespace :: Maybe v <- + maybeNamespace :: Maybe Name.Name <- optional (reserved "namespace") >>= \case Nothing -> pure Nothing - Just _ -> Just . Name.toVar . L.payload <$> (importWordyId <|> importSymbolyId) + Just _ -> Just . L.payload <$> (importWordyId <|> importSymbolyId) + let maybeNamespaceVar = Name.toVar <$> maybeNamespace -- The file may optionally contain top-level imports, -- which are parsed and applied to the type decls and term stanzas @@ -65,7 +66,7 @@ file = do env <- let applyNamespaceToDecls :: forall decl. Iso' decl (DataDeclaration v Ann) -> Map v decl -> Map v decl applyNamespaceToDecls dataDeclL = - case maybeNamespace of + case maybeNamespaceVar of Nothing -> id Just namespace -> Map.fromList . map f . Map.toList where @@ -90,7 +91,7 @@ file = do (typ, fields) <- parsedAccessors -- The parsed accessor has an un-namespaced type, so apply the namespace directive (if necessary) before -- looking up in the environment computed by `environmentFor`. - let typ1 = maybe id Var.namespaced2 maybeNamespace (L.payload typ) + let typ1 = maybe id Var.namespaced2 maybeNamespaceVar (L.payload typ) Just (r, _) <- [Map.lookup typ1 (UF.datas env)] -- Generate the record accessors with *un-namespaced* names (passing `typ` rather than `typ1`) below, because we -- need to know these names in order to perform rewriting. As an example, @@ -107,21 +108,19 @@ file = do let accessors :: [(v, Ann, Term v Ann)] accessors = unNamespacedAccessors - & case maybeNamespace of + & case maybeNamespaceVar of Nothing -> id Just namespace -> over (mapped . _1) (Var.namespaced2 namespace) - let importNames = [(Name.unsafeParseVar v, Name.unsafeParseVar v2) | (v, v2) <- imports] - let locals = Names.importing importNames (UF.names env) -- At this stage of the file parser, we've parsed all the type and ability -- declarations. - local (\e -> e {names = Names.shadowing locals namesStart}) do + local (\e -> e {names = Names.shadowing (UF.names env) namesStart, maybeNamespace}) do names <- asks names stanzas <- do unNamespacedStanzas0 <- sepBy semi stanza let unNamespacedStanzas = fmap (TermParser.substImports names imports) <$> unNamespacedStanzas0 pure $ unNamespacedStanzas - & case maybeNamespace of + & case maybeNamespaceVar of Nothing -> id Just namespace -> let unNamespacedTermNamespaceNames :: Set v diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index e89960e9c3..77fb96c8fb 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -122,7 +122,8 @@ typeLink' :: (Monad m, Var v) => P v m (L.Token Reference) typeLink' = findUniqueType =<< hqPrefixId findUniqueType :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> P v m (L.Token Reference) -findUniqueType id = do +findUniqueType id0 = do + id <- applyNamespaceToToken id0 ns <- asks names case Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns of s @@ -131,7 +132,7 @@ findUniqueType id = do termLink' :: (Monad m, Var v) => P v m (L.Token Referent) termLink' = do - id <- hqPrefixId + id <- applyNamespaceToToken =<< hqPrefixId ns <- asks names case Names.lookupHQTerm Names.IncludeSuffixes (L.payload id) ns of s @@ -140,7 +141,7 @@ termLink' = do link' :: (Monad m, Var v) => P v m (Either (L.Token Reference) (L.Token Referent)) link' = do - id <- hqPrefixId + id <- applyNamespaceToToken =<< hqPrefixId ns <- asks names case (Names.lookupHQTerm Names.IncludeSuffixes (L.payload id) ns, Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns) of (s, s2) | Set.size s == 1 && Set.null s2 -> pure . Right $ const (Set.findMin s) <$> id @@ -290,7 +291,7 @@ parsePattern = label "pattern" root ctor :: CT.ConstructorType -> P v m (L.Token ConstructorReference) ctor ct = do -- this might be a var, so we avoid consuming it at first - tok <- P.try (P.lookAhead hqPrefixId) + tok <- applyNamespaceToToken =<< P.try (P.lookAhead hqPrefixId) names <- asks names -- probably should avoid looking up in `names` if `L.payload tok` -- starts with a lowercase @@ -450,15 +451,23 @@ nameIsKeyword name keyword = -- has a short hash, we resolve that short hash immediately and fail -- committed if that short hash can't be found in the current environment resolveHashQualified :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> TermP v m -resolveHashQualified tok = do +resolveHashQualified tok0 = do names <- asks names - case L.payload tok of - HQ.NameOnly n -> pure $ Term.var (ann tok) (Name.toVar n) - hqn -> case Names.lookupHQTerm Names.IncludeSuffixes hqn names of - s - | Set.null s -> failCommitted $ UnknownTerm tok s - | Set.size s > 1 -> failCommitted $ UnknownTerm tok s - | otherwise -> pure $ Term.fromReferent (ann tok) (Set.findMin s) + case L.payload tok0 of + HQ.NameOnly n -> pure $ Term.var (ann tok0) (Name.toVar n) + _ -> do + tok <- applyNamespaceToToken tok0 + case Names.lookupHQTerm Names.IncludeSuffixes (L.payload tok) names of + s + | Set.null s -> failCommitted $ UnknownTerm tok s + | Set.size s > 1 -> failCommitted $ UnknownTerm tok s + | otherwise -> pure $ Term.fromReferent (ann tok) (Set.findMin s) + +applyNamespaceToToken :: (Monad m) => L.Token (HQ.HashQualified Name) -> P v m (L.Token (HQ.HashQualified Name)) +applyNamespaceToToken tok = + asks maybeNamespace <&> \case + Nothing -> tok + Just namespace -> fmap (fmap (Name.joinDot namespace)) tok termLeaf :: forall m v. (Monad m, Var v) => TermP v m termLeaf = @@ -1262,14 +1271,14 @@ block' isTop implicitUnitAtEnd s openBlock closeBlock = do open <- openBlock (names, imports) <- imports _ <- optional semi - statements <- local (\e -> e {names = names}) $ sepBy semi statement + statements <- local (\e -> e {names}) $ sepBy semi statement end <- closeBlock body <- substImports names imports <$> go open statements pure (ann open <> ann end, body) where statement = asum [Binding <$> binding, DestructuringBind <$> destructuringBind, Action <$> blockTerm] go :: L.Token () -> [BlockElement v] -> P v m (Term v Ann) - go open bs = + go open = let finish :: Term.Term v Ann -> TermP v m finish tm = case Components.minimize' tm of Left dups -> customFailure $ DuplicateTermNames (toList dups) @@ -1309,7 +1318,7 @@ block' isTop implicitUnitAtEnd s openBlock closeBlock = do if implicitUnitAtEnd then (toList bs, DD.unitTerm a) else (toList bs, Term.var a (positionalVar a Var.missingResult)) - in toTm bs + in toTm number :: (Var v) => TermP v m number = number' (tok Term.int) (tok Term.nat) (tok Term.float) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 7e00fe534c..068231d077 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -1672,7 +1672,8 @@ parseType input src = do Parser.ParsingEnv { uniqueNames = mempty, uniqueTypeGuid = \_ -> pure Nothing, - names + names, + maybeNamespace = Nothing } typ <- Parsers.parseType (Text.unpack (fst lexed)) parsingEnv & onLeftM \err -> diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs index 4a2ceeb016..3694354d76 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs @@ -27,7 +27,7 @@ import Unison.Codebase.Editor.Slurp qualified as Slurp import Unison.Codebase.Runtime qualified as Runtime import Unison.FileParsers qualified as FileParsers import Unison.Names (Names) -import Unison.Names qualified as Names +import Unison.NamesWithHistory qualified as Names (shadowing) import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Ann import Unison.Parsers qualified as Parsers @@ -100,7 +100,8 @@ loadUnisonFile sourceName text = do Parser.ParsingEnv { uniqueNames = uniqueName, uniqueTypeGuid = Cli.loadUniqueTypeGuid pp, - names + names, + maybeNamespace = Nothing } unisonFile <- Cli.runTransaction (Parsers.parseFile (Text.unpack sourceName) (Text.unpack text) parsingEnv) @@ -117,7 +118,7 @@ loadUnisonFile sourceName text = do names -- Shadow just the type decl and constructor names (because the unison file didn't typecheck so we -- don't have term `Names`) - & Names.unionLeft (UF.toNames unisonFile) + & Names.shadowing (UF.toNames unisonFile) in PPED.makePPED (PPE.hqNamer 10 ns) ( PPE.suffixifyByHashWithUnhashedTermsInScope diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index bec9f8bf9f..5f647be8d4 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -92,7 +92,8 @@ checkFile doc = runMaybeT do Parser.ParsingEnv { uniqueNames = uniqueName, uniqueTypeGuid = Cli.loadUniqueTypeGuid pp, - names = parseNames + names = parseNames, + maybeNamespace = Nothing } (notes, parsedFile, typecheckedFile) <- do liftIO do diff --git a/unison-core/src/Unison/NamesWithHistory.hs b/unison-core/src/Unison/NamesWithHistory.hs index e7e10fee6f..d578eddad2 100644 --- a/unison-core/src/Unison/NamesWithHistory.hs +++ b/unison-core/src/Unison/NamesWithHistory.hs @@ -108,7 +108,7 @@ push n0 ns = unionLeft0 n1 ns -- This can be used to shadow names in the codebase with names in a unison file for instance: -- e.g. @shadowing scratchFileNames codebaseNames@ shadowing :: Names -> Names -> Names -shadowing = Names.unionLeft +shadowing = Names.unionLeftName -- Find all types whose name has a suffix matching the provided `HashQualified`, -- returning types with relative names if they exist, and otherwise diff --git a/unison-src/transcripts-using-base/base.u b/unison-src/transcripts-using-base/base.u index b1023f558a..51d572aa1d 100644 --- a/unison-src/transcripts-using-base/base.u +++ b/unison-src/transcripts-using-base/base.u @@ -87,7 +87,7 @@ List.filter: (a -> Boolean) -> [a] -> [a] List.filter f all = go acc = cases [] -> acc - a +: as -> if (f a) then go (cons a acc) as else go acc as + a +: as -> if (f a) then go (a +: acc) as else go acc as go [] all List.forEach : [a] -> (a ->{e} ()) ->{e} () diff --git a/unison-src/transcripts/delete.md b/unison-src/transcripts/delete.md index 9c1b8efd1a..ce934fd83a 100644 --- a/unison-src/transcripts/delete.md +++ b/unison-src/transcripts/delete.md @@ -147,7 +147,7 @@ structural type Foo = Foo Nat incrementFoo : Foo -> Nat incrementFoo = cases - (Foo n) -> n + 1 + (Foo.Foo n) -> n + 1 ``` ```ucm diff --git a/unison-src/transcripts/delete.output.md b/unison-src/transcripts/delete.output.md index 6107a7fd04..0a9139a6cf 100644 --- a/unison-src/transcripts/delete.output.md +++ b/unison-src/transcripts/delete.output.md @@ -346,7 +346,7 @@ structural type Foo = Foo Nat incrementFoo : Foo -> Nat incrementFoo = cases - (Foo n) -> n + 1 + (Foo.Foo n) -> n + 1 ``` ``` ucm diff --git a/unison-src/transcripts/destructuring-binds.output.md b/unison-src/transcripts/destructuring-binds.output.md index 371864ee95..8dae5b1603 100644 --- a/unison-src/transcripts/destructuring-binds.output.md +++ b/unison-src/transcripts/destructuring-binds.output.md @@ -86,20 +86,20 @@ ex4 = Loading changes detected in scratch.u. - I couldn't figure out what a refers to here: - 2 | (a,b) = (a Nat.+ b, 19) - - I think its type should be: - - Nat + ❓ + + I couldn't resolve any of these symbols: + + 2 | (a,b) = (a Nat.+ b, 19) + + + Symbol Suggestions + + a No matches + + b No matches - Some common causes of this error include: - * Your current namespace is too deep to contain the - definition in its subtree - * The definition is part of a library which hasn't been - added to this project - * You have a typo in the name ``` Even though the parser accepts any pattern on the LHS of a bind, it looks pretty weird to see things like `12 = x`, so we avoid showing a destructuring bind when the LHS is a "literal" pattern (like `42` or "hi"). Again these examples wouldn't compile with coverage checking. diff --git a/unison-src/transcripts/fix1578.md b/unison-src/transcripts/fix1578.md deleted file mode 100644 index 809af6c161..0000000000 --- a/unison-src/transcripts/fix1578.md +++ /dev/null @@ -1,112 +0,0 @@ -This transcript shows how suffix-based name resolution works when definitions in the file share a suffix with definitions already in the codebase. - -## Setup - -```ucm:hide -scratch/main> builtins.merge -``` - -As setup, we'll add a data type `Day` and a definition `foo.bar : Nat`. - -```unison:hide -unique type Day = Sun | Mon | Tue | Wed | Thu | Fri | Sat - -foo.bar : Nat -foo.bar = 23 -``` - -```ucm:hide -scratch/main> add -``` - -Suffix-based name resolution prefers to use names locally defined in the current file, then checks for matches in the codebase. Here are the precise rules, which will be explained below with examples: - -* If a symbol, `s`, is a suffix of exactly one definition `d` in the file, then `s` refers to `d`. -* Otherwise, if `s` is a suffix of exactly one definition `d` in the codebase, then `s` refers to `d`. -* Otherwise, if `s` is a suffix of multiple definitions in the file or the codebase, then (at least for terms) type-directed name resolution will be attempted to figure out which definition `s` refers to. - -## Example 1: local file term definitions shadow codebase term definitions - -This should typecheck, using the file's `bar : Text` rather than the codebase `foo.bar : Nat`: - -```unison:hide -use Text ++ - -bar : Text -bar = "hello" - -baz = bar ++ ", world!" -``` - -## Example 2: any locally unique term suffix shadows codebase term definitions - -This should also typecheck, using the file's `oog.bar`. This shows you can refer to a definition in the file by any suffix that is unique to definitions in the file (even if that suffix may match other definitions in the _codebase_). See example 4 below for overriding this behavior. - -```unison:hide -use Text ++ - -oog.bar = "hello" - -baz = bar ++ ", world!" -``` - -This subtle test establishes that we aren't using type-directed name resolution (TDNR) for the local term references in the file. If this were using TDNR, it would fail with an ambiguity as there's nothing that pins down the expected type of `bar` here: - -```unison:hide -use Text ++ - -oog.bar = "hello" - -baz = (bar, 42) -``` - -This subtle test establishes that locally introduced variables (within a function, say) correctly shadow definitions introduced at the file top level: - -```unison:hide -use Text ++ - -oog.bar = "hello" - -baz : [Int] -> ([Int], Nat) -baz bar = (bar, 42) -- here, `bar` refers to the parameter -``` - -## Example 3: Local type and constructor definitions shadow codebase definitions - -This should also typecheck, using the local `Sun`, and not `Day.Sun` which exists in the codebase, and the local `Day`, not the codebase `Day`. - -```unison:hide -structural type Zoot = Zonk | Sun - -structural type Day = Day Int - -use Zoot Zonk - -flip : Zoot -> Zoot -flip = cases - Sun -> Zonk - Zonk -> Sun - -day1 : Day -day1 = Day +1 -``` - -## Example 4: Refering to codebase definitions via a unique suffix - -Even though local definitions are preferred, you can refer to definitions in the codebase via any unique suffix that doesn't also exist in the file. - -```unison:hide -structural type Zoot = Zonk | Sun - -use Zoot Zonk - -blah = cases - Day.Sun -> Day.Tue - day -> day - -blah2 = - -- imports work too if you get tired of typing Day.Sun over and over - use Day Sun - cases Sun -> Wed - day -> day -``` diff --git a/unison-src/transcripts/fix1578.output.md b/unison-src/transcripts/fix1578.output.md deleted file mode 100644 index 0645dae519..0000000000 --- a/unison-src/transcripts/fix1578.output.md +++ /dev/null @@ -1,105 +0,0 @@ -This transcript shows how suffix-based name resolution works when definitions in the file share a suffix with definitions already in the codebase. - -## Setup - -As setup, we'll add a data type `Day` and a definition `foo.bar : Nat`. - -``` unison -unique type Day = Sun | Mon | Tue | Wed | Thu | Fri | Sat - -foo.bar : Nat -foo.bar = 23 -``` - -Suffix-based name resolution prefers to use names locally defined in the current file, then checks for matches in the codebase. Here are the precise rules, which will be explained below with examples: - - - If a symbol, `s`, is a suffix of exactly one definition `d` in the file, then `s` refers to `d`. - - Otherwise, if `s` is a suffix of exactly one definition `d` in the codebase, then `s` refers to `d`. - - Otherwise, if `s` is a suffix of multiple definitions in the file or the codebase, then (at least for terms) type-directed name resolution will be attempted to figure out which definition `s` refers to. - -## Example 1: local file term definitions shadow codebase term definitions - -This should typecheck, using the file's `bar : Text` rather than the codebase `foo.bar : Nat`: - -``` unison -use Text ++ - -bar : Text -bar = "hello" - -baz = bar ++ ", world!" -``` - -## Example 2: any locally unique term suffix shadows codebase term definitions - -This should also typecheck, using the file's `oog.bar`. This shows you can refer to a definition in the file by any suffix that is unique to definitions in the file (even if that suffix may match other definitions in the *codebase*). See example 4 below for overriding this behavior. - -``` unison -use Text ++ - -oog.bar = "hello" - -baz = bar ++ ", world!" -``` - -This subtle test establishes that we aren't using type-directed name resolution (TDNR) for the local term references in the file. If this were using TDNR, it would fail with an ambiguity as there's nothing that pins down the expected type of `bar` here: - -``` unison -use Text ++ - -oog.bar = "hello" - -baz = (bar, 42) -``` - -This subtle test establishes that locally introduced variables (within a function, say) correctly shadow definitions introduced at the file top level: - -``` unison -use Text ++ - -oog.bar = "hello" - -baz : [Int] -> ([Int], Nat) -baz bar = (bar, 42) -- here, `bar` refers to the parameter -``` - -## Example 3: Local type and constructor definitions shadow codebase definitions - -This should also typecheck, using the local `Sun`, and not `Day.Sun` which exists in the codebase, and the local `Day`, not the codebase `Day`. - -``` unison -structural type Zoot = Zonk | Sun - -structural type Day = Day Int - -use Zoot Zonk - -flip : Zoot -> Zoot -flip = cases - Sun -> Zonk - Zonk -> Sun - -day1 : Day -day1 = Day +1 -``` - -## Example 4: Refering to codebase definitions via a unique suffix - -Even though local definitions are preferred, you can refer to definitions in the codebase via any unique suffix that doesn't also exist in the file. - -``` unison -structural type Zoot = Zonk | Sun - -use Zoot Zonk - -blah = cases - Day.Sun -> Day.Tue - day -> day - -blah2 = - -- imports work too if you get tired of typing Day.Sun over and over - use Day Sun - cases Sun -> Wed - day -> day -``` - diff --git a/unison-src/transcripts/fix3037.output.md b/unison-src/transcripts/fix3037.output.md index aebd61c502..ea46621a2b 100644 --- a/unison-src/transcripts/fix3037.output.md +++ b/unison-src/transcripts/fix3037.output.md @@ -17,19 +17,17 @@ runner = pureRunner Loading changes detected in scratch.u. - I found an ability mismatch when checking the expression in red - - 3 | pureRunner : Runner {} - 4 | pureRunner = Runner base.force - 5 | - 6 | -- this compiles, but shouldn't the effect type parameter on Runner be invariant? - 7 | runner : Runner {IO} - 8 | runner = pureRunner - - - When trying to match Runner {} with Runner {IO} the right hand - side contained extra abilities: {IO} + ❓ + + I couldn't resolve any of these symbols: + + 4 | pureRunner = Runner base.force + + + Symbol Suggestions + + base.force No matches ``` @@ -51,14 +49,17 @@ h _ = () Loading changes detected in scratch.u. - I found an ability mismatch when checking the application - - 9 | > h anA - - - When trying to match A {} with A {IO} the right hand side - contained extra abilities: {IO} + ❓ + + I couldn't resolve any of these symbols: + + 4 | anA = A base.force + + + Symbol Suggestions + + base.force No matches ``` diff --git a/unison-src/transcripts/fix845.output.md b/unison-src/transcripts/fix845.output.md index c192583c63..9328d2f9ee 100644 --- a/unison-src/transcripts/fix845.output.md +++ b/unison-src/transcripts/fix845.output.md @@ -33,20 +33,18 @@ Now, typecheck a file with a reference to `Blah.zonk` (which doesn't exist in th Loading changes detected in scratch.u. - I couldn't figure out what Blah.zonk refers to here: - 2 | > Blah.zonk [1,2,3] - - I think its type should be: - - [Nat] -> o + ❓ + + I couldn't resolve any of these symbols: + + 2 | > Blah.zonk [1,2,3] + + + Symbol Suggestions + + Blah.zonk No matches - Some common causes of this error include: - * Your current namespace is too deep to contain the - definition in its subtree - * The definition is part of a library which hasn't been - added to this project - * You have a typo in the name ``` Here's another example, just checking that TDNR works for definitions in the same file: diff --git a/unison-src/transcripts/io.md b/unison-src/transcripts/io.md index 7db903ebb4..cc27f12ca5 100644 --- a/unison-src/transcripts/io.md +++ b/unison-src/transcripts/io.md @@ -350,24 +350,24 @@ testGetArgs.runMeWithNoArgs = 'let args = reraise !getArgs.impl match args with [] -> printLine "called with no args" - _ -> raise (fail "called with args") + _ -> raise (testGetArgs.fail "called with args") testGetArgs.runMeWithOneArg : '{io2.IO, Exception} () testGetArgs.runMeWithOneArg = 'let args = reraise !getArgs.impl match args with - [] -> raise (fail "called with no args") + [] -> raise (testGetArgs.fail "called with no args") [_] -> printLine "called with one arg" - _ -> raise (fail "called with too many args") + _ -> raise (testGetArgs.fail "called with too many args") testGetArgs.runMeWithTwoArgs : '{io2.IO, Exception} () testGetArgs.runMeWithTwoArgs = 'let args = reraise !getArgs.impl match args with - [] -> raise (fail "called with no args") - [_] -> raise (fail "called with one arg") + [] -> raise (testGetArgs.fail "called with no args") + [_] -> raise (testGetArgs.fail "called with one arg") [_, _] -> printLine "called with two args" - _ -> raise (fail "called with too many args") + _ -> raise (testGetArgs.fail "called with too many args") ``` Test that they can be run with the right number of args. diff --git a/unison-src/transcripts/io.output.md b/unison-src/transcripts/io.output.md index 4ac673c76e..77c84aea6b 100644 --- a/unison-src/transcripts/io.output.md +++ b/unison-src/transcripts/io.output.md @@ -566,24 +566,24 @@ testGetArgs.runMeWithNoArgs = 'let args = reraise !getArgs.impl match args with [] -> printLine "called with no args" - _ -> raise (fail "called with args") + _ -> raise (testGetArgs.fail "called with args") testGetArgs.runMeWithOneArg : '{io2.IO, Exception} () testGetArgs.runMeWithOneArg = 'let args = reraise !getArgs.impl match args with - [] -> raise (fail "called with no args") + [] -> raise (testGetArgs.fail "called with no args") [_] -> printLine "called with one arg" - _ -> raise (fail "called with too many args") + _ -> raise (testGetArgs.fail "called with too many args") testGetArgs.runMeWithTwoArgs : '{io2.IO, Exception} () testGetArgs.runMeWithTwoArgs = 'let args = reraise !getArgs.impl match args with - [] -> raise (fail "called with no args") - [_] -> raise (fail "called with one arg") + [] -> raise (testGetArgs.fail "called with no args") + [_] -> raise (testGetArgs.fail "called with one arg") [_, _] -> printLine "called with two args" - _ -> raise (fail "called with too many args") + _ -> raise (testGetArgs.fail "called with too many args") ``` Test that they can be run with the right number of args. diff --git a/unison-src/transcripts/namespace-directive.md b/unison-src/transcripts/namespace-directive.md index 1d0ffddb25..6891461501 100644 --- a/unison-src/transcripts/namespace-directive.md +++ b/unison-src/transcripts/namespace-directive.md @@ -62,7 +62,7 @@ type Baz = { qux : Nat } type RefersToFoo = RefersToFoo Foo refersToBar = cases - Bar -> 17 + Foo.Bar -> 17 refersToQux baz = Baz.qux baz + Baz.qux baz diff --git a/unison-src/transcripts/namespace-directive.output.md b/unison-src/transcripts/namespace-directive.output.md index 90e568248a..63f7a5c2cb 100644 --- a/unison-src/transcripts/namespace-directive.output.md +++ b/unison-src/transcripts/namespace-directive.output.md @@ -132,7 +132,7 @@ type Baz = { qux : Nat } type RefersToFoo = RefersToFoo Foo refersToBar = cases - Bar -> 17 + Foo.Bar -> 17 refersToQux baz = Baz.qux baz + Baz.qux baz diff --git a/unison-src/transcripts/pattern-match-coverage.md b/unison-src/transcripts/pattern-match-coverage.md index e08ea269ab..5868bd7981 100644 --- a/unison-src/transcripts/pattern-match-coverage.md +++ b/unison-src/transcripts/pattern-match-coverage.md @@ -367,7 +367,7 @@ unique type T = A | B result : '{e, Abort} T -> {e} () result f = handle !f with cases - { A } -> () + { T.A } -> () { B } -> () { abort -> _ } -> bug "aborted" ``` @@ -421,7 +421,7 @@ unique type T = A | B result : '{e, Abort} T -> {e} () result f = handle !f with cases - { A } -> () + { T.A } -> () { abort -> _ } -> bug "aborted" ``` diff --git a/unison-src/transcripts/pattern-match-coverage.output.md b/unison-src/transcripts/pattern-match-coverage.output.md index 575c35cab0..2e761bf1ad 100644 --- a/unison-src/transcripts/pattern-match-coverage.output.md +++ b/unison-src/transcripts/pattern-match-coverage.output.md @@ -853,7 +853,7 @@ unique type T = A | B result : '{e, Abort} T -> {e} () result f = handle !f with cases - { A } -> () + { T.A } -> () { B } -> () { abort -> _ } -> bug "aborted" ``` @@ -970,7 +970,7 @@ unique type T = A | B result : '{e, Abort} T -> {e} () result f = handle !f with cases - { A } -> () + { T.A } -> () { abort -> _ } -> bug "aborted" ``` @@ -980,7 +980,7 @@ result f = handle !f with cases Pattern match doesn't cover all possible cases: 7 | result f = handle !f with cases - 8 | { A } -> () + 8 | { T.A } -> () 9 | { abort -> _ } -> bug "aborted" @@ -1004,14 +1004,19 @@ result f = handle !f with cases Loading changes detected in scratch.u. - Pattern match doesn't cover all possible cases: - 7 | result f = handle !f with cases - 8 | { x } -> x - 9 | { give A -> resume } -> result resume - + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: - Patterns not matched: - * { give B -> _ } + ⍟ These new definitions are ok to `add`: + + ability Give a + result : '{e, Give T} r ->{e} r + + ⍟ These names already exist. You can `update` them to your + new definition: + + type T ``` ``` unison diff --git a/unison-src/transcripts/suffixes.md b/unison-src/transcripts/suffixes.md index 7245b4cb31..24eeef17b9 100644 --- a/unison-src/transcripts/suffixes.md +++ b/unison-src/transcripts/suffixes.md @@ -73,35 +73,3 @@ Note that we can always still view indirect dependencies by using more name segm scratch/main> view distributed.abra.cadabra scratch/main> names distributed.lib.baz.qux ``` - -## Corner cases - -If a definition is given in a scratch file, its suffixes shadow existing definitions that exist in the codebase with the same suffixes. For example: - -```unison:hide -unique type A = Thing1 Nat | thing2 Nat - -foo.a = 23 -bar = 100 -``` - -```ucm -scratch/main> add -``` - -```unison -unique type B = Thing1 Text | thing2 Text | Thing3 Text - -zoink.a = "hi" - --- verifying that the `a` here references `zoink.a` -foo.baz.qux.bar : Text -foo.baz.qux.bar = a - --- verifying that the `bar` is resolving to `foo.baz.qux.bar` --- and that `Thing1` references `B.Thing1` from the current file -fn = cases - Thing1 msg -> msg Text.++ bar - thing2 msg -> msg Text.++ bar - _ -> todo "hmm" -``` diff --git a/unison-src/transcripts/suffixes.output.md b/unison-src/transcripts/suffixes.output.md index a4cd5e3b02..d8167704e4 100644 --- a/unison-src/transcripts/suffixes.output.md +++ b/unison-src/transcripts/suffixes.output.md @@ -167,57 +167,3 @@ scratch/main> names distributed.lib.baz.qux Names: lib.distributed.lib.baz.qux ``` -## Corner cases - -If a definition is given in a scratch file, its suffixes shadow existing definitions that exist in the codebase with the same suffixes. For example: - -``` unison -unique type A = Thing1 Nat | thing2 Nat - -foo.a = 23 -bar = 100 -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type A - bar : Nat - foo.a : Nat - -``` -``` unison -unique type B = Thing1 Text | thing2 Text | Thing3 Text - -zoink.a = "hi" - --- verifying that the `a` here references `zoink.a` -foo.baz.qux.bar : Text -foo.baz.qux.bar = a - --- verifying that the `bar` is resolving to `foo.baz.qux.bar` --- and that `Thing1` references `B.Thing1` from the current file -fn = cases - Thing1 msg -> msg Text.++ bar - thing2 msg -> msg Text.++ bar - _ -> todo "hmm" -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - type B - fn : B -> Text - foo.baz.qux.bar : Text - zoink.a : Text - -``` diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 21513cd19b..ce913ee8ca 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -115,7 +115,37 @@ data ParsingEnv (m :: Type -> Type) = ParsingEnv -- The name (e.g. `Foo` in `unique type Foo`) is passed in, and if the function returns a Just, that GUID is used; -- otherwise, a random one is generated from `uniqueNames`. uniqueTypeGuid :: Name -> m (Maybe Text), - names :: Names + names :: Names, + -- The namespace block we are currently parsing under. + -- + -- Mostly, this ought to have no affect on parsing: "applying" a namespace should be a pre-processing pass. All + -- bindings are prefixed with the namespace (easy), and all free variables that match a binding are prefixed (also easy). + -- + -- ... but our "parser" is also doing parse-time name resolution for hash-qualified names, type references, + -- constructors in patterns, and term/type links. + -- + -- So, when parsing a pattern `Bar` like + -- + -- (in `namespace foo`) + -- match whatever with + -- Bar -> ... + -- + -- we need to first prefix `Bar`, giving `foo.Bar`, before looking up in the name in the environment. + -- + -- You might think we could simply parse a term under a pre-namespaced environment, avoiding the need to plumb the + -- namespace through via the parsing environment. That too could work in theory, but would be rather difficult to + -- implement with the current file parsing mechanism that fully parses and resolves all types in the file before + -- moving on to terms. + -- + -- As an example, we don't want this to fail with a `foo.Bar not in scope` error: + -- + -- namespace foo + -- type Bar = ... + -- type Foo = ... foo.Bar ... + -- + -- That is easiest to implement with the current solution – first pre-process the types as above, then run them + -- through the "make type environment" logic (which is fed into the term parser). + maybeNamespace :: Maybe Name } newtype UniqueName = UniqueName (L.Pos -> Int -> Maybe Text) From af8315e789570fefcb3d80e4f996bdf231cb73ec Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 26 Aug 2024 13:45:46 -0400 Subject: [PATCH 619/631] restore better error messages from type checker, not parser, on term out-of-scope --- unison-core/src/Unison/Term.hs | 9 +++-- .../transcripts/destructuring-binds.output.md | 24 ++++++------ unison-src/transcripts/fix3037.output.md | 39 +++++++++---------- unison-src/transcripts/fix845.output.md | 22 ++++++----- 4 files changed, 49 insertions(+), 45 deletions(-) diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index 65202114e6..1455d26d95 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -165,7 +165,7 @@ bindNames unsafeVarToName nameToVar localVars ns term = do localNames = map unsafeVarToName (Set.toList localVars) okTm :: (v, a) -> Names.ResolutionResult a (Maybe (v, ResolvesTo Referent)) - okTm (v, a) = + okTm (v, _) = let exactNamespaceMatches = Names.lookupHQTerm Names.ExactName (HQ.NameOnly name) ns suffixNamespaceMatches = Name.searchByRankedSuffix name (Names.terms ns) localMatches = @@ -173,16 +173,19 @@ bindNames unsafeVarToName nameToVar localVars ns term = do in case (Set.size exactNamespaceMatches, Set.size suffixNamespaceMatches, Set.size localMatches) of (1, _, _) -> good (ResolvesToNamespace (Set.findMin exactNamespaceMatches)) (n, _, _) | n > 1 -> leaveFreeForTdnr - (_, 0, 0) -> if Name.isBlank name then leaveFreeForHoleSuggestions else bad Names.NotFound + (_, 0, 0) -> + if Name.isBlank name + then leaveFreeForHoleSuggestions + else leaveFreeForTellingUserAboutExpectedType (_, 1, 0) -> good (ResolvesToNamespace (Set.findMin suffixNamespaceMatches)) (_, 0, 1) -> good (ResolvesToLocal (Set.findMin localMatches)) _ -> leaveFreeForTdnr where name = unsafeVarToName v good = Right . Just . (v,) - bad = Left . Seq.singleton . Names.TermResolutionFailure (HQ.NameOnly name) a leaveFreeForHoleSuggestions = Right Nothing leaveFreeForTdnr = Right Nothing + leaveFreeForTellingUserAboutExpectedType = Right Nothing okTy :: (v, a) -> Names.ResolutionResult a (v, Type v a) okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes hqName ns of diff --git a/unison-src/transcripts/destructuring-binds.output.md b/unison-src/transcripts/destructuring-binds.output.md index 8dae5b1603..371864ee95 100644 --- a/unison-src/transcripts/destructuring-binds.output.md +++ b/unison-src/transcripts/destructuring-binds.output.md @@ -86,20 +86,20 @@ ex4 = Loading changes detected in scratch.u. + I couldn't figure out what a refers to here: - ❓ - - I couldn't resolve any of these symbols: - - 2 | (a,b) = (a Nat.+ b, 19) - - - Symbol Suggestions - - a No matches - - b No matches + 2 | (a,b) = (a Nat.+ b, 19) + + I think its type should be: + + Nat + Some common causes of this error include: + * Your current namespace is too deep to contain the + definition in its subtree + * The definition is part of a library which hasn't been + added to this project + * You have a typo in the name ``` Even though the parser accepts any pattern on the LHS of a bind, it looks pretty weird to see things like `12 = x`, so we avoid showing a destructuring bind when the LHS is a "literal" pattern (like `42` or "hi"). Again these examples wouldn't compile with coverage checking. diff --git a/unison-src/transcripts/fix3037.output.md b/unison-src/transcripts/fix3037.output.md index ea46621a2b..aebd61c502 100644 --- a/unison-src/transcripts/fix3037.output.md +++ b/unison-src/transcripts/fix3037.output.md @@ -17,17 +17,19 @@ runner = pureRunner Loading changes detected in scratch.u. + I found an ability mismatch when checking the expression in red + + 3 | pureRunner : Runner {} + 4 | pureRunner = Runner base.force + 5 | + 6 | -- this compiles, but shouldn't the effect type parameter on Runner be invariant? + 7 | runner : Runner {IO} + 8 | runner = pureRunner + + + When trying to match Runner {} with Runner {IO} the right hand + side contained extra abilities: {IO} - ❓ - - I couldn't resolve any of these symbols: - - 4 | pureRunner = Runner base.force - - - Symbol Suggestions - - base.force No matches ``` @@ -49,17 +51,14 @@ h _ = () Loading changes detected in scratch.u. + I found an ability mismatch when checking the application + + 9 | > h anA + + + When trying to match A {} with A {IO} the right hand side + contained extra abilities: {IO} - ❓ - - I couldn't resolve any of these symbols: - - 4 | anA = A base.force - - - Symbol Suggestions - - base.force No matches ``` diff --git a/unison-src/transcripts/fix845.output.md b/unison-src/transcripts/fix845.output.md index 9328d2f9ee..c192583c63 100644 --- a/unison-src/transcripts/fix845.output.md +++ b/unison-src/transcripts/fix845.output.md @@ -33,18 +33,20 @@ Now, typecheck a file with a reference to `Blah.zonk` (which doesn't exist in th Loading changes detected in scratch.u. + I couldn't figure out what Blah.zonk refers to here: - ❓ - - I couldn't resolve any of these symbols: - - 2 | > Blah.zonk [1,2,3] - - - Symbol Suggestions - - Blah.zonk No matches + 2 | > Blah.zonk [1,2,3] + + I think its type should be: + + [Nat] -> o + Some common causes of this error include: + * Your current namespace is too deep to contain the + definition in its subtree + * The definition is part of a library which hasn't been + added to this project + * You have a typo in the name ``` Here's another example, just checking that TDNR works for definitions in the same file: From 38c148272f2a2d0128c16a13dde2777be26ee5e2 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 26 Aug 2024 13:49:43 -0400 Subject: [PATCH 620/631] fix missing record field --- parser-typechecker/src/Unison/Parsers.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Parsers.hs b/parser-typechecker/src/Unison/Parsers.hs index fc1500a12f..9b9024f970 100644 --- a/parser-typechecker/src/Unison/Parsers.hs +++ b/parser-typechecker/src/Unison/Parsers.hs @@ -78,7 +78,8 @@ unsafeParseFileBuiltinsOnly = Parser.ParsingEnv { uniqueNames = mempty, uniqueTypeGuid = \_ -> pure Nothing, - names = Builtin.names + names = Builtin.names, + maybeNamespace = Nothing } unsafeParseFile :: (Monad m) => String -> Parser.ParsingEnv m -> m (UnisonFile Symbol Ann) From 0bed3fcc7fb54f2dbe7fa0ae01bb08817304a1ee Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 26 Aug 2024 13:54:10 -0400 Subject: [PATCH 621/631] delete commented-out code --- parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs index 46d3fb220c..e9f165150f 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs @@ -91,10 +91,7 @@ suffixifyByHash names = suffixifyByHashWithUnhashedTermsInScope :: Set Name -> Names -> Suffixifier suffixifyByHashWithUnhashedTermsInScope localTermNames namespaceNames = Suffixifier - { suffixifyTerm = \name -> - Name.suffixifyByHash - name - terms, -- (Relation.mapRanMonotonic ResolvesToNamespace (Names.terms names)), + { suffixifyTerm = \name -> Name.suffixifyByHash name terms, suffixifyType = \name -> Name.suffixifyByHash name (Names.types namespaceNames) } where From 79c877b341d05c37371ec9f1a54d60c567cf70aa Mon Sep 17 00:00:00 2001 From: SimaDovakin Date: Tue, 27 Aug 2024 10:50:24 +0300 Subject: [PATCH 622/631] Added new contributor. --- CONTRIBUTORS.markdown | 1 + 1 file changed, 1 insertion(+) diff --git a/CONTRIBUTORS.markdown b/CONTRIBUTORS.markdown index 5649b15dd0..6ed2e9ca35 100644 --- a/CONTRIBUTORS.markdown +++ b/CONTRIBUTORS.markdown @@ -87,3 +87,4 @@ The format for this list: name, GitHub handle * Dan Doel (@dolio) * Eric Torreborre (@etorreborre) * Eduard Nicodei (@neduard) +* Ruslan Simchuk (@SimaDovakin) From 2942ed62fe041ac72687f59787c931a34f5d5b02 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 27 Aug 2024 15:09:18 -0400 Subject: [PATCH 623/631] fix handling of namespace blocks in term parser --- parser-typechecker/src/Unison/Parsers.hs | 3 +- .../src/Unison/Runtime/IOSource.hs | 3 +- .../src/Unison/Syntax/FileParser.hs | 8 +- .../src/Unison/Syntax/TermParser.hs | 100 ++++++++++++------ .../unison-parser-typechecker.cabal | 1 + .../src/Unison/Codebase/Editor/HandleInput.hs | 3 +- .../Codebase/Editor/HandleInput/Load.hs | 3 +- unison-cli/src/Unison/LSP/FileAnalysis.hs | 3 +- unison-core/src/Unison/NamesWithHistory.hs | 8 +- unison-syntax/src/Unison/Syntax/Parser.hs | 36 +++---- 10 files changed, 106 insertions(+), 62 deletions(-) diff --git a/parser-typechecker/src/Unison/Parsers.hs b/parser-typechecker/src/Unison/Parsers.hs index 9b9024f970..13ce658a8a 100644 --- a/parser-typechecker/src/Unison/Parsers.hs +++ b/parser-typechecker/src/Unison/Parsers.hs @@ -79,7 +79,8 @@ unsafeParseFileBuiltinsOnly = { uniqueNames = mempty, uniqueTypeGuid = \_ -> pure Nothing, names = Builtin.names, - maybeNamespace = Nothing + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } unsafeParseFile :: (Monad m) => String -> Parser.ParsingEnv m -> m (UnisonFile Symbol Ann) diff --git a/parser-typechecker/src/Unison/Runtime/IOSource.hs b/parser-typechecker/src/Unison/Runtime/IOSource.hs index a589c9ae06..f344bb0a06 100644 --- a/parser-typechecker/src/Unison/Runtime/IOSource.hs +++ b/parser-typechecker/src/Unison/Runtime/IOSource.hs @@ -42,7 +42,8 @@ parsingEnv = { uniqueNames = mempty, uniqueTypeGuid = \_ -> pure Nothing, names = Builtin.names, - maybeNamespace = Nothing + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } typecheckingEnv :: Typechecker.Env Symbol Ann diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index ce3d01382c..6ef53527df 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -113,7 +113,13 @@ file = do Just namespace -> over (mapped . _1) (Var.namespaced2 namespace) -- At this stage of the file parser, we've parsed all the type and ability -- declarations. - local (\e -> e {names = Names.shadowing (UF.names env) namesStart, maybeNamespace}) do + let updateEnvForTermParsing e = + e + { names = Names.shadowing (UF.names env) namesStart, + maybeNamespace, + localNamespacePrefixedTypesAndConstructors = UF.names env + } + local updateEnvForTermParsing do names <- asks names stanzas <- do unNamespacedStanzas0 <- sepBy semi stanza diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 9141a723e5..3d46d0ae37 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -47,7 +47,7 @@ import Unison.Parser.Ann qualified as Ann import Unison.Pattern (Pattern) import Unison.Pattern qualified as Pattern import Unison.Prelude -import Unison.Reference (Reference) +import Unison.Reference (TypeReference) import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Syntax.Lexer.Unison qualified as L @@ -119,12 +119,11 @@ rewriteBlock = do rhs <- openBlockWith "==>" *> TypeParser.computationType <* closeBlock pure (DD.rewriteType (ann kw <> ann rhs) (L.payload <$> vs) lhs rhs) -typeLink' :: (Monad m, Var v) => P v m (L.Token Reference) +typeLink' :: (Monad m, Var v) => P v m (L.Token TypeReference) typeLink' = findUniqueType =<< hqPrefixId -findUniqueType :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> P v m (L.Token Reference) -findUniqueType id0 = do - id <- applyNamespaceToToken id0 +findUniqueType :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> P v m (L.Token TypeReference) +findUniqueType id = do ns <- asks names case Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns of s @@ -133,16 +132,16 @@ findUniqueType id0 = do termLink' :: (Monad m, Var v) => P v m (L.Token Referent) termLink' = do - id <- applyNamespaceToToken =<< hqPrefixId + id <- hqPrefixId ns <- asks names case Names.lookupHQTerm Names.IncludeSuffixes (L.payload id) ns of s | Set.size s == 1 -> pure $ const (Set.findMin s) <$> id | otherwise -> customFailure $ UnknownTerm id s -link' :: (Monad m, Var v) => P v m (Either (L.Token Reference) (L.Token Referent)) +link' :: (Monad m, Var v) => P v m (Either (L.Token TypeReference) (L.Token Referent)) link' = do - id <- applyNamespaceToToken =<< hqPrefixId + id <- hqPrefixId ns <- asks names case (Names.lookupHQTerm Names.IncludeSuffixes (L.payload id) ns, Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns) of (s, s2) | Set.size s == 1 && Set.null s2 -> pure . Right $ const (Set.findMin s) <$> id @@ -283,18 +282,54 @@ parsePattern = label "pattern" root ctor :: CT.ConstructorType -> P v m (L.Token ConstructorReference) ctor ct = do -- this might be a var, so we avoid consuming it at first - tok <- applyNamespaceToToken =<< P.try (P.lookAhead hqPrefixId) - names <- asks names - -- probably should avoid looking up in `names` if `L.payload tok` - -- starts with a lowercase - case Names.lookupHQPattern Names.IncludeSuffixes (L.payload tok) ct names of - s - | Set.null s -> die names tok s - | Set.size s > 1 -> die names tok s - | otherwise -> do - -- matched ctor name, consume the token - _ <- anyToken - pure (Set.findMin s <$ tok) + tok <- P.try (P.lookAhead hqPrefixId) + + -- First, if: + -- + -- * The token isn't hash-qualified (e.g. "Foo.Bar") + -- * We're under a namespace directive (e.g. "baz") + -- * There's an exact match for a locally-bound constructor (e.g. "baz.Foo.Bar") + -- + -- Then: + -- + -- * Use that constructor reference (duh) + -- + -- Else: + -- + -- * Fall through to the normal logic of looking the constructor name up in all of the names (which includes + -- the locally-bound constructors). + + maybeLocalCtor <- + case L.payload tok of + HQ.NameOnly name -> + asks maybeNamespace >>= \case + Nothing -> pure Nothing + Just namespace -> do + localNames <- asks localNamespacePrefixedTypesAndConstructors + case Names.lookupHQPattern Names.ExactName (HQ.NameOnly (Name.joinDot namespace name)) ct localNames of + refs + | Set.null refs -> pure Nothing + -- 2+ name case is impossible: we looked up exact names in the locally-bound names. Two bindings + -- with the same name would have been a parse error. So, just take the minimum element from the set, + -- which we know is a singleton. + | otherwise -> do + -- matched ctor name, consume the token + _ <- anyToken + pure (Just (Set.findMin refs)) + _ -> pure Nothing + + case maybeLocalCtor of + Just localCtor -> pure (localCtor <$ tok) + Nothing -> do + names <- asks names + case Names.lookupHQPattern Names.IncludeSuffixes (L.payload tok) ct names of + s + | Set.null s -> die names tok s + | Set.size s > 1 -> die names tok s + | otherwise -> do + -- matched ctor name, consume the token + _ <- anyToken + pure (Set.findMin s <$ tok) where isLower = Text.all Char.isLower . Text.take 1 . Name.toText isIgnored n = Text.take 1 (Name.toText n) == "_" @@ -315,7 +350,15 @@ parsePattern = label "pattern" root (ann hq) if Set.null s then NotFound - else Ambiguous names (Set.map (\ref -> Referent.Con ref ct) s) Set.empty + else + Ambiguous + names + (Set.map (\ref -> Referent.Con ref ct) s) + -- Eh, here we're saying there are no "local" constructors – they're all from "the namespace". + -- That's not necessarily true, but it doesn't (currently) affect the error message any, and + -- we have already parsed and hashed local constructors (so they aren't really different from + -- namespace constructors). + Set.empty ] unzipPatterns f elems = case unzip elems of (patterns, vs) -> f patterns (join vs) @@ -441,24 +484,17 @@ nameIsKeyword name keyword = -- has a short hash, we resolve that short hash immediately and fail -- committed if that short hash can't be found in the current environment resolveHashQualified :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> TermP v m -resolveHashQualified tok0 = do - names <- asks names - case L.payload tok0 of - HQ.NameOnly n -> pure $ Term.var (ann tok0) (Name.toVar n) +resolveHashQualified tok = do + case L.payload tok of + HQ.NameOnly n -> pure $ Term.var (ann tok) (Name.toVar n) _ -> do - tok <- applyNamespaceToToken tok0 + names <- asks names case Names.lookupHQTerm Names.IncludeSuffixes (L.payload tok) names of s | Set.null s -> failCommitted $ UnknownTerm tok s | Set.size s > 1 -> failCommitted $ UnknownTerm tok s | otherwise -> pure $ Term.fromReferent (ann tok) (Set.findMin s) -applyNamespaceToToken :: (Monad m) => L.Token (HQ.HashQualified Name) -> P v m (L.Token (HQ.HashQualified Name)) -applyNamespaceToToken tok = - asks maybeNamespace <&> \case - Nothing -> tok - Just namespace -> fmap (fmap (Name.joinDot namespace)) tok - termLeaf :: forall m v. (Monad m, Var v) => TermP v m termLeaf = asum diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index edc3182a5e..e34a1a652f 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -160,6 +160,7 @@ library Unison.Syntax.FileParser Unison.Syntax.FilePrinter Unison.Syntax.NamePrinter + Unison.Syntax.Precedence Unison.Syntax.TermParser Unison.Syntax.TermPrinter Unison.Syntax.TypeParser diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 068231d077..0f13816ce3 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -1673,7 +1673,8 @@ parseType input src = do { uniqueNames = mempty, uniqueTypeGuid = \_ -> pure Nothing, names, - maybeNamespace = Nothing + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } typ <- Parsers.parseType (Text.unpack (fst lexed)) parsingEnv & onLeftM \err -> diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs index 3694354d76..5a387deb64 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs @@ -101,7 +101,8 @@ loadUnisonFile sourceName text = do { uniqueNames = uniqueName, uniqueTypeGuid = Cli.loadUniqueTypeGuid pp, names, - maybeNamespace = Nothing + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } unisonFile <- Cli.runTransaction (Parsers.parseFile (Text.unpack sourceName) (Text.unpack text) parsingEnv) diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index 5f647be8d4..2b5363c7ff 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -93,7 +93,8 @@ checkFile doc = runMaybeT do { uniqueNames = uniqueName, uniqueTypeGuid = Cli.loadUniqueTypeGuid pp, names = parseNames, - maybeNamespace = Nothing + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } (notes, parsedFile, typecheckedFile) <- do liftIO do diff --git a/unison-core/src/Unison/NamesWithHistory.hs b/unison-core/src/Unison/NamesWithHistory.hs index d578eddad2..233bede3ef 100644 --- a/unison-core/src/Unison/NamesWithHistory.hs +++ b/unison-core/src/Unison/NamesWithHistory.hs @@ -113,7 +113,7 @@ shadowing = Names.unionLeftName -- Find all types whose name has a suffix matching the provided `HashQualified`, -- returning types with relative names if they exist, and otherwise -- returning types with absolute names. -lookupRelativeHQType :: SearchType -> HashQualified Name -> Names -> Set Reference +lookupRelativeHQType :: SearchType -> HashQualified Name -> Names -> Set TypeReference lookupRelativeHQType searchType hq ns = let rs = lookupHQType searchType hq ns keep r = any (not . Name.isAbsolute) (R.lookupRan r (Names.types ns)) @@ -122,17 +122,17 @@ lookupRelativeHQType searchType hq ns = | Set.null rs' -> rs | otherwise -> rs' -lookupRelativeHQType' :: SearchType -> HQ'.HashQualified Name -> Names -> Set Reference +lookupRelativeHQType' :: SearchType -> HQ'.HashQualified Name -> Names -> Set TypeReference lookupRelativeHQType' searchType = lookupRelativeHQType searchType . HQ'.toHQ -- | Find all types whose name has a suffix matching the provided 'HashQualified'. -lookupHQType :: SearchType -> HashQualified Name -> Names -> Set Reference +lookupHQType :: SearchType -> HashQualified Name -> Names -> Set TypeReference lookupHQType searchType = lookupHQRef searchType Names.types Reference.isPrefixOf -- | Find all types whose name has a suffix matching the provided 'HashQualified''. See 'lookupHQType'. -lookupHQType' :: SearchType -> HQ'.HashQualified Name -> Names -> Set Reference +lookupHQType' :: SearchType -> HQ'.HashQualified Name -> Names -> Set TypeReference lookupHQType' searchType = lookupHQType searchType . HQ'.toHQ diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 74d8d03537..f3f944091e 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -117,36 +117,32 @@ data ParsingEnv (m :: Type -> Type) = ParsingEnv -- otherwise, a random one is generated from `uniqueNames`. uniqueTypeGuid :: Name -> m (Maybe Text), names :: Names, - -- The namespace block we are currently parsing under. + -- The namespace block we are currently parsing under, and the file-bound namespace-prefixed type and constructor + -- names in scope (we've already parsed all type declarations by the time we need this, in the term parser). -- - -- Mostly, this ought to have no affect on parsing: "applying" a namespace should be a pre-processing pass. All - -- bindings are prefixed with the namespace (easy), and all free variables that match a binding are prefixed (also easy). + -- Ideally these ought to have no affect on parsing: "applying" a namespace should be a pre-processing pass. All + -- bindings are prefixed with the namespace (easy), and all free variables that match a binding are prefixed (also + -- easy). -- -- ... but our "parser" is also doing parse-time name resolution for hash-qualified names, type references, -- constructors in patterns, and term/type links. -- - -- So, when parsing a pattern `Bar` like + -- For constructors in patterns, when parsing a pattern `Foo.Bar` in a namespace `baz`, if `baz.Foo.Bar` is among + -- the file-bound namespace-prefixed constructor names in scope, then resolve to that constructor. Otherwise, + -- proceed as normal to look for `Foo.Bar` in the names environment. -- - -- (in `namespace foo`) - -- match whatever with - -- Bar -> ... - -- - -- we need to first prefix `Bar`, giving `foo.Bar`, before looking up in the name in the environment. - -- - -- You might think we could simply parse a term under a pre-namespaced environment, avoiding the need to plumb the - -- namespace through via the parsing environment. That too could work in theory, but would be rather difficult to - -- implement with the current file parsing mechanism that fully parses and resolves all types in the file before - -- moving on to terms. - -- - -- As an example, we don't want this to fail with a `foo.Bar not in scope` error: + -- For type links, similar deal: we (only because we parse and hash all types before terms) could conceivably + -- properly handle code like -- -- namespace foo -- type Bar = ... - -- type Foo = ... foo.Bar ... + -- baz = ... typeLink Bar ... -- - -- That is easiest to implement with the current solution – first pre-process the types as above, then run them - -- through the "make type environment" logic (which is fed into the term parser). - maybeNamespace :: Maybe Name + -- And for term links we are certainly out of luck: we can't look up a resolved file-bound term by hash *during + -- parsing*. That's an issue with term links in general, unrelated to namespaces, but perhaps complicated by + -- namespaces nonetheless. + maybeNamespace :: Maybe Name, + localNamespacePrefixedTypesAndConstructors :: Names } newtype UniqueName = UniqueName (L.Pos -> Int -> Maybe Text) From 9346865a30af869aa803865da62820f66781f43e Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 27 Aug 2024 16:54:11 -0400 Subject: [PATCH 624/631] fix warning in test file --- parser-typechecker/tests/Unison/Test/Common.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/parser-typechecker/tests/Unison/Test/Common.hs b/parser-typechecker/tests/Unison/Test/Common.hs index ba1e5916c0..e1d880002c 100644 --- a/parser-typechecker/tests/Unison/Test/Common.hs +++ b/parser-typechecker/tests/Unison/Test/Common.hs @@ -87,5 +87,7 @@ parsingEnv = Parser.ParsingEnv { uniqueNames = mempty, uniqueTypeGuid = \_ -> pure Nothing, - names = B.names + names = B.names, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } From 267262311cada5c9ba26cd6602d6e83f94b01dc0 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 27 Aug 2024 17:10:14 -0400 Subject: [PATCH 625/631] fix a couple more warnings --- unison-cli/src/Unison/Cli/MonadUtils.hs | 4 +++- unison-merge/src/Unison/Merge/Mergeblob4.hs | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 4546be1e84..242ee77635 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -556,5 +556,7 @@ makeParsingEnv path names = do ParsingEnv { uniqueNames = uniqueName, uniqueTypeGuid = loadUniqueTypeGuid path, - names + names, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } diff --git a/unison-merge/src/Unison/Merge/Mergeblob4.hs b/unison-merge/src/Unison/Merge/Mergeblob4.hs index 3a72e4c854..fa8f8f0e61 100644 --- a/unison-merge/src/Unison/Merge/Mergeblob4.hs +++ b/unison-merge/src/Unison/Merge/Mergeblob4.hs @@ -37,7 +37,9 @@ makeMergeblob4 blob = do -- call to `error`. uniqueNames = Parser.UniqueName \_ _ -> Nothing, uniqueTypeGuid = \name -> Identity (Map.lookup name blob.uniqueTypeGuids), - names = stageOneNames + names = stageOneNames, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } file <- runIdentity (Parsers.parseFile "" (Pretty.toPlain 80 blob.unparsedFile) parsingEnv) Right From 6dd0fead5af82b6153eb5483a88be54d421e4379 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 27 Aug 2024 17:26:40 -0400 Subject: [PATCH 626/631] fix namespace directive + type link case --- .../src/Unison/Syntax/TermParser.hs | 32 +++++++++++++++---- unison-src/transcripts/namespace-directive.md | 9 ++++-- .../transcripts/namespace-directive.output.md | 14 ++++++-- 3 files changed, 43 insertions(+), 12 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 3d46d0ae37..a6e4b80773 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -123,12 +123,15 @@ typeLink' :: (Monad m, Var v) => P v m (L.Token TypeReference) typeLink' = findUniqueType =<< hqPrefixId findUniqueType :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> P v m (L.Token TypeReference) -findUniqueType id = do - ns <- asks names - case Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns of - s - | Set.size s == 1 -> pure $ const (Set.findMin s) <$> id - | otherwise -> customFailure $ UnknownType id s +findUniqueType id = + resolveToLocalNamespacedType id >>= \case + Nothing -> do + ns <- asks names + case Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns of + s + | Set.size s == 1 -> pure (Set.findMin s <$ id) + | otherwise -> customFailure $ UnknownType id s + Just ref -> pure (ref <$ id) termLink' :: (Monad m, Var v) => P v m (L.Token Referent) termLink' = do @@ -160,6 +163,23 @@ link = termLink <|> typeLink tok <- termLink' pure $ Term.termLink (ann tok) (L.payload tok) +resolveToLocalNamespacedType :: (Monad m, Ord v) => L.Token (HQ.HashQualified Name) -> P v m (Maybe TypeReference) +resolveToLocalNamespacedType tok = + case L.payload tok of + HQ.NameOnly name -> + asks maybeNamespace >>= \case + Nothing -> pure Nothing + Just namespace -> do + localNames <- asks localNamespacePrefixedTypesAndConstructors + pure case Names.lookupHQType Names.ExactName (HQ.NameOnly (Name.joinDot namespace name)) localNames of + refs + | Set.null refs -> Nothing + -- 2+ name case is impossible: we looked up exact names in the locally-bound names. Two bindings + -- with the same name would have been a parse error. So, just take the minimum element from the set, + -- which we know is a singleton. + | otherwise -> Just (Set.findMin refs) + _ -> pure Nothing + -- We disallow type annotations and lambdas, -- just function application and operators blockTerm :: (Monad m, Var v) => TermP v m diff --git a/unison-src/transcripts/namespace-directive.md b/unison-src/transcripts/namespace-directive.md index 6891461501..8d3443df44 100644 --- a/unison-src/transcripts/namespace-directive.md +++ b/unison-src/transcripts/namespace-directive.md @@ -41,8 +41,8 @@ reference to the name `factorial` within the body of `factorial` is a recursive namespace directive, exact-name-match-wins semantics) or an ambiguous reference (bad, as would be the case if the bindings were expanded to `foo.factorial` and `foo.longer.evil.factorial`, but the variables left alone). -Here are a few more examples demonstrating that type names, constructor names, and generated record accessor names are -all properly handled. +Here are a few more examples demonstrating that type names, constructor names, generated record accessor names, and +type links are all properly handled. ```unison type longer.foo.Foo = Bar @@ -66,10 +66,13 @@ refersToBar = cases refersToQux baz = Baz.qux baz + Baz.qux baz + +hasTypeLink = + {{ {type Foo} }} ``` ```ucm scratch/main> add -scratch/main> view RefersToFoo refersToBar refersToQux +scratch/main> view RefersToFoo refersToBar refersToQux hasTypeLink scratch/main> todo ``` diff --git a/unison-src/transcripts/namespace-directive.output.md b/unison-src/transcripts/namespace-directive.output.md index 63f7a5c2cb..92ecb360cf 100644 --- a/unison-src/transcripts/namespace-directive.output.md +++ b/unison-src/transcripts/namespace-directive.output.md @@ -84,8 +84,8 @@ reference to the name `factorial` within the body of `factorial` is a recursive namespace directive, exact-name-match-wins semantics) or an ambiguous reference (bad, as would be the case if the bindings were expanded to `foo.factorial` and `foo.longer.evil.factorial`, but the variables left alone). -Here are a few more examples demonstrating that type names, constructor names, and generated record accessor names are -all properly handled. +Here are a few more examples demonstrating that type names, constructor names, generated record accessor names, and +type links are all properly handled. ``` unison type longer.foo.Foo = Bar @@ -136,6 +136,9 @@ refersToBar = cases refersToQux baz = Baz.qux baz + Baz.qux baz + +hasTypeLink = + {{ {type Foo} }} ``` ``` ucm @@ -156,6 +159,7 @@ refersToQux baz = -> foo.Baz ->{g} foo.Baz foo.Baz.qux.set : Nat -> foo.Baz -> foo.Baz + foo.hasTypeLink : Doc2 foo.refersToBar : foo.Foo -> Nat foo.refersToQux : foo.Baz -> Nat @@ -173,13 +177,17 @@ scratch/main> add -> foo.Baz ->{g} foo.Baz foo.Baz.qux.set : Nat -> foo.Baz -> foo.Baz + foo.hasTypeLink : Doc2 foo.refersToBar : foo.Foo -> Nat foo.refersToQux : foo.Baz -> Nat -scratch/main> view RefersToFoo refersToBar refersToQux +scratch/main> view RefersToFoo refersToBar refersToQux hasTypeLink type foo.RefersToFoo = RefersToFoo foo.Foo + foo.hasTypeLink : Doc2 + foo.hasTypeLink = {{ {type foo.Foo} }} + foo.refersToBar : foo.Foo -> Nat foo.refersToBar = cases foo.Foo.Bar -> 17 From 01d345450890c2cacaedc7a56ed27b92d003ee93 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 27 Aug 2024 18:03:14 -0400 Subject: [PATCH 627/631] revert a couple now-unnecessary changes --- parser-typechecker/src/Unison/Runtime/IOSource.hs | 4 ++-- unison-core/src/Unison/Name.hs | 5 ----- unison-core/src/Unison/Term.hs | 6 +----- unison-src/transcripts-using-base/base.u | 2 +- unison-syntax/src/Unison/Syntax/Parser.hs | 9 +++++++-- 5 files changed, 11 insertions(+), 15 deletions(-) diff --git a/parser-typechecker/src/Unison/Runtime/IOSource.hs b/parser-typechecker/src/Unison/Runtime/IOSource.hs index f344bb0a06..f690671fc5 100644 --- a/parser-typechecker/src/Unison/Runtime/IOSource.hs +++ b/parser-typechecker/src/Unison/Runtime/IOSource.hs @@ -545,8 +545,8 @@ d1 Doc.++ d2 = use Doc2 match (d1,d2) with (Join ds, Join ds2) -> Join (ds List.++ ds2) - (Join ds, _) -> Join (ds List.:+ d2) - (_, Join ds) -> Join (d1 List.+: ds) + (Join ds, _) -> Join (List.snoc ds d2) + (_, Join ds) -> Join (List.cons d1 ds) _ -> Join [d1,d2] unique[q1905679b27a97a4098bc965574da880c1074183a2c55ff1d481619c7fb8a1e1] type diff --git a/unison-core/src/Unison/Name.hs b/unison-core/src/Unison/Name.hs index 9b8aaa5275..573f254869 100644 --- a/unison-core/src/Unison/Name.hs +++ b/unison-core/src/Unison/Name.hs @@ -36,7 +36,6 @@ module Unison.Name -- * To organize later commonPrefix, - isBlank, preferShallowLibDepth, searchByRankedSuffix, searchBySuffix, @@ -547,10 +546,6 @@ suffixifyByHash fqn rel = refs = R.searchDom (compareSuffix suffix) rel --- | A `Name` is blank when it is unqualified and begins with a `_` (also implying that it is wordy) -isBlank :: Name -> Bool -isBlank n = isUnqualified n && Text.isPrefixOf "_" (NameSegment.toUnescapedText $ lastSegment n) - -- | Returns the common prefix of two names as segments -- -- Note: the returned segments are NOT reversed. diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index 6d0acc1cc3..d3608bc426 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -173,17 +173,13 @@ bindNames unsafeVarToName nameToVar localVars ns term = do in case (Set.size exactNamespaceMatches, Set.size suffixNamespaceMatches, Set.size localMatches) of (1, _, _) -> good (ResolvesToNamespace (Set.findMin exactNamespaceMatches)) (n, _, _) | n > 1 -> leaveFreeForTdnr - (_, 0, 0) -> - if Name.isBlank name - then leaveFreeForHoleSuggestions - else leaveFreeForTellingUserAboutExpectedType + (_, 0, 0) -> leaveFreeForTellingUserAboutExpectedType (_, 1, 0) -> good (ResolvesToNamespace (Set.findMin suffixNamespaceMatches)) (_, 0, 1) -> good (ResolvesToLocal (Set.findMin localMatches)) _ -> leaveFreeForTdnr where name = unsafeVarToName v good = Right . Just . (v,) - leaveFreeForHoleSuggestions = Right Nothing leaveFreeForTdnr = Right Nothing leaveFreeForTellingUserAboutExpectedType = Right Nothing diff --git a/unison-src/transcripts-using-base/base.u b/unison-src/transcripts-using-base/base.u index 51d572aa1d..b1023f558a 100644 --- a/unison-src/transcripts-using-base/base.u +++ b/unison-src/transcripts-using-base/base.u @@ -87,7 +87,7 @@ List.filter: (a -> Boolean) -> [a] -> [a] List.filter f all = go acc = cases [] -> acc - a +: as -> if (f a) then go (a +: acc) as else go acc as + a +: as -> if (f a) then go (cons a acc) as else go acc as go [] all List.forEach : [a] -> (a ->{e} ()) ->{e} () diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index f3f944091e..51bdc1e367 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -82,6 +82,7 @@ import Unison.HashQualifiedPrime qualified as HQ' import Unison.Hashable qualified as Hashable import Unison.Name as Name import Unison.NameSegment (NameSegment) +import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Names.ResolutionResult qualified as Names import Unison.Parser.Ann (Ann (..), Annotated (..)) @@ -302,15 +303,19 @@ closeBlock = void <$> matchToken L.Close optionalCloseBlock :: (Ord v) => P v m (L.Token ()) optionalCloseBlock = closeBlock <|> (\() -> L.Token () mempty mempty) <$> P.eof +-- | A `Name` is blank when it is unqualified and begins with a `_` (also implying that it is wordy) +isBlank :: Name -> Bool +isBlank n = isUnqualified n && Text.isPrefixOf "_" (NameSegment.toUnescapedText $ lastSegment n) + -- | A HQ Name is blank when its Name is blank and it has no hash. isBlank' :: HQ'.HashQualified Name -> Bool isBlank' = \case - HQ'.NameOnly n -> Name.isBlank n + HQ'.NameOnly n -> isBlank n HQ'.HashQualified _ _ -> False wordyPatternName :: (Var v) => P v m (L.Token v) wordyPatternName = queryToken \case - L.WordyId (HQ'.NameOnly n) -> if Name.isBlank n then Nothing else Just $ Name.toVar n + L.WordyId (HQ'.NameOnly n) -> if isBlank n then Nothing else Just $ Name.toVar n _ -> Nothing -- | Parse a prefix identifier e.g. Foo or (+), discarding any hash From 24a6c9b3eae2e96b7756e4453ff88656ae3fe7fd Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 27 Aug 2024 19:29:29 -0400 Subject: [PATCH 628/631] clean some code up and fix pattern-match-coverage.md --- .../src/Unison/Syntax/FileParser.hs | 1 - .../src/Unison/Syntax/TermParser.hs | 5 +- .../src/Unison/UnisonFile/Names.hs | 2 +- .../Codebase/Editor/HandleInput/Load.hs | 2 +- .../Codebase/Editor/HandleInput/Update2.hs | 4 +- unison-core/src/Unison/Name.hs | 1 - unison-core/src/Unison/Names.hs | 84 ++----------------- unison-core/src/Unison/NamesWithHistory.hs | 7 -- .../transcripts/pattern-match-coverage.md | 2 +- .../pattern-match-coverage.output.md | 21 ++--- 10 files changed, 24 insertions(+), 105 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 6ef53527df..fe2cd3cb53 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -19,7 +19,6 @@ import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names -import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Ann import Unison.Prelude diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index a6e4b80773..63bdd69054 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -344,12 +344,11 @@ parsePattern = label "pattern" root names <- asks names case Names.lookupHQPattern Names.IncludeSuffixes (L.payload tok) ct names of s - | Set.null s -> die names tok s - | Set.size s > 1 -> die names tok s - | otherwise -> do + | Set.size s == 1 -> do -- matched ctor name, consume the token _ <- anyToken pure (Set.findMin s <$ tok) + | otherwise -> die names tok s where isLower = Text.all Char.isLower . Text.take 1 . Name.toText isIgnored n = Text.take 1 (Name.toText n) == "_" diff --git a/parser-typechecker/src/Unison/UnisonFile/Names.hs b/parser-typechecker/src/Unison/UnisonFile/Names.hs index e0991c1c16..281e64c967 100644 --- a/parser-typechecker/src/Unison/UnisonFile/Names.hs +++ b/parser-typechecker/src/Unison/UnisonFile/Names.hs @@ -14,8 +14,8 @@ import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.Names qualified as DD.Names import Unison.Hashing.V2.Convert qualified as Hashing import Unison.Names (Names (..)) +import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names -import Unison.NamesWithHistory qualified as Names import Unison.Prelude import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs index 5a387deb64..d969291ac3 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs @@ -27,7 +27,7 @@ import Unison.Codebase.Editor.Slurp qualified as Slurp import Unison.Codebase.Runtime qualified as Runtime import Unison.FileParsers qualified as FileParsers import Unison.Names (Names) -import Unison.NamesWithHistory qualified as Names (shadowing) +import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Ann import Unison.Parsers qualified as Parsers diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index 67d9ebd280..71ee1483bf 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -334,7 +334,7 @@ makePPE hashLen names initialFileNames dependents = -- namespace and "oink.bar" in the file. "bar" may be a unique suffix among the namespace names, but would be -- ambiguous in the context of namespace + file names. -- - -- So, we use `unionLeftName`, which starts with the LHS names (the namespace), and adds to it names from the + -- So, we use `shadowing`, which starts with the LHS names (the namespace), and adds to it names from the -- RHS (the initial file names, i.e. what was originally saved) that don't already exist in the LHS. - (PPE.suffixifyByHash (Names.unionLeftName names initialFileNames)) + (PPE.suffixifyByHash (Names.shadowing names initialFileNames)) ) diff --git a/unison-core/src/Unison/Name.hs b/unison-core/src/Unison/Name.hs index 573f254869..0bbe9ba4a8 100644 --- a/unison-core/src/Unison/Name.hs +++ b/unison-core/src/Unison/Name.hs @@ -72,7 +72,6 @@ import Unison.Prelude import Unison.Util.Alphabetical (Alphabetical, compareAlphabetical) import Unison.Util.List qualified as List import Unison.Util.Relation qualified as R -import qualified Data.Text as Text -- | @compareSuffix x y@ compares the suffix of @y@ (in reverse segment order) that is as long as @x@ to @x@ (in reverse -- segment order). diff --git a/unison-core/src/Unison/Names.hs b/unison-core/src/Unison/Names.hs index 9e17160d90..70c08977d5 100644 --- a/unison-core/src/Unison/Names.hs +++ b/unison-core/src/Unison/Names.hs @@ -38,9 +38,7 @@ module Unison.Names typeReferences, termsNamed, typesNamed, - unionLeft, - unionLeftName, - unionLeftRef, + shadowing, namesForReference, namesForReferent, shadowTerms, @@ -205,79 +203,15 @@ restrictReferences refs Names {..} = Names terms' types' terms' = R.filterRan ((`Set.member` refs) . Referent.toReference) terms types' = R.filterRan (`Set.member` refs) types --- | Guide to unionLeft* --- Is it ok to create new aliases for parsing? --- Sure. --- --- Is it ok to create name conflicts for parsing? --- It's okay but not great. The user will have to hash-qualify to disambiguate. --- --- Is it ok to create new aliases for pretty-printing? --- Not helpful, we need to choose a name to show. --- We'll just have to choose one at random if there are aliases. --- Is it ok to create name conflicts for pretty-printing? --- Still okay but not great. The pretty-printer will have to hash-qualify --- to disambiguate. --- --- Thus, for parsing: --- unionLeftName is good if the name `n` on the left is the only `n` the --- user will want to reference. It allows the rhs to add aliases. --- unionLeftRef allows new conflicts but no new aliases. Lame? --- (<>) is ok for parsing if we expect to add some conflicted names, --- e.g. from history --- --- For pretty-printing: --- Probably don't want to add new aliases, unless we don't know which --- `Names` is higher priority. So if we do have a preferred `Names`, --- don't use `unionLeftName` or (<>). --- You don't want to create new conflicts either if you have a preferred --- `Names`. So in this case, don't use `unionLeftRef` either. --- I guess that leaves `unionLeft`. --- --- Not sure if the above is helpful or correct! - --- unionLeft two Names, including new aliases, but excluding new name conflicts. --- e.g. unionLeftName [foo -> #a, bar -> #a, cat -> #c] --- [foo -> #b, baz -> #c] --- = [foo -> #a, bar -> #a, baz -> #c, cat -> #c)] --- Btw, it's ok to create name conflicts for parsing environments, if you don't --- mind disambiguating. -unionLeftName :: Names -> Names -> Names -unionLeftName = unionLeft' $ const . R.memberDom - --- unionLeft two Names, including new name conflicts, but excluding new aliases. --- e.g. unionLeftRef [foo -> #a, bar -> #a, cat -> #c] --- [foo -> #b, baz -> #c] --- = [foo -> #a, bar -> #a, foo -> #b, cat -> #c] -unionLeftRef :: Names -> Names -> Names -unionLeftRef (Names priorityTerms priorityTypes) (Names fallbackTerms fallbackTypes) = - Names (restricter priorityTerms fallbackTerms) (restricter priorityTypes fallbackTypes) - where - restricter priorityRel fallbackRel = - let refsExclusiveToFallback = (Relation.ran fallbackRel) `Set.difference` (Relation.ran priorityRel) - in priorityRel <> Relation.restrictRan fallbackRel refsExclusiveToFallback - --- unionLeft two Names, but don't create new aliases or new name conflicts. --- e.g. unionLeft [foo -> #a, bar -> #a, cat -> #c] --- [foo -> #b, baz -> #c] --- = [foo -> #a, bar -> #a, cat -> #c] -unionLeft :: Names -> Names -> Names -unionLeft = unionLeft' go - where - go n r acc = R.memberDom n acc || R.memberRan r acc - --- implementation detail of the above -unionLeft' :: - (forall a b. (Ord a, Ord b) => a -> b -> Relation a b -> Bool) -> - Names -> - Names -> - Names -unionLeft' shouldOmit a b = Names terms' types' +-- | Prefer names in the first argument, falling back to names in the second. +-- This can be used to shadow names in the codebase with names in a unison file for instance: +-- e.g. @shadowing scratchFileNames codebaseNames@ +shadowing :: Names -> Names -> Names +shadowing a b = + Names (shadowing a.terms b.terms) (shadowing a.types b.types) where - terms' = foldl' go a.terms (R.toList b.terms) - types' = foldl' go a.types (R.toList b.types) - go :: (Ord a, Ord b) => Relation a b -> (a, b) -> Relation a b - go acc (n, r) = if shouldOmit n r acc then acc else R.insert n r acc + shadowing xs ys = + Relation.fromMultimap (Map.unionWith (\x _ -> x) (Relation.domain xs) (Relation.domain ys)) -- | TODO: get this from database. For now it's a constant. numHashChars :: Int diff --git a/unison-core/src/Unison/NamesWithHistory.hs b/unison-core/src/Unison/NamesWithHistory.hs index 233bede3ef..4ec19c2788 100644 --- a/unison-core/src/Unison/NamesWithHistory.hs +++ b/unison-core/src/Unison/NamesWithHistory.hs @@ -6,7 +6,6 @@ module Unison.NamesWithHistory ( diff, push, - shadowing, lookupHQType, lookupHQType', lookupHQTerm, @@ -104,12 +103,6 @@ push n0 ns = unionLeft0 n1 ns uniqueTerms = [(n, ref) | (n, nubOrd -> [ref]) <- Map.toList terms'] uniqueTypes = [(n, ref) | (n, nubOrd -> [ref]) <- Map.toList types'] --- | Prefer names in the first argument, falling back to names in the second. --- This can be used to shadow names in the codebase with names in a unison file for instance: --- e.g. @shadowing scratchFileNames codebaseNames@ -shadowing :: Names -> Names -> Names -shadowing = Names.unionLeftName - -- Find all types whose name has a suffix matching the provided `HashQualified`, -- returning types with relative names if they exist, and otherwise -- returning types with absolute names. diff --git a/unison-src/transcripts/pattern-match-coverage.md b/unison-src/transcripts/pattern-match-coverage.md index 5868bd7981..b4fcce8be8 100644 --- a/unison-src/transcripts/pattern-match-coverage.md +++ b/unison-src/transcripts/pattern-match-coverage.md @@ -434,7 +434,7 @@ unique type T = A | B result : '{e, Give T} r -> {e} r result f = handle !f with cases { x } -> x - { give A -> resume } -> result resume + { give T.A -> resume } -> result resume ``` ```unison:error diff --git a/unison-src/transcripts/pattern-match-coverage.output.md b/unison-src/transcripts/pattern-match-coverage.output.md index 2e761bf1ad..b6f48adb3b 100644 --- a/unison-src/transcripts/pattern-match-coverage.output.md +++ b/unison-src/transcripts/pattern-match-coverage.output.md @@ -997,26 +997,21 @@ unique type T = A | B result : '{e, Give T} r -> {e} r result f = handle !f with cases { x } -> x - { give A -> resume } -> result resume + { give T.A -> resume } -> result resume ``` ``` ucm Loading changes detected in scratch.u. - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - ability Give a - result : '{e, Give T} r ->{e} r - - ⍟ These names already exist. You can `update` them to your - new definition: + Pattern match doesn't cover all possible cases: + 7 | result f = handle !f with cases + 8 | { x } -> x + 9 | { give T.A -> resume } -> result resume - type T + + Patterns not matched: + * { give B -> _ } ``` ``` unison From 2354c90c9bc4352d626d2a5cf998826045ae6c6f Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 27 Aug 2024 19:34:25 -0400 Subject: [PATCH 629/631] delete unused import --- parser-typechecker/src/Unison/FileParsers.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/parser-typechecker/src/Unison/FileParsers.hs b/parser-typechecker/src/Unison/FileParsers.hs index d0673074e0..73c11450ca 100644 --- a/parser-typechecker/src/Unison/FileParsers.hs +++ b/parser-typechecker/src/Unison/FileParsers.hs @@ -20,7 +20,6 @@ import Unison.Builtin qualified as Builtin import Unison.ConstructorReference qualified as ConstructorReference import Unison.Name qualified as Name import Unison.Names qualified as Names -import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnv.Names qualified as PPE From 217cf13530935c7907b7f374f56ff5edd61522b8 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 27 Aug 2024 19:48:42 -0400 Subject: [PATCH 630/631] add missing record fields --- unison-cli/tests/Unison/Test/LSP.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/unison-cli/tests/Unison/Test/LSP.hs b/unison-cli/tests/Unison/Test/LSP.hs index 2ab406da56..4459d93204 100644 --- a/unison-cli/tests/Unison/Test/LSP.hs +++ b/unison-cli/tests/Unison/Test/LSP.hs @@ -384,7 +384,9 @@ typecheckSrc name src = do Parser.ParsingEnv { uniqueNames = uniqueName, uniqueTypeGuid = \_ -> pure Nothing, - names = parseNames + names = parseNames, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } Codebase.runTransaction codebase do Parsers.parseFile name (Text.unpack src) parsingEnv >>= \case From a783bf3a06118b360279e7b1d602c8d361cc9cbf Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 27 Aug 2024 19:52:37 -0400 Subject: [PATCH 631/631] fix import --- parser-typechecker/tests/Unison/Test/UnisonSources.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parser-typechecker/tests/Unison/Test/UnisonSources.hs b/parser-typechecker/tests/Unison/Test/UnisonSources.hs index e618ac8fb9..0f7cb980c5 100644 --- a/parser-typechecker/tests/Unison/Test/UnisonSources.hs +++ b/parser-typechecker/tests/Unison/Test/UnisonSources.hs @@ -10,7 +10,7 @@ import System.FilePath (joinPath, replaceExtension, splitPath) import System.FilePath.Find (always, extension, find, (==?)) import Unison.Builtin qualified as Builtin import Unison.Codebase.Runtime (Runtime, evaluateWatches) -import Unison.NamesWithHistory qualified as Names +import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Parsers qualified as Parsers import Unison.Prelude